home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / CIS / UPLOAD12.MAC < prev    next >
Text File  |  2000-06-30  |  24KB  |  732 lines
  1. ;****************************************************************************
  2. ; FILE UPLOAD UTILITY FOR CIS A PROTOCOL.
  3. ; WRITTEN 3/17/82 BY BOB RICHARDSON
  4. ; COPYRIGHT (C) 1982 PERFORMANCE BUSINESS MACHINES
  5. ; program distributed by permission- further distribution must contain this
  6. ; notice, the copyright notice and the authors name
  7. ;
  8. ; INVOKED BY "UPLOAD FNAME.FTP" AND USES DEFAULT FCB AND COMMAND LINE 
  9. ; *************************************************************************        
  10. .z80
  11. ;    equates
  12. soh    equ    01h    ; start of header
  13. etx    equ    03h    ; end of text 
  14. eot    equ    04h    ; end of transmission
  15. enq    equ    05h    ; enq char - not used
  16. si    equ    0fh    ; shift in - starts protocol on terminal
  17. so    equ    0eh    ; shift out - ends protocol
  18. ;
  19. knak    equ    15h    ; nak
  20. dle    equ    10h    ; data link escape - used to mask chars for transparency
  21. esc    equ    1bh    ; escape
  22. eof    equ    1ah    ; ctl-z
  23. ctlz    equ    1ah    ; also
  24. cr    equ    0dh    ; carriage return
  25. lf    equ    0ah    ; line feed
  26. tof    equ    0ch    ; top of form
  27. ;
  28. cldboot    equ    00h    ; bios coldboot vector
  29. iobyte    equ    0003h    ; addr of iobyte
  30. deffcb    equ    05ch    ; addr of default fcb
  31. command    equ    080h    ; addr of command line    
  32. bdos    equ    05h    ; addr of bdos jmp 
  33. ; BDOS FUNCTIONS
  34. prnstg  equ    09h    ; print string delimited by $
  35. rdcbuf    equ    0ah    ; read console buffer function
  36. fn$opn    equ    0fh    ; open disk file
  37. fn$cls    equ    010h    ; close disk file
  38. fn$del    equ    013h    ; delete disk file
  39. fn$rds    equ    014h    ; read sequential
  40. fn$wts    equ    015h    ; write sequential
  41. fn$mak    equ    016h    ; make file
  42. fn$ren    equ    017h    ; rename file
  43. fn$std    equ    01ah    ; set dma function
  44.  
  45. ;
  46. ; BIOS OFFSETS FOR VARIOUS CALLS
  47. const    equ    03h    ; constat call
  48. conin    equ    06h    ; conin
  49. conout    equ    09h    ; character out to console
  50. list    equ    0ch    ; character to line printer
  51. punch    equ    0fh    ; char to punch device
  52. rdr    equ    12h    ; get char from reader device
  53. reader    equ    12h    ; alternate spelling
  54. ; FCB OFFSETS
  55. current equ    32    ; offset to current record number
  56. ftype    equ    09    ; and offset to type
  57. ; Version info
  58. vers    equ    '1'    ; ascii version
  59. rev    equ    '2'    ; and rev level  
  60. ; History info
  61. ;         3/20/1982     FIRST COMPLETE VERSION RELEASED 
  62. ;                BY THE AUTHOR  BOB RICHARDSON OF MICROPRO INTL
  63. ;                CORPORATION - FURTHER DISTRIBUTION MUST CONTAIN
  64. ;                THIS COMMENT - this file made available courtesy
  65. ;                of MicroPro International Corp. and the author
  66. ;
  67. ;**************************************************************************
  68. ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  69. ; code begins:
  70. ; MAIN DRIVER LOOP FOR THE UPLOAD PROTOCOL
  71. ;
  72. upld:
  73.     ld    sp,upld        ; the Charlie Strom memorial local stack     
  74.     call    announce    ; copyrite and vers, rev level
  75.     call    dskinit        ; initialize disk buffer
  76.     call     procol        ; turn on protocol, open file, and start
  77. upldrt:
  78.     call    sndhdr        ; then send the header for file xfer
  79.     call    waitack        ; and wait for ack response
  80.     jp    c,upldrt    ; retry if nak response
  81.     jp    nz,comfail    ; error so dump job
  82.     call    sendack        ; else prompt for first record
  83. uplp:
  84.     call    getrec        ; get terminals record
  85.     jp    c,uplp        ; wait for resend if nak    
  86.     ld    a,(seeneot)    ; get eotflag
  87.     cp    00h        ; and test for completion
  88.     jp    nz,fin        ; eof - recd eot record
  89. upl1:
  90.     call    putrec        ; write rec(s) to disk
  91.     jp    c,dspacen    ; no space on host disk - send fail message
  92.     call    z,sendack
  93.     jp    uplp        ; loop till eof
  94. ;
  95. fin:
  96.     call    sendack        ; ack eot message
  97.     call    complete    ; turn off protocol and send all done message 
  98.     call    fclose        ; dump buffer tailings if any
  99.     jp     cldboot     ; terminate
  100. ;************************************************************************
  101. ; end of driver     beginning of subroutines
  102. biosvct:
  103.     ld    hl,(cldboot+1)    ;get start of bios table
  104.     add    hl,de        ; get addr for branch
  105.     jp    (hl)        ; return handled to inline location
  106. ;************************************************************************
  107. ; Get rev and version and copyright notice to operator
  108. announce:
  109.     ld    de,cpyrite        ; copyright notice
  110.     call    prnmes            ; to console
  111.     ret                ; to caller
  112. ;
  113. cpyrite:
  114.     defb    cr,lf,'Upload Vers. ',vers,'.',rev,cr,lf
  115.     defb    ' Copyright (C) 1982  PBM Division MicroPro International Corporation ','$'
  116. ;
  117. ; **************************************************************************
  118. ;  Kudos to Russ Renshaw for inventing this protocol
  119. ;  and special thanks to charlie, tom, and dave - sysops of the CIS CP-MIG
  120. ;  without whose help none of this code would be here    
  121. ; ***************************************************************************
  122. ; INITIALIZE THE PROTOCOL AND OPEN FILES
  123. procol:
  124.     ld    de,deffcb    ; get default fcb
  125.     ld    c,fn$opn    ; open file function
  126.     call    bdos        ; see if we can open file
  127.     cp    04h        ; test for successful open
  128.     jp    c,isfil        ; send file exists message if file there 
  129.     ld    a,(command)    ; get count of oper supplied chars
  130.     or    a        ; and insure non zero value
  131.     jp    z,nospec    ; complain if not right
  132.     ld    hl,deffcb+ftype ; addr of file type
  133.     push    hl        ; and save for next use
  134.     ld    de,typsav    ; save area
  135.     ld    bc,03h        ; length of file type
  136.     ldir             ; move to save area - operator supplied file type
  137.     pop    de        ; here is the next use of filetype addr in fcb
  138.     ld    hl,dollar    ; $$$ for temporary file type
  139.     ld    bc,03h        ; length of file type
  140.     ldir            ; move it in
  141. ;  the above added for pip compatibility 
  142.     ld    a,0        ; get zero
  143.     ld    (masking),a    ; and start masking ctl chars in msg text
  144.     call    rmtnm        ; prompt operator for name at his end
  145.     ld    a,(conbuff+1)    ; start of data - contains byte count
  146.     ld    c,a        ; is count for move
  147.     ld    b,0        ; with high order=0
  148.     ld    hl,conbuff+2    ; start of actual name
  149.     call    noblnk        ; bypass all blanks
  150.     jp    z,comfail    ; if this passes machine is broken - get a new
  151.                 ; one.
  152.     ld    de,filespec    ; addr in esc a message
  153.     push    bc        ; save the number of non blanks
  154.     ldir            ; move filespec to message
  155.     pop    hl        ; restore count
  156.     ld    a,cr        ; get cr to terminate the esc a string
  157.     ld    (de),a        ; and move it to the esc a message buffer end
  158.     inc    hl        ; update count to reflect this fact
  159.     ld    (tmpsav),hl    ; and save for next routine
  160. ; here we create the temporary $$$ file on the disk
  161.     ld    de,deffcb    ; so make the file - all is well    
  162.     ld    c,fn$del    ; first delete it just in case
  163.     push    de        ; save for next call
  164.     call    bdos        ; to pyramid building routine
  165.     pop    de        ; restore fcb pointer        
  166.     ld    c,fn$mak    ; make function
  167.     call    bdos        ; mush
  168.     cp    04h        ; test sucessful completion 
  169.     jp    nc,nodirsp    ; else give error for no directory space
  170.     ld    a,0        ; get zero
  171.     ld    (deffcb+current),a    ; to current record
  172.     ret            ; to caller
  173. ;
  174. tmpsav:
  175.     defw    00h        ; save area for operator count from 
  176.                 ; remote file name
  177. ; **********************************************************************
  178. ; send the esc a header to the terminal - refer to the protocol document
  179. ; for the format of this record - is essentially the same as normal
  180. ; but fields have special meanings.
  181. sndhdr:
  182. ; and then turn on protocol in terminal
  183.     ld    a,si        ; get shift in char
  184.     call     punout        ; send it
  185.     ld    a,esc        ; send esc
  186.     call    punout        ; charge
  187.     ld    a,'A'        ; esc a for message
  188.     call    punout        ; mush ye huskies mush
  189.     ld    hl,(tmpsav)    ; get count from operator answer for name
  190.     push     hl        ; move to bc
  191.     ld    hl,escames    ; get message balance addr
  192.     pop    bc        ; restore count from command line
  193.     ld    a,c        ; get count in accumulator
  194.     add    a,escalen    ; and add in normal length
  195.     ld    b,a        ; get in byte counter
  196.     call    prmesout    ; send message as normal
  197.     xor    a        ; set z flag
  198.     ret            ; and return
  199. ; bypass leading blanks in command line
  200. noblnk:
  201.     ld    a,(hl)        ; get char
  202.     cp    20h        ; test blank
  203.     ret    nz        ; non blank
  204.     dec    c        ; reduce count
  205.     ret    z        ; return error if exhausted
  206.     inc    hl        ; increment buffer pointer
  207.     jp    noblnk
  208.  
  209. ; file exists on host- blow off terminal as security measure
  210. ;
  211. isfil:
  212.     ld    de,isflmes    ; file found message
  213.     call    prnmes        ; to console
  214.     jp    cldboot        ; and terminate abnormally
  215. ;
  216. isflmes:
  217.     defb    cr,lf,'FILE ALREADY EXISTS ON HOST- CHECK DIRECTORY$'
  218. ; nospec is issued when user omits the 
  219. ; filespec in the command line
  220. nospec:
  221.     ld    de,nospecm    ; file found message
  222.     call    prnmes        ; to console
  223.     jp    cldboot        ; and terminate abnormally
  224. ;
  225. nospecm:
  226.     defb    cr,lf,'I am sorry- you must specify a name for upload$'
  227.  
  228. ; error - the host has no directory space
  229. nodirsp:
  230.     ld    de,nodirmes    ; no directory space
  231.     call    prnmes        ; to console
  232.     jp    cldboot        ; and terminate
  233. ;
  234. nodirmes:
  235.     defb    cr,lf,'NO DIRECTORY SPACE ON HOST !!!','$'
  236. ;
  237. ; message for ESC A header - sent if all is well to start upload
  238. escames:
  239.     defb    'U'        ; upload
  240.     defb    'B'        ; Binary transfer
  241. escalen equ    $-escames    ; length for send routine
  242. filespec:
  243.     defs    16h         ; name of file to upload
  244. typsav:
  245.     defs    03h        ; save area for file type until sucessfull
  246. dollar:
  247.     defb    '$$$'        ; temporary file type in case of io error    
  248. ;
  249. ;**************************************************************************
  250. ;get name for remote computer
  251. ; a <cr> response will cause the same name to be used as on host
  252. rmtnm:
  253.     ld    de,remquery        ; ask the terminal what it wants to call it
  254.     call    prnmes            ; to the operating system such as it is
  255.     ld    de,conbuff        ; get a response
  256.     call    rdcon            ; and then
  257.     ld    hl,conbuff+2        ; convert to insure upper case
  258.     ld    a,(conbuff+1)        ; get char count xferred
  259.     cp    0            ; insure some characters
  260.     jp    z,naminv        ; else take default value
  261.     ld    c,a            ; get counter for blank test to 
  262.     call    noblnk            ; further insure no error
  263.     jp    z,naminv        ; else use same name as on host
  264.     ld    b,a            ; in byte counter
  265. ; roll lower to upper case if necessary
  266. rmtnm1:
  267.     ld    a,(hl)            ; pick up char    
  268.     cp    061h            ; test for lower case
  269.     jr    c,rmtntl        ; not lower if carry
  270.     cp    07bh            ; still looking if less than z
  271.     jr    nc,rmtntl        ; so go on about business
  272.     and    05fh            ; else roll
  273.     ld    (hl),a            ; and save
  274. rmtntl:
  275.     inc    hl            ; bump character pointer
  276.     djnz    rmtnm1            ; and get next character
  277.     ret                ; and return to caller
  278. ; use same name as host for remote file
  279. ;
  280. naminv:
  281.     ld    hl,command+1        ; use the command line input
  282.     ld    de,conbuff+2        ; for the remote name
  283.     ld    a,(command)        ; length
  284.     ld    c,a            ; to counter with
  285.     ld    (conbuff+1),a        ; count in command line
  286.     ld    b,0            ; zero high order
  287.     ldir                ; move characters
  288.     ret                ; to caller
  289. ;
  290. ; buffer for response to filename question 
  291. conbuff:
  292.     defb    010h            ; sixteen bytes max I'll allow
  293.     defb    00h            ; initial count
  294.     defs    16            ; and blank buffer
  295. ;
  296. remquery:
  297.     defb    cr,lf,' I need the file name on your computer',cr,lf,'->','$'
  298. ;
  299. ;            
  300. ;***************************************************************************
  301. ; TRANSMIT ACK OR NAK TO TERMINAL
  302. sendack:
  303.     ld    a,'.'        ; get ack character
  304.     jp    acknak        ; branch to common code
  305. ;
  306. sendnak:
  307.     ld    a,'/'        ; nak char
  308. acknak:
  309.     call    punout        ; send it
  310.     scf            ; insure carry reset for logic flow in mn loop
  311.     ccf            ; could have used or a , i know - good document
  312.     ret            ; but thats a subject for another time
  313. ;*****************************************************************************
  314. ; send a record using the CIS-A protocol
  315. ; used primarily for the esc a header in this program
  316. ;
  317. prmesout:
  318.     push    bc        ; save byte count
  319.     push    hl        ; save buffer pointer    
  320.     xor    a        ; get zero
  321.     ld    (chksum),a    ; and init checksum
  322.     ld    a,soh        ; get start of header char
  323.     call    punout        ; and send it
  324.     ld    a,(currec)    ; get current record
  325.     call    sumupd        ; and update checksum
  326.     call    punout        ; and send it
  327.     pop    hl        ; restore buffer addr
  328.     pop    bc        ; restore count to b
  329. ;
  330. pmeslp:
  331.     push    hl        ; save pointer
  332.     push    bc        ; and char count
  333.     ld    a,(hl)        ; get char
  334.     call    sumupd        ; update checksum
  335.     call    tstmsk        ; test if masking necessary
  336.     call    punout        ; send char
  337.     pop    bc        ; restore count
  338.     pop    hl        ; get buffer pointer
  339.     inc    hl        ; increment it
  340.     djnz    pmeslp        ; and loop until all done
  341. ;
  342.     ld    a,etx        ; get etx char
  343.     call    punout        ; send it
  344.     ld    a,(chksum)    ; get check sum
  345.     cp    020h        ; test for < ascii space
  346.     jp    nc,pmesl1    ; if = or greater, do not mask
  347.     or    040h        ; else add to supply transparency
  348.     push    af        ; save checksum
  349.     ld    a,dle        ; send dle
  350.     call    punout        ; to remote
  351.     pop    af        ; restore char
  352. pmesl1: 
  353.     call    punout        ; send it
  354.     ret            ; and return
  355. ;*************************************************************************
  356. ; Test here for masking of control chars, handle if necessary
  357. ; control chars are masked to prevent confusion between innocent bit combos
  358. ; and protocol control chars
  359. tstmsk:
  360.     push    af        ; save char
  361.     ld    a,(masking)    ; get switch value
  362.     cp    00h        ; test for on status
  363.     jp    nz,tstmsr    ; if off return immediate
  364.     pop    af        ; restore original char
  365.     push    af
  366.     cp    05h        ; test if one of the offending chars
  367.     jp    c,tstms1    ; mask if so
  368.     cp    dle        ; or if equal the dle
  369.     jp    z,tstms1    ; go masked
  370.     cp    knak        ; or if = to 
  371.     jp    z,tstms1    ; the fatal nak mask it
  372. ; common return
  373. tstmsr:
  374.     pop    af
  375.     ret            ; common return if no masking necessary
  376. ; masking needed - so mask it
  377. tstms1:
  378.     ld    a,dle        ; send dle char first
  379.     call    punout        ; and send it
  380.     pop    af        ; followed by char+40
  381.     or    040h        ; to insure transparecy
  382.     ret     
  383. ;
  384. masking:
  385.     defb    00h        ; flag for control char masking
  386. ;
  387. ;****************************************************************************
  388. ; update the checksum
  389. ; called whenever we need checksumming - uses simple checksum algorithm
  390. sumupd:
  391.     push    af        ; save char
  392.     ld    e,a        ; and leave it in reg
  393.     ld    a,(chksum)    ; get old checksum
  394.     rlca            ; and rotate it
  395.     add    a,e        ; add new byte 
  396.     adc    a,0        ; and possible carry
  397.     ld    (chksum),a    ; and save it
  398.     pop    af        ; restore character
  399.     ret            ; and return        
  400. ;****************************************************************************
  401. ; Read a record from the serial port
  402. ; using the Compuserve A protocol
  403. getrec:
  404.     xor    a        ; init checksum
  405.     ld    (chksum),a    ; for use soon
  406.     call    rdrin        ; get a char from the rdr device
  407.     cp    etx        ; maybe he is just nervous
  408.     jp    z,getrec    ; so wait - questionable situation
  409.     cp    soh        ; better be an soh
  410.     jp    nz,comfail    ; else abort the protocol
  411. ; get the terminals record number
  412.     call    rdrin        ; get record number
  413.     ld    (trmrno),a    ; and save it for later ack/nak branch
  414.     call    sumupd        ; and start checksumming 
  415. ; set up to fill a buffer
  416.     ld    a,00h        ; zero to char count
  417.     ld    (charcnt),a    ; for index pointer
  418.     ld    (charcnt+1),a    ; both halves must get cleared
  419.     ld    (seeneot),a    ; and reset the eot status byte
  420.     ld    hl,buffer    ; get address of comm buffer
  421. ; then read data until etx
  422. getr1:                ; mainloop        
  423.     push    hl        ; save the buffer pointer
  424.     call    rdrin        ; and get a char
  425.     pop    hl        ; restore buffer pointer
  426.     cp    etx        ; see if its the end of record
  427.     jp    z,getetx    ; so go get checksum if so
  428.     cp    eot        ; test for eot
  429.     jp    z,geteot    ; and handle if recieved
  430. getr2:
  431.     cp    dle        ; was it a masking char?
  432.     jr    nz,getr3    ; regular unmasked character
  433.     push    hl        ; else get next char
  434.     call    rdrin        ; from terminal
  435.     pop    hl        ; restore buffer pointer
  436.     and    03fh        ; and correct for masking
  437. getr3:
  438.     ld    (hl),a        ; save in buffer
  439.     inc    hl        ; update pointer
  440.     call    sumupd        ; update checksum
  441.     ld    bc,(charcnt)    ; update count
  442.     inc    bc        ; to reflect chars in buffer
  443.     ld    (charcnt),bc    ; merrily counting
  444.     jp    getr1        ; and go back for more
  445. ;
  446. ; here when eot is spotted
  447. geteot:
  448.     ld    (seeneot),a    ; set eot recieved flag
  449.     call    sumupd        ; update the checksum for eot
  450.     jp    getr1        ; and return to loop for etx, chksum
  451. ; recvd an etx
  452. getetx: 
  453.     call    rdrin        ; get term's checksum
  454.     cp    dle        ; see if its masked
  455.     jr    nz,getet1    ; and bypass this if not
  456.     call    rdrin        ; get real checksum
  457.     and    01fh        ; and make it a control char
  458. ; validate the transmission
  459. getet1:
  460.     ld    c,a        ; and test to see 
  461.     ld    a,(chksum)    ; that all is ok
  462.     cp    c        ; zero if equal
  463.     jp    nz,getnak    ; reject if not
  464.     ld    a,(trmrno)    ; get term record number
  465.     ld    c,a        ; and save for compare
  466.     ld    a,(currec)    ; get what host thinks is current
  467.     sub    c        ; and test for terminal high
  468.     jp    c,comfail    ; signal communications failure if so
  469.     ld    (trmrno),a    ; else save a flag for disk write routine
  470.     call    updrnum        ; everything looks ok - we are acking
  471.     xor    a        ; so clear carry flag to show all went well
  472.     ret            ; and return
  473. ; error has occured in xmission
  474. getnak:
  475.     call    sendnak        ; something is very wrong- send a nak
  476.     scf            ; set the carry flag
  477.     ret            ; and retry
  478. ; transmission control variables
  479. trmrno:
  480.     defb    00h        ; area for term. record number
  481. seeneot:
  482.     defb    00h        ; flag to indicate eot detected
  483. charcnt:
  484.     defw    00h        ; counter for chars received
  485. ;
  486. ;
  487. ;
  488. ;**************************************************************************
  489. ; Routine to write the approved characters to disk. only error is no space
  490. ; write a record to the disk a character at a time.. 
  491. putrec:
  492.     ld    a,(trmrno)    ; get flag for record number
  493.     or    a
  494.     jp    nz,dputfin    ; bypass put unless correct record
  495.     ld    hl,buffer    ; get start of comm record
  496.     ld    bc,(charcnt)    ; and get count of chars
  497.     ld    a,b        ; and test for zero error
  498.     or    c        ;
  499.     jp    z,dputfin    ; bypass putloop if so
  500. ;
  501. dputlp:
  502.     ld    a,(hl)        ; get the char 
  503.     push    hl        ; save the buffer pointer
  504.     push    bc        ; save the count
  505.     call    ptchar        ; put 1 char to disk stream
  506.     pop    bc        ; restore count
  507.     pop    hl        ; restore buffer pointer
  508.     inc    hl        ; update ptr
  509.     dec    bc        ; and update count
  510.     ld    a,b        ; test for zero
  511.     or    c        ; value in byte counter
  512.     jp    nz,dputlp    ; and spin till done
  513. ;
  514. dputfin:
  515.     ld    a,(dskerr)    ; test for possible disk error
  516.     or    a        ; should be zero
  517.     ret    z        ; ret good if so
  518.     scf            ; else set error for disk space
  519.     ret            ; and return
  520. ;
  521. ; initialize the disk buffer on startup or after a write
  522. dskinit:
  523.     ld    hl,dbuff    ; start addr
  524.     ld    de,dbuff+1    ; for overlapping move
  525.     ld    bc,buffend-dbuff-1    ; buffer length-1 
  526.     ld    a,ctlz        ; ctlz to clear with
  527.     ld    (hl),a        ; save the seed
  528.     ldir            ; and clear
  529.     ret            ; to caller
  530. ;
  531. ; routine to put a character in the disk buffer and write if buffer is full
  532. ; writes will ONLY occur on eot or full buffer
  533. ptchar:
  534.     ld    hl,(dpointr)    ; get current pointer
  535.     ld    (hl),a        ; and save character
  536.     inc    hl        ; point to next
  537.     ld    (dpointr),hl    ; and save it 
  538.     ld    de,buffend    ; get limit
  539.     xor    a        ; clear carry
  540.     sbc    hl,de        ; test for end
  541.     ret    nz        ; return if not boundry
  542.     call    ptitout        ; write the record
  543.     ld    hl,dbuff    ; re-init pointers
  544.     ld    (dpointr),hl    ; for next pass
  545.     call    dskinit        ; re-init buffer
  546.     ret            ; and return
  547.  
  548. ptitout:
  549.     ld    de,dbuff    ; get dma addr
  550.     ld    c,fn$std    ; set dmaadr function
  551.     call    bdos        ; to os
  552.     ld    de,deffcb    ; fcbaddr
  553.     ld    c,fn$wts    ; write sequential function
  554.     call    bdos        ; and its done
  555.     ld    (dskerr),a    ; save possible error status
  556.     ret            ; and return to caller
  557. ;
  558. ; close the file and write record if non-empty
  559. fclose:
  560.     ld    hl,(dpointr)    ; get pointer value
  561.     ld    de,dbuff    ; and init value
  562.     xor    a        ; clear carry
  563.     sbc    hl,de        ; is pointer at start of buffer??
  564.     jr    z,fclos1    ; yes, bypass flush
  565.     call    ptitout
  566. ; close the file and rename it to the originally specified name
  567. fclos1:  
  568.     ld    de,deffcb    ; for file close function
  569.     ld    c,fn$cls    ; the aforementioned function
  570.     call    bdos        ; close and go
  571.     ld    de,deffcb+16    ; get next 16 for rename setup
  572.     xor    a        ; clear drive byte
  573.     inc    de
  574.     ld    (de),a        ; for later
  575.     ld    hl,deffcb+1    ; and point to old name
  576.     ld    bc,08h        ; length for move
  577.     ldir            ; move in file name
  578.     ld    hl,typsav    ; get original file type
  579.     ld    bc,03h        ; and length
  580.     ldir            ; and move it in too
  581.     ld    c,fn$ren    ; rename function change fil.$$$ to fil.ext
  582.     ld    de,deffcb    ; addr of fcb for renamed file
  583.     call    bdos        ; rename it
  584.     ret            ; to caller    
  585. ;
  586. dskerr:
  587.     defb    00h
  588. ;
  589. ;*************************************************************************
  590. ; Communications have failed - reset everything and split
  591. ;
  592. comfail:
  593.     ld    a,knak        ; send physical abort character
  594.     call    punout        ; and abort
  595.     ld    de,failmes    ; get comm failure message
  596.     call    prnmes        ; send message
  597.     ld    de,deffcb    ; and delete any file by that name
  598.     ld    c,fn$del    ; delete function
  599.     call    bdos        ; go out in the best way 
  600.     jp    cldboot        ; and abort
  601. ;
  602. failmes:
  603.     defb    CR,LF,' Communications Failure - Upload aborted','$'
  604. ;**********************************************8
  605. ; Host is out of disk space
  606. dspacen:
  607.     ld    a,knak        ; send physical abort character
  608.     call    punout        ; and abort
  609.     ld    de,dspcmes    ; get comm failure message
  610.     call    prnmes        ; send message
  611.     jp    cldboot        ; and abort
  612. ;
  613. dspcmes:
  614.     defb    cr,lf,' Host out of disk space - Upload aborted','$'
  615. ;
  616. ;************************************************************************** 
  617. ; EOF - send a good eot message to let host know we are done
  618. puteot:
  619.     ld    a,0ffh        ; turn of the switch to insure
  620.     ld    (masking),a    ; that eot is sent unmasked
  621. ;
  622.     ld    hl,eotmes    ; get addr of eot char
  623.     ld    b,1        ; setup
  624.     call    prmesout    ; and send it
  625.     ret
  626. complete:
  627.     ld    a,so        ; turn off protocol mode at terminal
  628.     call    punout        ; now
  629.     ld    de,ucommes    ; get upload complete
  630.     call    prnmes        ; send it 
  631. ;
  632.     ret
  633. ucommes:
  634.     defb    cr,lf,' UPLOAD COMPLETE ','$'
  635. eotmes:
  636.     defb    eot
  637. ;**********************************************************************
  638. ; Wait for an ack from the terminal
  639. waitack:
  640.     call    pcharin        ; get protocol char
  641.     cp    '.'        ; is it ack
  642.     jp    z,gotack    ; then handle
  643.     cp    '/'        ; is it nak?
  644.     jp    z,rexmit    ; then retransmit
  645.     cp    knak        ; check for abort
  646.     jp    nz,waitack    ; else loop
  647. ;
  648.     ld    a,01        ; set nz, clear carry
  649.     or    a        ; and return
  650.     ret
  651. ;
  652. rexmit:
  653.     scf            ; return carry set
  654.     ret
  655. ;
  656. gotack:
  657.     call    updrnum        ; update current record number
  658.     xor    a        ; set zero flag and clear carry
  659.     ret    
  660. ;**************************************************************************
  661. ; update current record number
  662. updrnum:
  663.     ld    a,(currec)    ; get current record number
  664.     inc    a        ; and increment
  665.     cp    '9'+1        ; test for overflow
  666.     jr    c,updrok    ; still valid if carry
  667.     ld    a,'0'        ; else change it
  668. updrok:        
  669.     ld    (currec),a    ; and save result
  670.     ret            ; then return
  671. ;****************************************************************************
  672. ; START OF IO ROUTINES - THESE ROUTINES MAY BE MODIFIED AS REQUIRED TO SUPPORT
  673. ; THE USERS HARDWARE ENVIRONMENT
  674. ;****************************************************************************
  675. ; send a message to terminal using print string convention - this routine
  676. ; assumes terminal is accessible as console and uses bdos
  677. prnmes:
  678.     ld    c,prnstg    ; settup function number
  679.     call    bdos        ; call the operating system
  680.     ret            ; and return
  681. ;***************************************************************************
  682. ; this routine reads a standard console buffer from the operator- again, using
  683. ; bdos
  684. rdcon:
  685.     ld    c,rdcbuf    ; read console buffer function
  686.     call    bdos        ; to os
  687.     ret            ; to caller    
  688.  
  689. ;***********************************************************************
  690. ; This routine uses the bios punch call to access the console port
  691. ; the routine must send the char in a to the modem without stripping parity
  692. ;
  693. punout:
  694.     push    af        ; save char
  695.     ld    c,a        ; get char in proper register
  696.     ld    de,punch    ; get offset
  697.     call    biosvct        ; go doit
  698.     pop    af        ; restore char
  699.     ret
  700. ;**************************************************************************
  701. ; This routine calls the bios reader input to get an 8 bit character
  702. ; character is returned in a with parity bit INTACT!
  703. rdrin:
  704.     ld    de,reader    ; get proper offset
  705.     call    biosvct        ; go get the char
  706.     cp    knak        ; see it its knak
  707.     jp    z,comfail    ; comm failure if so 
  708.     ret    
  709. ;
  710. ; *************************************************************************
  711. ; read one char from modem - parity may be stripped
  712. pcharin:
  713.     ld    de,conin    ; get 1 char via bios
  714.     call    biosvct        ; and return
  715.     ret            ; to caller
  716.  
  717. ;    
  718. currec:
  719.     defb    '1'        ; initial record number
  720. chksum:
  721.     defb    00h        ; initial check sum
  722. dpointr:
  723.     defw    dbuff        ; initial pointer value
  724.  
  725. ;
  726. ;
  727. dbuff:
  728.     ds    128        ; dma address
  729. buffend equ    $
  730. buffer    equ    $    
  731.     end
  732.