CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / cpm / modems / modem / cp405src.ark / CP4PKT.ASM < prev next >

Wrap

Assembly Source File | 1986-12-26 | 62.4 KB | 2,210 lines

; CP4PKT.ASM ; KERMIT - (Celtic for "FREE") ; ; This is the CP/M-80 implementation of the Columbia University ; KERMIT file transfer protocol. ; ; Version 4.0 ; ; Copyright June 1981,1982,1983,1984 ; Columbia University ; ; Originally written by Bill Catchings of the Columbia University Center for ; Computing Activities, 612 W. 115th St., New York, NY 10025. ; ; Contributions by Frank da Cruz, Daphne Tzoar, Bernie Eiben, ; Bruce Tanner, Nick Bush, Greg Small, Kimmo Laaksonen, Jeff Damens, and many ; others. ; ; This file contains the (system-independent) routines that implement ; the KERMIT protocol, and the commands that use them: ; RECEIVE, SEND, FINISH, and LOGOUT. ; ; revision history: ; edir 6: November 22, 1984 ; Change SEND's 'Unable to find file' error exit from calling ; error3 to calling prtstr instead. I don't know about you, but ; I greatly dislike having messages dumped into pre-existing ; junk on the screen where I have to spend lots of time hunting ; for them. [Hal Hostetler] ; ; edit 5: September 9, 1984 ; Call flsmdm in init to flush old input when starting transfers. ; Select console before returning from inpkt. ; Replace inline code with calls to makfil/clofil to set up for ; multisector buffering on output. ; Remove superfluous call to clrlin in error3. ; ; edit 4: August 21, 1984 (CJC) ; Fix comment in inpkt: packet is terminated by NUL on return, not CR. ; If debugging, display the outgoing packet before putting the EOL ; character on, so the dumped packet doesn't get overwritten. ; ; edit 3: July 27, 1984 ; add link directive for LASM. CP4PKT is linked by CP4MIT, and links ; to CP4TT. Add Toad Hall TACtrap to permit operations through a TAC. ; ; edit 2: June 8, 1984 ; formatting and documentation; remove some unused labels; move setpar ; to cp4mit.m80; add module version string; make all arithmetic on ; 'pktnum' modulo 64; apply defaults correctly for missing parameters ; in send-init packet (and corresponding ack). ; ; edit 1: May, 1984 ; extracted from CPMBASE.M80 version 3.9; modifications are described ; in the accompanying .UPD file. ; pktver: db 'CP4PKT.ASM (6) 22-Nov-84$' ; name, edit number, date ; RECEIVE command ; here from: kermit read: lxi d,data ;Where to put the text (if any.) mvi a,cmtxt call comnd ;Get either some text or a confirm. jmp kermt3 ; Didn't get anything. ora a ;Get any chars? jz read1 ;Nope, just a regular send. sta argblk+1 ;Store the number of chars. xchg ;Get pointer into HL. mvi m,'$' ;Put in a dollar sign for printing. call init ;Clear the line and initialize the buffers. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr mvi a,'1' ;Start with single character checksum sta curchk ;Save the type xra a ;Start a packet zero. sta argblk mvi a,'R' ;Receive init packet. call spack ;Send the packet. jmp kermt3 ; Die! jmp read12 read1: call init ;Clear the line and initialize the buffers. read12: xra a sta czseen ;Clear the ^X/^Z flag initially. lxi h,0 shld numpkt ;Set the number of packets to zero. shld numrtr ;Set the number of retries to zero. sta pktnum ;Set the packet number to zero. sta numtry ;Set the number of tries to zero. call scrnrt ;Position cursor lxi h,0 call nout ;Write the number of retries. mvi a,'R' sta state ;Set the state to receive initiate. ;... ; ;RECEIVE state table switcher. read2: call scrnp ;Position cursor lhld numpkt call nout ;Write the current packet number. lda state ;Get the state. cpi 'D' ;Are we in the DATA receive state? jnz read3 call rdata jmp read2 read3: cpi 'F' ;Are we in the FILE receive state? jnz read4 call rfile ;Call receive file. jmp read2 read4: cpi 'R' ;Are we in the Receive-Initiate state? jnz read5 call rinit lda state ;[jd] get new state cpi 'F' ;[jd] went into receive state? jnz read2 ;[jd] no lxi d,inms24 ;[jd] yes, get receiving... message call finmes ;[jd] go print it jmp read2 read5: cpi 'C' ;Are we in the Receive-Complete state? jnz read6 lxi d,infms3 ;Put in "Complete" message. lda czseen ;Or was it interrupted? ora a ; . . . jz read5a ;No. xra a ;Yes, clear flag. sta czseen ; ... lxi d,inms13 ;Issue "interrupted" message. read5a: call finmes ;Print completion message in right place. jmp kermit read6: cpi 'A' ;Are we in the Receive-"Abort" state? jnz read7 read7: lxi d,infms4 ;Anything else is equivalent to "abort". call finmes jmp kermit ; ; Receive routines ; Receive init ; called by: read rinit: lda numtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm rinit2 lxi d,ermes4 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rinit2: inr a ;Increment it. sta numtry ;Save the updated number of tries. mvi a,'1' ;Reset block check type to single character sta curchk ;Store as current type for initialization call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'S' ;Is it a send initiate packet? jnz rinit3 ;If not see if its an error. lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda argblk ;Returned packet number. (Synchronize them.) call countp lda argblk+1 ;Get the number of arguments received. lxi h,data ;Get a pointer to the data. call spar ;Get the data into the proper variables. lxi h,data ;Get a pointer to our data block. call rpar ;Set up the receive parameters. sta argblk+1 ;Store the returned number of arguments. mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ; Failed, abort. lda inichk ;Now switch to agreed upon check-type sta curchk ;For all future packets mvi a,'F' ;Set the state to file send. sta state ret rinit3: cpi 'E' ;Is it an error packet. jnz nak0 ;If not NAK whatever it is. call error jmp abort ; ; Receive file ; called by: read rfile: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rfile1 lxi d,ermes5 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfile1: inr a ;Increment it. sta numtry ;Save the updated number of tries. call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'S' ;Is it a send initiate packet? jnz rfile2 ; No, try next type. lda oldtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm rfil12 ;If not proceed. lxi d,ermes4 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfil12: inr a ;Increment it. sta oldtry ;Save the updated number of tries. lda pktnum ;Get the present packet number. dcr a ;Decrement ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number cmp b ;Is the packet's number one less than now? jnz nak0 ;No, NAK and try again. call updrtr ;Update the retry count. xra a sta numtry ;Reset the number of tries. lxi h,data ;Get a pointer to our data block. call rpar ;Set up the parameter information. sta argblk+1 ;Save the number of arguments. mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ; Failed, abort. ret rfile2: cpi 'Z' ;Is it an EOF packet? jnz rfile3 ; No, try next type. lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rfil21 ;If not proceed. lxi d,ermes6 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfil21: call tryagn ret rfile3: cpi 'F' ;Start of file? jnz rfile4 call compp jnz nak0 ;No, NAK it and try again. call countp call gofil ;Get a file to write to, and init output buffer. jmp abort lda numtry ;Get the number of tries. sta oldtry ;Save it. call ackp mvi a,'D' ;Set the state to data receive. sta state lda czseen ;Check if we punted a file cpi 'Z' ;and didn't want any more rz ;If that was the request, keep telling other end xra a ;Otherwise, clear flag (^X is only for one file) sta czseen ;And store the flag back ret rfile4: cpi 'B' ;End of transmission. jnz rfile5 call compp jnz nak0 ;No, NAK it and try again. xra a ;No data. (Packet number already in argblk). sta argblk+1 mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort mvi a,'C' ;Set the state to complete. sta state ret rfile5: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Receive data ; called by: read rdata: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdata1 lxi d,erms10 call error3 ;Display error message. jmp abort ;Change the state to abort. rdata1: inr a ;Increment it. sta numtry ;Save the updated number of tries. call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'D' ;Is it a data packet? jnz rdata2 ; No, try next type. call compp jz rdat14 lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdat12 ;If not proceed. lxi d,erms10 call error3 ;Display err msg. jmp abort ;Change the state to abort. rdat12: call tryagn ret rdat14: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. lda argblk+1 ;Get the length of the data. call ptchr jmp abort ; Unable to write out chars;abort. xra a sta numtry ;Reset the number of tries. sta argblk+1 ;No data. (Packet number still in argblk.) mov c,a ;Assume no data lda czseen ;Check if control-X typed ora a ; . . . jz rdat15 ;Zero if not typed mov c,a ;Get the type of character typed mvi a,1 ;One data character sta argblk+1 ;Save the count mov a,c ;Get the possible data character sta data ;Store in data area rdat15: mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ret rdata2: cpi 'F' ;Start of file? jnz rdata3 ; No, try next type. lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdat21 ;If not proceed. lxi d,ermes5 call error3 ;Display err msg. jmp abort ;Change the state to abort. rdat21: call tryagn ret rdata3: cpi 'Z' ;Is it a EOF packet? jnz rdata4 ;Try and see if its an error. call compp jnz nak0 ;No, NAK it and try again. call countp lda argblk+1 ;Get the data length cpi 1 ;Have one item? jnz rdat33 ;If not, ignore data lda data ;Yes, get the character cpi 'D' ;Is it a 'D' for discard? jz rdat36 ;If so, punt file rdat33: call clofil ;Finish off the file. jmp rdat37 ; Give up if the disk is full. xra a ;Since we kept the file, sta czseen ;don't say it was discarded. rdat36: lda numtry ;Get the number of tries. sta oldtry ;Save it. call ackp mvi a,'F' sta state ret rdat37: lxi d,erms11 ; "?Disk full" call error3 ; put it on the error line jmp abort ; abort transfer rdata4: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; SEND command ; here from: kermit send: mvi a,cmifi ;Parse an input file spec. lxi d,fcb ;Give the address for the FCB. call comnd jmp kermit ; Give up on bad parse. call cfmcmd call mfname ;handle (multi) files jnc send14 ;got a valid file-name lxi d,erms15 call prtstr ;Display error msg. ([hh] where it's visible) jmp kermit send14: call init ;Clear the line and initialize the buffers. xra a sta pktnum ;Set the packet number to zero. sta numtry ;Set the number of tries to zero. sta wrn8 ;[jd] we haven't sent the 8-bit-lost warning lxi h,0 shld numpkt ;Set the number of packets to zero. shld numrtr ;Set the number of retries to zero. call scrnrt ;Position cursor lxi h,0 call nout ;Write the number of retries. mvi a,'1' ;Reset to use single character checksum sta curchk ;For startup mvi a,'S' sta state ;Set the state to receive initiate. ;... ; ;SEND state table switcher send2: call scrnp ;Position cursor lhld numpkt call nout ;Write the packet number. lda state ;Get the state. cpi 'D' ;Are we in the data send state? jnz send3 call sdata jmp send2 send3: cpi 'F' ;Are we in the file send state? jnz send4 call sfile ;Call send file. jmp send2 send4: cpi 'Z' ;Are we in the EOF state? jnz send5 call seof jmp send2 send5: cpi 'S' ;Are we in the send initiate state? jnz send6 call sinit lda state ;[jd] get state back cpi 'F' ;[jd] into file send state yet? jnz send2 ;[jd] no lxi d,inms23 ;[jd] yes, print sending... call finmes ;[jd] jmp send2 send6: cpi 'B' ;Are we in the eot state? jnz send7 call seot jmp send2 send7: cpi 'C' ;Are we in the send complete state? jnz send8 ;No... lxi d,infms3 ;Yes, write "Complete" message. lda czseen ;Or was it interrupted? ora a ; . . . jz send7a ;No. lxi d,inms13 ;Yes, then say "Interrupted" instead. send7a: call finmes jmp kermit send8: cpi 'A' ;Are we in the send "abort" state? jnz send9 lxi d,infms4 ;Print message. call finmes jmp kermit send9: lxi d,infms4 ;Anything else is equivalent to "abort". call finmes jmp kermit ; ; Send routines ; Send initiate ; called by: send sinit: lda numtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm sinit2 lxi d,erms14 call error3 ;Display ermsg jmp abort ;Change the state to abort. sinit2: inr a ;Increment it. sta numtry ;Save the updated number of tries. mvi a,'1' ;Reset to use single character checksum sta curchk ;For startup lda chktyp ;Get our desired block check type sta inichk ;Store so we tell other end lxi h,data ;Get a pointer to our data block. call rpar ;Set up the parameter information. sta argblk+1 ;Save the number of arguments. lda numpkt ;Get the packet number. sta argblk mvi a,'S' ;Send initiate packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sinit3 ;If not try next. call compp rnz ;If not try again. call countp lda argblk+1 ;Get the number of pieces of data. lxi h,data ;Pointer to the data. call spar ;Read in the data. lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda inichk ;Get the agreed upon block check type sta curchk ;Store as type to use for packets now mvi a,'F' ;Set the state to file send. sta state call getfil ;Open the file. ret ; assume success; mfname thinks the file exists. sinit3: cpi 'N' ;NAK? jnz sinit4 ;If not see if its an error. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not assume its for this packet, go again. xra a sta numtry ;Reset number of tries. mvi a,'F' ;Set the state to file send. sta state ret sinit4: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send file header ; called by: send sfile: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm sfile1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. sfile1: inr a ;Increment it. sta numtry ;Save the updated number of tries. xra a ;Clear A sta czseen ;No control-Z or X seen lxi h,data ;Get a pointer to our data block. shld datptr ;Save it. lxi h,fcb+1 ;Pointer to the file name in the FCB. shld fcbptr ;Save position in FCB. mvi b,0 ;No chars yet. mvi c,0 sfil11: mov a,b cpi 8H ;Is this the ninth char? jnz sfil12 ;If not proceed. mvi a,'.' ;Get a dot. lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr c sfil12: inr b ;Increment the count. mov a,b cpi 0CH ;Twelve? jp sfil13 lhld fcbptr mov a,m ani 7fH ;Turn off CP/M 2 or 3's high bits. inx h shld fcbptr ;Save position in FCB. cpi '!' ;Is it a good character? jm sfil11 ;If not get the next. lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr c jmp sfil11 ;Get another. sfil13: mov a,c ;Number of char in file name. sta argblk+1 lhld datptr mvi a,'$' mov m,a ;Put in a dollar sign for printing. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr lda pktnum ;Get the packet number. sta argblk mvi a,'F' ;File header packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sfile2 ;If not try next. call compp rnz ;If not hold out for the right one. sfil14: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. call gtchr ;Fill the first data packet jmp sfil16 ;Error go see if its EOF. ; ;Got the chars, proceed. sta size ;Save the size of the data gotten. mvi a,'D' ;Set the state to data send. sta state ret sfil16: cpi 0FFH ;Is it EOF? jnz abort ;If not give up. mvi a,'Z' ;Set the state to EOF. sta state ret sfile2: cpi 'N' ;NAK? jnz sfile3 ;Try if error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp sfil14 ;Just as good as a ACK;go to the ACK code. sfile3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send data ; called by: send sdata: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm sdata1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. sdata1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lxi h, data ;Get a pointer to our data block. shld datptr ;Save it. lxi h,filbuf ;Pointer to chars to be sent. shld cbfptr ;Save position in char buffer. mvi b,1 ;First char. sdat11: lhld cbfptr mov a,m inx h shld cbfptr ;Save position in char buffer. mov c,a ;[jd] preserve character temporarily lda quot8 ;[jd] doing eighth-bit quoting? ora a ;[jd] mov a,c ;[jd] restore char jnz sdat4 ;[jd] using eighth-bit quoting, no warning lda parity ;[jd] get parity cpi parnon ;[jd] none? mov a,c ;[jd] restore character jz sdat4 ;[jd] no parity, leave char alone lda wrn8 ;[jd] look at warning flag ora a ;[jd] have we already given the warning? jnz sdat5 ;[jd] yes, skip this mov a,c ;[jd] restore character... ani 80h ;[jd] examine parity jz sdat5 ;[jd] no parity, no warning. call parwrn ;[jd] ...print warning - parity lost mvi a,0ffh ;[jd] remember that we sent the message sta wrn8 ;[jd] sdat5: mov a,c ;[jd] restore character again ani 7fh ;[jd] strip parity so not checksummed sdat4: lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr b ;Increment the count. lda size ;Get the number of chars in char buffer. cmp b ;Have we transfered that many? jp sdat11 ;If not get another. lda size ;Number of char in char buffer. sta argblk+1 lda pktnum ;Get the packet number. sta argblk mvi a,'D' ;Data packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sdata2 ;If not try next. call compp rnz ;If not hold out for the right one. lda argblk ;Get the packet number back call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda argblk+1 ;Get the data length cpi 1 ;Check if only 1 character? jnz sdat15 ;If not, just continue lda data ;Got one character, get it from data cpi 'Z' ;Want to abort entire stream? jnz sdat14 ;If not, check for just this file sta czseen ;Yes, remember it sdat14: cpi 'X' ;Desire abort of current file? jnz sdat15 ;If not, just continue sta czseen ;Yes, remember that sdat15: lda czseen ;Also get control-Z flag ora a ;Check if either given jz sdat12 ;If neither given, continue mvi a,'Z' ;Change state to EOF sta state ; . . . ret ;And return sdat12: call gtchr jmp sdat13 ;Error go see if its EOF. sta size ;Save the size of the data gotten. ret sdat13: cpi 0FFH ;Is it EOF? jnz abort ;If not give up. mvi a,'Z' ;Set the state to EOF. sta state ret sdata2: cpi 'N' ;NAK? jnz sdata3 ;See if is an error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp sdat12 ;Just as good as a ACK;go to the ACK code. sdata3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send EOF ; called by: send seof: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm seof1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. seof1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lda pktnum ;Get the packet number. sta argblk xra a sta argblk+1 ;No data. lda czseen ;Check if C-Z or C-X typed ora a ; . . . jz seof14 ;If not aborted, just keep going mvi a,'D' ;Tell other end to discard packet sta data ;Store in data portion mvi a,1 ;One character sta argblk+1 ;Store the length seof14: mvi a,'Z' ;EOF packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz seof2 ;If not try next. call compp rnz ;If not hold out for the right one. seof12: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. mvi c,closf ;Close the file. lxi d,fcb call bdos ;* Check if successful lda czseen ;Desire abort of entire stream? cpi 'Z' ;Desire abort of entire stream? jz seof13 ;If so, just give up now call mfname ;Get the next file. jc seof13 ; No more. call getfil ;and open it (assume success) xra a ;Clear A sta czseen ;Since we have not aborted this file mvi a,'F' ;Set the state to file send. sta state ret seof13: mvi a,'B' ;Set the state to EOT. sta state ret seof2: cpi 'N' ;NAK? jnz seof3 ;Try and see if its an error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp seof12 ;Just as good as a ACK;go to the ACK code. seof3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send EOT ; called by: send seot: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm seot1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. seot1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lda pktnum ;Get the packet number. sta argblk xra a sta argblk+1 ;No data. mvi a,'B' ;EOF packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz seot2 ;If not try next. call compp rnz ;If not hold out for the right one. seot12: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. mvi a,'C' ;Set the state to file send. sta state ret seot2: cpi 'N' ;NAK? jnz seot3 ;Is it error. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp seot12 ;Just as good as a ACK;go to the ACK code. seot3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; This routine sets up the data for init packet (either the ; Send_init or ACK packet). ; called by: rinit, rfile, sinit rpar: lda rpsiz ;Get the receive packet size. adi ' ' ;Add a space to make it printable. mov m,a ;Put it in the packet. inx h ;Point to the next char. lda rtime ;Get the receive packet time out. adi ' ' ;Add a space. mov m,a ;Put it in the packet. inx h lda rpad ;Get the number of padding chars. adi ' ' mov m,a inx h lda rpadch ;Get the padding char. adi 100O ;Uncontrol it. ani 7FH mov m,a inx h lda reol ;Get the EOL char. adi ' ' mov m,a inx h lda rquote ;Get the quote char. mov m,a inx h mvi m,'Y' ;[jd] we know how to do 8-bit quoting lda parity ;[jd] cpi parnon ;[jd] parity none? jz rpar1 ;[jd] yes, keep going lda qbchr ;[jd] no, better request 8-bit quoting mov m,a rpar1: inx h ;Advance to next lda chktyp ;Get desired block check type mov m,a ;Store it inx h ;Advance pointer mvi a,08H ;Six pieces of data. ret ; ; This routine reads in all the send_init packet information. ; called by: rinit, sinit spar: sta temp4 ;Save the number of arguments. ; Initialize some variables to their required default values, so we use ; the right values even if the remote Kermit doesn't send the full packet: ; ; we don't do anything with timeout values yet. ; ; no default pad count/pad character? mvi a,cr ; EOL character = carriage-return sta seol mvi a,'#' ; quote character = '#' sta squote mvi a,'&' ; eighth-bit quote character = '&' sta qbchr mvi a,'1' ; block-check = 1-character-checksum sta inichk ; mov a,m ;Get the max packet size. sbi ' ' ;Subtract a space. sta spsiz ;Save it. lda temp4 cpi 3 ;Fewer than three pieces? rm ;If so we are done. inx h inx h ;Increment past the time out info. mov a,m ;Get the number of padding chars. sbi ' ' sta spad lda temp4 cpi 4 ;Fewer than four pieces? rm ;If so we are done. inx h mov a,m ;Get the padding char. adi 100O ;Re-controlify it. ani 7FH sta spadch lda temp4 cpi 5 ;Fewer than five pieces? rm ;If so we are done. inx h mov a,m ;Get the EOL char. sbi ' ' sta seol lda temp4 cpi 6 ;Fewer than six pieces? rm ;If so we are done. inx h mov a,m ;Get the quote char. sta squote lda temp4 ;Get the amount of data supplied cpi 7 ;Have an 8-bit quote? rm ;If not there, all done inx h ;Yes, get the character mvi a,0 ;[jd] sta quot8 ;[jd] assume not quoting mov a,m ;Get the supplied character cpi 'N' ;[jd] No? jz spar1 ;[jd] then don't try to do it cpi ' ' ;[jd] maybe they don't know about it... jz spar1 ;[jd] then don't try to do it. cpi 'Y' ;[jd] Yes? jnz spar2 ;[jd] if not 'Y', assume it's a quote char. lda parity ;[jd] using parity? cpi parnon ;[jd] no, don't need quoting... jz spar1 ;[jd] mvi a,0ffh ;[jd] else turn on... sta quot8 ;[jd] ...quote flag jmp spar1 spar2: sta qbchr ;[jd] use their quote char (should validate) mvi a,0ffh sta quot8 ;[jd] turn quote flag and fall thru... spar1: lda temp4 ;Determine if block check type given cpi 8 ;Is the field there? rm ;If not, all done inx h ;Point to the character mov a,m ;Get the value mov b,a ;Copy value lda chktyp ;Get our type cmp b ;Is it our desired type? rnz ; If not, use default (1-character-checksum) sta inichk ; Match, store as type to use after init ret ; and return ; ; Copy characters from packet to disk ; called by: rdata ptchr: sta temp1 ;Save the size. lxi h,data ;Beginning of received packet data. shld outpnt ;Remember where we are. lda rquote mov b,a ;Keep the quote char in b. mvi c,0 ;[jd] assume no 8-bit quote char lda quot8 ;[jd] doing 8-bit quoting? ora a jz ptchr1 ;[jd] no, keep going lda qbchr ;[jd] else get 8-bit quote char mov c,a ;[jd] keep this in c ptchr1: lxi h,temp1 dcr m ;Decrement # of chars in packet. jm rskp ;Return successfully if done. lxi h,chrcnt ;Number of chars remaining in dma. dcr m ;Decrement. jp ptchr2 ;Continue if space left. call outbuf ;Output it if full. jmp ptchr9 ; Error return if disk is full. ptchr2: lhld outpnt ;Get position in output buffer. mov a,m ;Grab a char. inx h shld outpnt ;and bump pointer. mvi e,0 ;[jd] assume nothing to OR in. cmp c ;[jd] is it the binary quote char? jnz ptch2a ;[jd] no, keep going mvi e,80h ;[jd] include parity bit lda temp1 dcr a sta temp1 ;[jd] decrement character count mov a,m ;[jd] get next character inx h shld outpnt ptch2a: cmp b ;Is it the quote char? jnz ptchr3 ;[jd] changed to ptchr3 so includes parity mov a,m ;Get the quoted character inx h shld outpnt ;and bump pointer. lxi h,temp1 dcr m ;Decrement # of chars in packet. mov d,a ;Save the char. ani 80H ;Turn off all but the parity bit. ora e ;[jd] let parity come from either (???) mov e,a ;Save the parity bit. mov a,d ;Get the char. ani 7FH ;Turn off the parity bit. cmp b ;Is it the quote char? jz ptchr3 ;If so just go write it out. cmp c ;[jd] maybe it's the 8-bit prefix character? jz ptchr3 ;[jd] then don't controllify. mov a,d ;Get the char. adi 40H ;Make the character a control char again. ani 7FH ;Modulo 128. ptchr3: ora e ;Or in the parity bit. lhld bufpnt ;Destination buffer. mov m,a ;Store it. inx h shld bufpnt ;Update the pointer jmp ptchr1 ;and loop to next char. ptchr9: lxi d,erms11 ; "?Disk full" call error3 ; put it on the error line ret ; take error return. ; ; Fill a data packet from file ; called by: sfile, sdata gtchr: lda squote ;Get the quote char. mov c,a ;Keep quote char in c. lda curchk ;Get current block check type sui '1' ;Get the extra overhead mov b,a ;Get a copy lda spsiz ;Get the maximum packet size. sui 5 ;Subtract the overhead. sub b ;Determine max packet length sta temp1 ;This is the number of chars we are to get. lxi h,filbuf ;Where to put the data. shld cbfptr ;Remember where we are. mvi b,0 ;No chars. gtchr1: lda temp1 dcr a ;Decrement the number of chars left. jp gtchr2 ;Go on if there is more than one left. mov a,b ;Return the count in A. jmp rskp gtchr2: sta temp1 lda chrcnt ;Space left in the DMA. dcr a ;* Can improve order here. jm gtchr3 sta chrcnt jmp gtchr4 gtchr3: call inbuf ;Get another buffer full. jmp gtch30 ; If no more return what we got. jmp gtchr4 ;If we got some, proceed. gtch30: mov a,b ;Return the count in A. ora a ;Get any chars? jnz rskp ;If so return them. jmp gtceof ;If not, say we found the end of the file. gtchr4: lhld bufpnt ;Position in DMA. mov a,m ;Get a char from the file. inx h shld bufpnt mov d,a ;Save the char. ani 80H ;Turn off all but parity. mov e,a ;Save the parity bit. jz gtch4a ;[jd] no parity, skip this check... lda quot8 ;[jd] doing eighth-bit quoting? ora a jz gtch4a ;[jd] no, just proceed normally lda temp1 ;[jd] get space remaining cpi 2 ;[jd] 3 chrs left (one cnted already)? jm gtchr9 ;[jd] no, skip this dcr a ;[jd] decrement space remaining sta temp1 ;[jd] put back. lhld cbfptr ;[jd] Position in character buffer. lda qbchr ;[jd] get quote character mov m,a ;]jd] Put the quote char in the buffer. inx h ;[jd] increment destination buffer pointer shld cbfptr ;[jd] store the pointer back inr b ;[jd] Increment the char count. mvi e,0 ;[jd] no parity bit to OR in. ;[jd] fall thru... gtch4a: mov a,d ;Restore the char. ani 7FH ;Turn off the parity. mov d,a ;[jd] save here for later... cpi ' ' ;Compare to a space. jm gtchr5 ;If less then its a control char, handle it. cpi del ;Is the char a delete? jz gtchr5 ;Go quote it. lda quot8 ; Are we doing 8th-bit quoting? ora a jz gtch4c ; if not, skip this test and restore character. lda qbchr ; get 8th-bit quote character cmp d ; same as current character? jz gtch4b ; yes, have to quote it... gtch4c: mov a,d ; no. get character back again. cmp c ;Is it the quote char? jnz gtchr8 ;If not proceed. gtch4b: lxi h,temp1 ;[jd] point to char count dcr m ;[jd] decrement (know room for at least one) lhld cbfptr ;Position in character buffer. mov m,c ;Put the (quote) char in the buffer. inx h shld cbfptr inr b ;Increment the char count. mov a,d ;[jd] restore character again jmp gtchr8 gtchr5: ora e ;Turn on the parity bit. cpi ('Z'-100O) ;Is it a ^Z? jnz gtchr7 ;If not just proceed. lda cpmflg ;Was the file created by CPM... cpi 1 ;in ASCII-mode ? jz gtch52 ;Control-Z stops text cpi 2 ;in BINARY mode? jz gtchr6 ;Yes, pass the ^Z ;At this point file-mode is DEFAULT. ;If the rest of the record is filled with ^Zs, we're at EOF, otherwise ;its a regular character. lhld bufpnt ;since CHRCNT is ZERO at EOF-time lda chrcnt ;(set by INBUF5 B.G.E) mov d,a ;Get the number of chars left in the DMA. gtch51: dcr d mov a,d jp gtch53 ;Any chars left? gtch52: xra a ;If not, get a zero. sta chrcnt ;Say no more chars in buffer. mov a,b ;Return the count in A. jmp rskp ;Scan rest of buffer for non ^Z -- If we find a non ^Z, fall into gtchr6. ;If we get to the end of the buffer before finding a non ^Z, fall into gtch52. gtch53: mov a,m ;Get the next char. inx h ;Move the pointer. cpi ('Z'-100O) ;Is it a ^Z? jz gtch51 ;If so see if the rest are. gtchr6: mvi a,('Z'-100O) ;Restore the ^Z. gtchr7: sta temp2 ;Save the char. lxi h,temp1 ;Point to the char total remaining. dcr m ;Decrement it. lhld cbfptr ;Position in character buffer. mov m,c ;Put the quote in the buffer. inx h shld cbfptr inr b ;Increment the char count. lda temp2 ;Get the control char back. adi 40H ;Make the non-control. ani 7fH ;Modulo 200 octal. gtchr8: lhld cbfptr ;Position in character buffer. ora e ;Or in the parity bit. mov m,a ;Put the char in the buffer. inx h shld cbfptr inr b ;Increment the char count. jmp gtchr1 ;Go around again. gtchr9: ;[jd] not enough room left in buffer... lhld bufpnt dcx h shld bufpnt ;[jd] back up over last character lxi h,chrcnt ;[jd] point to character count inr m ;[jd] increment it mov a,b ;[jd] count of chars transferred jmp rskp ;[jd] return it gtceof: mvi a,0FFH ;Get a minus one. ret ; ; Get the file name (including host to micro translation) ; called by: rfile gofil: lxi h,data ;Get the address of the file name. shld datptr ;Store the address. lxi h,fcb+1 ;Address of the FCB. shld fcbptr ;Save it. xra a sta temp1 ;Initialize the char count. sta temp2 sta fcb ;Set the drive to default to current. mvi b,' ' gofil1: mov m,b ;Blank the FCB. inx h inr a cpi 0CH ;Twelve? jm gofil1 gofil2: lhld datptr ;Get the NAME field. mov a,m cpi 'a' ;Force upper case jm gofl2a ; ani 5FH ; gofl2a: inx h cpi '.' ;Seperator? jnz gofil3 shld datptr ;[jd] update ptr (moved from above) lxi h,fcb+9H shld fcbptr lda temp1 sta temp2 mvi a,9H sta temp1 jmp gofil6 gofil3: ora a ;Trailing null? jz gofil7 ;Then we're done. shld datptr ;[jd] no, can update ptr now. lhld fcbptr mov m,a inx h shld fcbptr lda temp1 ;Get the char count. inr a sta temp1 cpi 8H ;Are we finished with this field? jm gofil2 gofil4: sta temp2 lhld datptr mov a,m inx h shld datptr ora a jz gofil7 cpi '.' ;Is this the terminator? jnz gofil4 ;Go until we find it. gofil6: lhld datptr ;Get the TYPE field. mov a,m cpi 'a' ;Force upper case jm gofl6a ; ani 5FH ; gofl6a: ora a ;Trailing null? jz gofil7 ;Then we're done. ;[jd] move above two lines so we don't increment pointer if char is null inx h shld datptr lhld fcbptr mov m,a inx h shld fcbptr lda temp1 ;Get the char count. inr a sta temp1 cpi 0CH ;Are we finished with this field? jm gofil6 gofil7: lhld datptr mvi m,'$' ;Put in a dollar sign for printing. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr lda flwflg ;Is file warning on? ora a jz gofil9 ;If not, just proceed. mvi c,openf ;See if the file exists. lxi d,fcb call bdos cpi 0FFH ;Does it exist? jz gofil9 ;If not create it. lxi d,infms5 call error3 lda temp2 ;Get the number of chars in the file name. ora a jnz gofil8 lda temp1 sta temp2 gofil8: mvi b,0 mov d,b ;Zero d for dad index into filename inr a ;Replace next character after filename cpi 9H ;Is the first field full? jnz gofl80 mvi b,0FFH ;Set a flag saying so. dcr a gofl80: mov e,a ;Keep current, replace index in d,e. gofl81: lxi h,fcb ;Get the FCB. dad d ;Add in the character number. mvi m,'&' ;Replace the char with an ampersand. push b push d lxi h,fcb ;Trim off any CP/M 2.2 attribute bits mvi c,1+8+3 ;so they do not affect the new file gofl82: mov a,m ; ani 7FH ; mov m,a ; inx h ; dcr c ; jnz gofl82 ; mvi c,openf ;See if the file exists. lxi d,fcb call bdos pop d pop b cpi 0FFH ;Does it exist? jz gofl89 ;If not create it. mov a,b ;Get the field-full flag. ora a ;Incr. or decr. ? jz gofl83 ;Jump if increment dcr e ;Decrement the number of chars. mov a,e ora a jz gofl88 ;If no more, die. jmp gofl81 gofl83: inr e ;Increment the number of chars. mov a,e cpi 9H ;Are we to the end? jm gofl81 ;If not try again. lda temp2 ;Get the original size. mov e,a mvi b,0FFH ;Set flag saying field-full, decrement jmp gofl81 gofl88: lxi d,erms16 ;Tell user that we can't rename it. call prtstr ret gofl89: mvi c,8 ;[jd] # of chars in name lxi d,fnbuf ;[jd] point to destination lxi h,fcb+1 ;[jd] source of name mvi b,0 ;[jd] first-time-thru flag gof89a: mov a,m ;[jd] get a char from the name inx h ;[jd] pass it cpi ' ' ;[jd] end of this part of name? jz gof89b ;[jd] yes, skip rest... stax d ;[jd] else drop char off inx d ;[jd] increment dest ptr dcr c ;[jd] decrement count jnz gof89a ;[jd] and continue if more to go gof89b: mov a,b ;[jd] ora a ;[jd] first time thru? jnz gof89c ;[jd] no, no period mvi a,'.' ;[jd] period between parts stax d ;[jd] inx d ;[jd] mvi b,0ffh ;[jd] not first time thru anymore mvi c,3 ;[jd] length of this part lxi h,fcb+9 ;[jd] start of extension jmp gof89a ;[jd] keep copying gof89c: mvi a,'$' stax d ;[jd] end the name string lxi d,fnbuf ;[jd] Print the file name call prtstr gofil9: call makfil ; Create the file. jmp gofl91 ; Disk was full. jmp rskp ; Success. gofl91: lxi d,erms11 call error3 ret ; ; This is the FINISH command. It tells the remote KERSRV to exit. ; here from kermit finish: call cfmcmd xra a sta numtry ;Inititialize count. mvi a,'1' ;Reset block check type to single character sta curchk ; . . . finsh1: lda numtry ;How many times have we tried? cpi maxtry ;Too many times? jm finsh3 ;No, try it. finsh2: lxi d,erms18 ;Say we couldn't do it. call prtstr jmp kermit ;Go home. finsh3: inr a ;Increment the number of tries. sta numtry xra a sta argblk ;Make it packet number zero. mvi a,1 sta argblk+1 ;One piece of data. lxi h,data mvi m,'F' ;Finish running Kermit. mvi a,'G' ;Generic command packet. call spack jmp finsh2 ; Tell the user and die. call rpack ;Get an acknowledgement. jmp finsh1 ; Go try again. cpi 'Y' ;ACK? jz kermit ;Yes, we are done. cpi 'E' ;Is it an error packet? jnz finsh1 ;Try sending the packet again. call error1 ;Print the error message. jmp kermit ; ; This is the LOGOUT command. It tells the remote KERSRV to logout. ; here from: kermit logout: call cfmcmd call logo ;Send the logout packet. jmp kermit ;Go get another command jmp kermit ; whether we succeed or not. ; do logout processing. ; called by: bye, logout logo: xra a sta numtry ;Inititialize count. mvi a,'1' ;Reset block check type to single character sta curchk ; . . . logo1: lda numtry ;How many times have we tried? cpi maxtry ;Too many times? jm logo3 ;No, try it. logo2: lxi d,erms19 ;Say we couldn't do it. call prtstr ret ;Finished. logo3: inr a ;Increment the number of tries. sta numtry xra a sta argblk ;Make it packet number zero. mvi a,1 sta argblk+1 ;One piece of data. lxi h,data mvi m,'L' ;Logout the remote host. mvi a,'G' ;Generic command packet. call spack jmp logo2 ; Tell the user and die. call rpack ;Get an acknowledgement jmp logo1 ; Go try again. cpi 'Y' ;ACK? jz rskp ;Yes, we are done. cpi 'E' ;Is it an error packet? jnz logo1 ;Try sending the packet again. call error1 ;Print the error message. ret ;All done. ; ; Packet routines ; Send_Packet ; This routine assembles a packet from the arguments given and sends it ; to the host. ; ; Expects the following: ; A - Type of packet (D,Y,N,S,R,E,F,Z,T) ; ARGBLK - Packet sequence number ; ARGBLK+1 - Number of data characters ; Returns: nonskip if failure ; skip if success ; called by: read, rinit, rfile, rdata, sinit, sfile, sdata, seof, seot, ; finish, logout, nak, ackp spack: sta argblk+2 lxi h,packet ;Get address of the send packet. mvi a,soh ;Get the start of header char. mov m,a ;Put in the packet. inx h ;Point to next char. lda curchk ;Get current checksum type sui '1' ;Determine extra length of checksum mov b,a ;Copy length lda argblk+1 ;Get the number of data chars. adi ' '+3 ;Real packet character count made printable. add b ;Determine overall length mov m,a ;Put in the packet. inx h ;Point to next char. lxi b,0 ;Zero the checksum AC. mov c,a ;Start the checksum. lda argblk ;Get the packet number. adi ' ' ;Add a space so the number is printable. mov m,a ;Put in the packet. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A (Cannot be XRA A, since we can't ; touch carry flag) adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk+2 ;Get the packet type. mov m,a ;Put in the packet. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B spack2: lda argblk+1 ;Get the packet size. ora a ;Are there any chars of data? jz spack3 ; No, finish up. dcr a ;Decrement the char count. sta argblk+1 ;Put it back. mov a,m ;Get the next char. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B jmp spack2 ;Go try again. spack3: lda curchk ;Get the current checksum type cpi '2' ;Two character? jz spack4 ;Yes, go handle it jnc spack5 ;No, go handle CRC if '3' mov a,c ;Get the character total. ani 0C0H ;Turn off all but the two high order bits. ;Shift them into the low order position. rlc ;Two left rotates same as 6 rights rlc ; . . . add c ;Add it to the old bits. ani 3FH ;Turn off the two high order bits. (MOD 64) adi ' ' ;Add a space so the number is printable. mov m,a ;Put in the packet. inx h ;Point to next char. jmp spack7 ;Go store eol character ;Here for 3 character CRC-CCITT spack5: mvi m,0 ;Store a null for current end push h ;Save H lxi h,packet+1 ;Point to first checksumed character call crcclc ;Calculate the CRC pop h ;Restore the pointer mov c,e ;Get low order half for later mov b,d ;Copy the high order mov a,d ;Get the high order portion rlc ;Shift off low 4 bits rlc ; . . . rlc ; . . . rlc ; . . . ani 0FH ;Keep only low 4 bits adi ' ' ;Put into printing range mov m,a ;Store the character inx h ;Point to next position ;Here for two character checksum spack4: mov a,b ;Get high order portion ani 0FH ;Only keep last four bits rlc ;Shift up two bits rlc ; . . . mov b,a ;Copy back into safe place mov a,c ;Get low order half rlc ;Shift high two bits rlc ;to low two bits ani 03H ;Keep only two low bits ora b ;Get high order portion in adi ' ' ;Convert to printing character range mov m,a ;Store the character inx h ;Point to next character mov a,c ;get low order portion ani 3FH ;Keep only six bits adi ' ' ;Convert to printing range mov m,a ;Store it inx h ;Bump the pointer spack7: lda dbgflg ora a ; is debugging enabled? jz spack8 push h ; yes. save address of end of packet mvi m,0 ; null-terminate the packet for display call sppos ; position cursor lxi h,packet+1 ; print the packet call dmptxt pop h ; restore address of end of packet spack8: lda seol ;Get the EOL the other host wants. mov m,a ;Put in the packet. inx h ;Point to next char. xra a ;Get a null. mov m,a ;Put in the packet. ; Write out the packet. outpkt: call selmdm ; Set up for output to comm port if iobyt lda spad ;Get the number of padding chars. sta temp1 outpk2: lda temp1 ;Get the count. dcr a ora a jm outpk6 ;If none left proceed. sta temp1 lda spadch ;Get the padding char. call setpar ;Set parity appropriately mov e,a ;Put the char in right AC. call outmdm ;Output it. jmp outpk2 outpk6: lxi h,packet ; Point to the packet. outlup: mov a,m ; Get the next character. ora a ; Is it a null? jz outlud ; If so return success. call setpar ; Set parity for the character mov e,a ; Put it in right AC call outmdm ; and output it. ; TAC trap: If this character is the TAC intercept character, and the TAC ; trap is enabled, we have to output it twice. If the TAC trap is enabled, ; tacflg contains the intercept character. (The current character cannot ; be NUL, so we don't have to worry about doubling nulls in the message) lda tacflg ; get current intercept character, or zero. cmp m ; compare against current data character. jnz outpk8 ; if different, do nothing. call setpar ; match. set appropriate parity, mov e,a ; put it in the right register, call outmdm ; and output it a second time. outpk8: inx h ; Increment the char pointer. jmp outlup outlud: call selcon ; select console jmp rskp ; and return success ; ; Receive_Packet ; This routine waits for a packet to arrive from the host. It reads ; characters until it finds a SOH. It then reads the packet into packet. ; ; Returns: nonskip if failure (checksum wrong or packet trashed) ; skip if success, with ; A - message type ; ARGBLK - message number ; ARGBLK+1 - length of data ; called by: rinit, rfile, rdata, ; sinit, sfile, sdata, seof, seot, finish, logout rpack: call inpkt ;Read up to the end-of-line character jmp r ; Return bad. rpack0: call getchr ;Get a character. jmp rpack ; Hit eol;null line;just start over. cpi soh ;Is the char the start of header char? jnz rpack0 ; No, go until it is. rpack1: call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta packet+1 ;Store in packet also mov c,a ;Start the checksum. lda curchk ;Get block check type sui '1' ;Determine extra length of block check mov b,a ;Get a copy mov a,c ;Get back length character sui ' '+3 ;Get the real data count. sub b ;Get total length sta argblk+1 mvi b,0 ;Clear high order half of checksum call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta argblk sta packet+2 ;Save also in packet add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk sui ' ' ;Get the real packet number. sta argblk call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta temp1 ;Save the message type. sta packet+3 ;Save in packet add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk+1 ;Get the number of data characters. sta temp2 lxi h,data ;Point to the data buffer. shld datptr rpack2: lda temp2 sui 1 ;Any data characters? jm rpack3 ; If not go get the checksum. sta temp2 call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. lhld datptr mov m,a ;Put the char into the packet. inx h ;Point to the next character. shld datptr add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B jmp rpack2 ;Go get another. rpack3: call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Turn the char back into a number. sta temp3 ;Determine type of checksum lda curchk ;Get the current checksum type cpi '2' ;1, 2 or 3 character? jz rpack4 ;If zero, 2 character jnc rpack5 ;Go handle 3 character mov a,c ;Get the character total. ani 0C0H ;Turn off all but the two high order bits. ;Shift them into the low order position. rlc ;Two left rotates same as six rights rlc ; . . . add c ;Add it to the old bits. ani 3FH ;Turn off the two high order bits. (MOD 64) mov b,a lda temp3 ;Get the real received checksum. cmp b ;Are they equal? jz rpack7 ;If so, proceed. rpack9: call updrtr ;If not, update the number of retries. ret ;Return error. ;Here for three character CRC-CCITT rpack5: lhld datptr ;Get the address of the data mvi m,0 ;Store a zero in the buffer to terminate packet lxi h,packet+1 ;Point at start of checksummed region call crcclc ;Calculate the CRC mov c,e ;Save low order half for later mov b,d ;Also copy high order mov a,d ;Get high byte rlc ;Want high four bits rlc ; . . . rlc ;And shift two more rlc ; . . . ani 0FH ;Keep only 4 bits mov d,a ;Back into D lda temp3 ;Get first value back cmp d ;Correct? jnz rpack9 ;No, punt call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Remove space offset sta temp3 ;Store for later check ;... ;Here for a two character checksum and last two characters of CRC rpack4: mov a,b ;Get high order portion ani 0FH ;Only four bits rlc ;Shift up two bits rlc ; . . . mov b,a ;Save back in B mov a,c ;Get low order rlc ;move two high bits to low bits rlc ; . . . ani 03H ;Save only low two bits ora b ;Get other 4 bits mov b,a ;Save back in B lda temp3 ;Get this portion of checksum cmp b ;Check first half jnz rpack9 ;If bad, go give up call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Remove space offset mov b,a ;Save in safe place mov a,c ;Get low 8 bits of checksum ani 3FH ;Keep only 6 bits cmp b ;Correct value jnz rpack9 ;Bad, give up rpack7: lhld datptr mvi m,0 ;Put a null at the end of the data. lda temp1 ;Get the type. jmp rskp ; ; inpkt - receive and buffer packet ; returns: nonskip if error (timeout) ; skip if success; packet starts at recpkt (which holds the SOH) ; and is terminated by a null. ; console is selected in either case. ; called by: rpack inpkt: lxi h,recpkt ;Point to the beginning of the packet. shld pktptr inpkt1: call inchr ;Get first character jmp r ;Return failure cpi soh ;is it the beginning of a packet? jnz inpkt1 ;if not, ignore leading junk jmp inpkt3 ;else go put it in packet inpkt2: call inchr ;Get a character. jmp r ; Return failure. cpi soh ;is it a new beginning of packet? jnz inpkt3 ;if not continue lxi h,recpkt ;else throw away what we've got so far shld pktptr ; inpkt3: lhld pktptr ; mov m,a ;Put the char in the packet. inx h shld pktptr mov b,a lxi d,-recpkx ;Start over if packet buffer overflow dad d ; jc inpkt ; lda reol ;Get the EOL char. cmp b jnz inpkt2 ;If not loop for another. ;... ;Begin IBM change/fdc ;This moved from OUTPK7 -- it appears that waiting until we're ;ready to send a packet before looking for turnaround character ;is long enough for it to get lost. Better to look now. lda ibmflg ;Is this the IBM? ora a jz inpkt6 ;If not then proceed. lda state ;Check if this is the Send-Init packet. cpi 'S' jz inpkt6 ;If so don't wait for the XON. inpkt5: call inchr ;Wait for the turn around char. jmp inpkt6 cpi xon ;Is it the IBM turn around character? jnz inpkt5 ;If not, go until it is. inpkt6: lhld pktptr ;Reload packet pointer ;End IBM change/fdc. dcx h ;Back up to end of line character mvi m,0 ;Replace it with a null to stop rpack: call selcon ;We've got the packet. Return to console. lda dbgflg ; Is debugging enabled? ora a jz inpkt7 inx h ; Point to next char. call rppos ; position cursor lxi h,recpkt+1 ; print the packet call dmptxt inpkt7: lxi h,recpkt shld pktptr ;Save the packet pointer. jmp rskp ;If so we are done. ; getchr - get next character from buffered packet. ; returns nonskip at end of packet. ; called by: rpack getchr: lhld pktptr ;Get the packet pointer. mov a,m ;Get the char. inx h shld pktptr ora a ;Is it the null we put at the end of the packet? jnz rskp ;If not return retskp. ret ;If so return failure. ; ; ; inchr - character input loop for file transfer ; returns: nonskip if timeout or character typed on console ; (console selected) ; skip with character from modem in A (parity stripped ; if necessary; modem selected) ; preserves bc, de, hl in either case. ; called by: inpkt inchr: push h ; save hl and bc push b lhld timout ;Get initial value for timeout shld timval ;[jd] inchr0: call selmdm ;select modem call inpmdm ;Try to get a character from the modem ora a jz inchr2 ;if zero, nothing there. mov b,a lda parity ;Is the parity none? cpi parnon mov a,b jz inchr1 ;If so just return. ani 7FH ;Turn off the parity bit. inchr1: pop b ;restore registers pop h jmp rskp ;take skip return, character in A inchr2: call selcon ;select console call inpcon ; Try to get a character from the console ora a jz inchr6 ;If not go do timer thing cpi cr ;Is it a carriage return? jz inchr4 ;If so return cpi ('Z'-100O) ;Control-Z? jz inchr5 ;Yes, go flag it cpi ('C'-100O) ;Control-C? jz inchr7 ;re-enter, he wants to get out cpi ('X'-100O) ;Control-X? jnz inchr6 ;No, ignore it. do timer thing. inchr5: adi 100O ;Convert to printing range sta czseen ;Flag we saw a control-Z inchr4: pop b ; restore registers pop h ret ;And return inchr6: lda timflg ;[jd] pick up timer flag ora a ;[jd] are we allowed to use timer? jz inchr0 ;[jd] no, don't time out lhld timval ; decrement fuzzy time-out dcx h ; shld timval ;((timout-1) * loop time) mov a,h ;(Retry if not time-out) ora l ; jnz inchr0 ; call updrtr ;Count as retry (?) pop b ;restore registers pop h ret ;and return to do retry inchr7: call clrtop ;[hh] clear screen and home cursor jmp kermit ;[hh] then re-enter kermit ; ; CRCCLC - Routine to calculate a CRC-CCITT for a string. ; ; This routine will calculate a CRC using the CCITT polynomial for ; a string. ; ; call with: HL/ Address of null-terminated string ; 16-bit CRC value is returned in DE. ; Registers BC and HL are preserved. ; ; called by: spack, rpack crcclc: push h ;Save HL push b ;And BC lxi d,0 ;Initial CRC value is 0 crccl0: mov a,m ;Get a character ora a ;Check if zero jz crccl1 ;If so, all done push h ;Save the pointer xra e ;Add in with previous value mov e,a ;Get a copy ani 0FH ;Get last 4 bits of combined value mov c,a ;Get into C mvi b,0 ;And make high order zero lxi h,crctb2 ;Point at low order table dad b ;Point to correct entry dad b ; . . . push h ;Save the address mov a,e ;Get combined value back again rrc ;Shift over to make index rrc ; . . . rrc ; . . . ani 1EH ;Keep only 4 bits mov c,a ;Set up to offset table lxi h,crctab ;Point at high order table dad b ;Correct entry mov a,m ;Get low order portion of entry xra d ;XOR with previous high order half inx h ;Point to high order byte mov d,m ;Get into D pop h ;Get back pointer to other table entry xra m ;Include with new high order half mov e,a ;Copy new low order portion inx h ;Point to other portion mov a,m ;Get the other portion of the table entry xra d ;Include with other high order portion mov d,a ;Move back into D pop h ;And H inx h ;Point to next character jmp crccl0 ;Go get next character crccl1: pop b ;Restore B pop h ;And HL ret ;And return, DE=CRC-CCITT CRCTAB: DW 00000H DW 01081H DW 02102H DW 03183H DW 04204H DW 05285H DW 06306H DW 07387H DW 08408H DW 09489H DW 0A50AH DW 0B58BH DW 0C60CH DW 0D68DH DW 0E70EH DW 0F78FH CRCTB2: DW 00000H DW 01189H DW 02312H DW 0329BH DW 04624H DW 057ADH DW 06536H DW 074BFH DW 08C48H DW 09DC1H DW 0AF5AH DW 0BED3H DW 0CA6CH DW 0DBE5H DW 0E97EH DW 0F8F7H ; ; This is where we go if we get an error during a protocol communication. ; error prints the error packet on line 6 or so, and aborts the ; transfer. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot ; error1 print CRLF followed by the error packet. ; called by: finish, logout ; error2 just prints the error packet. ; error3 positions cursor and prints error message specified in DE. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, ; seot, parwrn, gofil, outbuf error: call screrr ;Position the cursor. mvi a,'A' ;Set the state to abort. sta state jmp error2 error1: lxi d,crlf ;Print a CRLF. call prtstr error2: lda argblk+1 ;Get the length of the data. mov c,a mvi b,0 ;Put it into BC lxi h,data ;Get the address of the data. dad b ;Get to the end of the string. mvi a,'$' ;Put a dollar sign at the end. mov m,a lxi d,data ;Print error message call prtstr ret error3: push d ;Save the pointer to the message. call screrr ;Position the cursor. pop d ;Get the pointer back. call prtstr ;Print error message ret ; ; Set up for file transfer. ; called by read, send. init: lxi d,version ; point at Kermit's version string call sysscr ; fix up screen call selmdm ; select modem call flsmdm ; purge any pending data call selcon ; select console again. ret ; Set state to ABORT ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot, ; nak, ackp abort: mvi a,'A' ;Otherwise abort. sta state ret ; nak - send NAK packet ; here from: rinit, rfile, rdata ; nak0 - update retry count and send NAK packet ; here from: rinit, rfile, rdata, tryagn nak0: call updrtr ;Update number of retries. nak: lda pktnum ;Get the packet number we're waiting for. sta argblk xra a ;No data. sta argblk+1 mvi a,'N' ;NAK that packet. call spack jmp abort ; Give up. ret ;Go around again. ; increment and display retry count ; called by: rfile, sinit, sfile, sdata, seof, seot, ; nak, rpack, inchr, tryagn updrtr: call scrnrt ;Position cursor lhld numrtr inx h ;Increment the number of retries shld numrtr call nout ;Write the number of retries. ret ; [jd] this routine prints parity warnings. All registers are ; saved except for a. ; called by: sdata parwrn: push b push d push h lxi d,inms25 call error3 pop h pop d pop b ret ;[jd] end of addition ; print message in status field. address of message is in DE. ; called by: read, send finmes: push d ;Save message. call scrst ;Position cursor pop d ;Print the termination message call prtstr call scrend ;Position cursor for prompt ret ; Compare expected packet number against received packet number. ; return with flags set (Z = packet number valid) ; called by: rfile, rdata, sinit, sfile, sdata, seof, seot compp: lda pktnum ;Get the packet Nr. mov b,a lda argblk cmp b ret ; Increment the packet number, modulo 64. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot countp: inr a ;Increment packet Nr. ani 3FH ;Turn off the two high order bits sta pktnum ;Save modulo 64 of number lhld numpkt inx h ;Increment Nr. of packets shld numpkt ret ; Send an ACK-packet ; called by: rfile, rdata, tryagn ackp: xra a sta numtry ;Reset number of retries sta argblk+1 ;No data. (The packet number is in argblk) mvi a,'Y' ;Acknowledge packet call spack ;Send packet jmp abort ret ; ? ; called with A/ current retry count ; called by: rfile, rdata tryagn: inr a ;Increment it. sta oldtry ;Save the updated number of tries. lda pktnum ;Get the present packet number. dcr a ;Decrement ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number cmp b ;Is the packet's number one less than now? jnz nak0 ;No, NAK it and try again. call updrtr ;Update the number of retries. call ackp ret ; Output a null-terminated string to the console. We assume that the ; console has been selected. Called with HL = address of string. ; called by: spack, inpkt dmptxt: mov a,m ; get character from string ora a rz ; done if null push h ; save string address mov e,a ; move character to E for outcon call outcon ; output character to console pop h ; restore string address inx h ; point past printed character jmp dmptxt ; go output rest of string ; IF lasm LINK CP4TT ENDIF;lasm