From ebb2ff2af569d5822b70ee555a32d27cf7494816 Mon Sep 17 00:00:00 2001 From: Jeff Armstrong Date: Sun, 25 Oct 2026 17:42:06 -0400 Subject: Initial import of 4.11 --- src/cpspk2.asm | 1336 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1336 insertions(+) create mode 100644 src/cpspk2.asm (limited to 'src/cpspk2.asm') diff --git a/src/cpspk2.asm b/src/cpspk2.asm new file mode 100644 index 0000000..b246967 --- /dev/null +++ b/src/cpspk2.asm @@ -0,0 +1,1336 @@ +; CPSPK2.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: +; +;edit 11, 21-Mar-1991 by MF. After "inchr7", close TAKE-file (if any) so +; ^C will halt all processing (including commands from TAKE-files) +; and put the user back at Kermit command-level. +;edit 10, 3-Jan-1991 by MF. Modify routine "inchr" after label "inchr5" to +; not take retry (nonskip) return if ^X/^Z seen on the Console. This +; will prevent multiple copies of packets being sent if user aborts +; some files in a stream being sent via ^X and is a better fix to this +; problem than flushing comm input before sending the "Z" packet +; requesting the remote Kermit to discard the current file being +; received (as implemented in CPSPK1.ASM edit of 2-jan-1991). +;edit 9, 14-Dec-1990 by MF. Modified "gofil" routine to allow for +; specification of a drive in the local filespec for GET and +; RECEIVE commands. Thus commands such as +; GET HELLO.TXT B:GOODBYE.TXT +; and +; RECEIVE B:GOODBYE.TXT +; now work as expected. +;edit 8, 22-Oct-1990 by MF. Fixed bug in completion-message routine +; "finmes" wherein the completion message was not printed if the +; terminal was set to QUIET because the message pointer was clobbered +; by prcrlf. +;edit 7, 14-Sep-1990 by MF. Add hooks for SET COLLISION command. +; Eliminate commented-out old file warning rename routine. +; Clear communication input buffers (call flsmdm) before +; BYE, FINISH and LOGOUT commands. +;edit 6, 9-Sep-1990 by MF. Implemented fixes in CPKERM.BWR for +; garbage printout during quiet transfers and for file existence/ +; rename algorithm. +; Also implemented hooks for Remote commands. +; edit 5, 18 June 1990 by Russell Lang [rjl@monu1.cc.monash.edu.au] +; When trying to generate a unique file name on receive, zero +; the attribute bits between file opening attempts. This is +; to fix a bug which caused the unique file name to have the +; attributes of the already existing file. If the attribute +; was R/O, a bdos error occured later when an attempt was made +; to write to the file. +; +; edit 4, 27 October, 1987 By OBSchou. Changed the rename routine to +; be more like the MSDOS issue. +; +; edit 3, 28 July, by OBSchou. Added traps to NOT print to screen during +; file transfers if quietd is non zero (ie we SET TERMINAL QUIET) +; This hopefully speeds up transfers in systems spending an age +; updating the screen. +; +; edit 2, 8 April, 1987 by OBSchou. Minor edit to put drive and user number +; in the "filename" field on the transfer screen. This means that the +; offset on the line foe the file name proper has moved along 4 space. +; Also, it writes 15 spaces AFER the xxd: string to clear the field +; of any prevous file. Needed for thos terminals that cannot +; clear to end of line... +; +; edit 1, 28 January, 1987 by OBSchou. +; Hived off about 1/2 of CPSPKT.ASM to form two (smaller => easier +; to handle) files. +; +; + +pk2ver: db 'CPSPK2.ASM (11) 21-Mar-1991$' ; name, edit number, date + + +; +; Get the file name (including host to micro translation) +; called by: rfile + +gofil: xra a + sta fcb ;Set the drive to default to current. + lxi h,data ;Get the address of the file name. +; allow use of local name if one was given [gnn] + lda remlen ;[gnn] + ora a ;[gnn] anything there? + jz gofil0 ;[gnn] no, use the one in the data packet + lxi h,remnam ;[gnn] yes, use this instead + lda remnam+1 ;[MF]Get 2nd char of local filename + cpi ':' ;[MF]Was a drive specified? + jnz gofil0 ;[MF]No, proceed as of old + mov a,m ;[MF]Yes, get drive + ani 5fh ;[MF]Force uppercase + sui 'A'-1 ;[MF]Make valid drive for fcb + sta fcb ;[MF]and store in fcb + inx h ;[MF]Skip drive and delimiter + inx h ;[MF]... +gofil0: ;[gnn] continue to set up the file [gnn] +; + 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 + mvi b,' ' +gofil1: mov m,b ;Blank the FCB. + inx h + inr a +; cpi 0CH ;Twelve?[5a] + cpi 0BH ; Eleven? [5a] + jm gofil1 + mvi m,0 ; [5a] Specify extent 0 +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. + lda quietd ; quiet display? + ana a + jnz gofi70 ; yes, so skip it. + call scrfln ;Position cursor +gofi70: lxi d,data ;Print the file name + lda getrxflg ;[obs 8] are we doing a get or receive? + ana a ;[obs 8] + jz gofi7a ;[obs 8] if zero, receive + lxi d,remnam ;[obs 8] +gofi7a: ;[obs 8] + + call prtstr +gofi7b: xra a ;[MF]Zero "discard" flag + sta dscflg ;[MF]... + 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. +; + lda flwflg ;[MF]Get flag again + cpi 3 ;[MF]SET COLLISION DISCARD? + jnz gofi7h ;[MF]No + mvi a,0ffh ;[MF]Yes, order rejection of the file + sta dscflg ;[MF]... + jmp rskp ;[MF]and pretend successful open +gofi7h: push psw ;[MF]Save Collision status + lxi d,infms5 + call error3 + pop psw ;[MF]Restore Collision status + cpi 1 ;[MF]SET COLLISION RENAME? + jz gofi7i ;[MF]Yes, same as SET WARNING ON + ;[MF]If we come here, SET COLLISION BACKUP + lxi h,fcb ;[MF]Copy original fcb to a safe place + lxi d,colfcb ;[MF]... + lxi b,33 ;[MF]... + call mover ;[MF]... + ;[MF]and fall into rename code +gofi7i: ;[MF] +; +; Replacement file name renamer routine. Incomming +; files are renamed in this manner: +; original file name: filex.ext +; first rename: filex001.ext +; ... ... +; ninth rename filex009.ext +; 10th rename fail - would we really want 10 +; files of the same name?? +; +; +; 1) +; Assume that we need to "rename" the file, so lets make sure +; that there is a full. 8 character filename. (We make it if +; it does not already exist) +; 1a) If full file name, last character is to be replaced +; by a zero. This gives us up to no#ine renames. +; 2)open file +; 2a)If exists, increment last character by one +; 2b)if = '9' then abort +; 2c)If does not exist, got 2) +; 3)we have a valid 'renamed' file +; +;Part 1) - fill out filename part + + mvi c,8 ; max 8 characters to test for + mvi a,'0' ; spaces to be replaced by a zero. + lxi h,fcb+8 ; start at the end +gofi7c: mov m,a ; put a zero in here + dcr c ; come to the end? + jz gofi7d ; should not have, but just in case... + dcx h ; previous chararcter + mov a,m ; get it + cpi ' ' ; if this character a space as well, zero it + mvi a,'0' ; set it to ascii zero just in case... + jz gofi7c ; +; +; Part 2) open the file (if success, then it exists) + +gofi7d: +;zero the attribute bits. [rjl@monu1.cc.monash.edu.au] + lxi h,fcb+1 ;[rjl] + mvi c,11 ;[rjl] +gofi7z: mov a,m ;[rjl] + ani 07fh ;[rjl] + mov m,a ;[rjl] + inx h ;[rjl] + dcr c ;[rjl] + jnz gofi7z ;[rjl] + lxi d,fcb + mvi c,openf + call BDOS + inr a ; if 0ffh returned, error (ie does not exist) + jz gofi7e + lda fcb+8 ; get last character + inr a + sta fcb+8 + cpi '9'+1 ; more than '9' => too far, lets give up. + jnz gofi7d ; else try again +;Giving up, so lets exit + lxi d,erms16 ; + call prtstr + ret ; return to error routine + +gofi7e: lxi d,fnbuf ; make the file name into a character string + lxi h,fcb+1 ; point to source file name, less drive name + mvi c,8 ; 11 characters (8+3) + dot to copy across +; +gofi7f: mov a,m ; get character + stax d + inx h + inx d + dcr c + jnz gofi7f ; loop until all done + + mvi a,'.' ; then the dot + stax d + inx d + + mvi c,3 ; then the file extention + +gofi7g: mov a,m + stax d + inx h + inx d + dcr c + jnz gofi7g ; loop until extention copied across + + mvi a,'$' ; dollar terminate string + stax d + lxi d,fnbuf ;[MF]Point to string + call prtstr ; write string to console + + lda flwflg ;[MF]Get warning (SET COLLISION) flag + cpi 2 ;[MF]SET COLLISION BACKUP? + jnz gofil9 ;[MF]No + lxi h,fcb ;[MF]Yes, get new filename fcb + lxi d,colfcb+16 ;[MF]Where to copy to for rename + lxi b,16 ;[MF]Copy 16 bytes + call mover ;[MF]... + lxi d,colfcb ;[MF]Point to rename fcb + mvi c,renam ;[MF]Rename function + call bdos ;[MF]Try to rename original file + cpi 0ffh ;[MF]Did we win? + jnz gofl82 ;[MF]Yes + lxi d,erms16 ;[MF]No, complain and bomb + jmp error3 ;[MF]... +gofl82: lxi h,colfcb ;[MF]Now recopy original filename into fcb + lxi d,fcb ;[MF]to create new file with original name + lxi b,16 ;[MF]... + call mover ;[MF]... +; +; +;Now lets make the file (create it) + +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 + call selmdm ;[MF]Select modem + call flsmdm ;[MF]Flush buffers + call selcon ;[MF]Select keyboard again + 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: call selmdm ;[MF]Select modem + call flsmdm ;[MF]Flush buffers + call selcon ;[MF]Select keyboard again + 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. + lda sndsop ;[gnn] send start-of-pkt 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 + lda quietd ; a quiet display? + ana a + jnz spac7a ; so dont say a thing + call sppos ; position cursor + lxi h,packet+1 ; print the packet + call dmptxt + lda prnflg ; is the printer on too? + ana a + jz spac7a + lxi h,sstatm ; print state + call printm ; dumptext but to printer + lda state + mov e,a + call outprn + lxi h,princr ; cr lf to printer + call printm + lxi h,spackm + call printm + lxi h,packet+1 + call printm + lxi h,princr + call printm + lxi h,princr + call printm + +spac7a: 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + jnz rpack0 ; No, go until it is. +rpack1: call getchr ;Get a character. + jmp r ; Hit end of line, return bad. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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 + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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. + lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char. + cmp m ;[gnn] + 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 ;buffer overflow + lda reol ;Get the EOL char. + cmp b + jnz inpkt2 ;If not loop for another. +;[gnn] *** added by Godfrey Nix Nottingham University *** +;[gnn] to allow Kermit server to echo our packets back + lxi h,recpkt+3 ;[gnn] point to packet type + lda packet+3 ;[gnn] get the one we sent + cmp m ;[gnn] are they the same? + jz inpkt ;[gnn] yes, get another packet +;[gnn] *** end of patch ***** + ;... + ;... + +;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. + lda quietd ; a quiet display? + ana a + jnz inpkt7 ; so dont say a thing + call rppos ; position cursor + lxi h,recpkt+1 ; print the packet + call dmptxt + + lda prnflg ; is the printer on too? + ana a + jz inpkt7 + lxi h,rstatm ; print state + call printm ; dumptext but to printer + lda state + mov e,a + call outprn + lxi h,princr ; cr lf to printer + call printm + lxi h,rpackm + call printm + lxi h,recpkt+1 + call printm + lxi h,princr + call printm + lxi h,princr + call printm + + +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 + jmp inchr6 ;[MF] and do timer thing +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 + lda takflg ;[MF]Take-file in progress? + ani 1 ;[MF]... + cnz closet ;[MF]Yes, close it and reset TAKE-flag + ;[MF]so all processing is halted + 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: lda quietd ; a quiet display? + ana a + jnz error0 ; so dont say a thing + lda remtxt ;[MF]Doing a remote command? + ora a ;[MF]... + jnz error0 ;[MF]Yes, don't position cursor + call screrr ;Position the cursor. +error0: mvi a,'A' ;Set the state to abort. + sta state + jmp error2 + +error1: lxi d,crlf ;Print a CRLF. + lda quietd ; a quiet display? + ana a + jnz error2 ; so dont say a thing + 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 m,'$' ;Put a dollar sign at the end. + lxi d,data ;Print error message + lda remtxt ;[MF]Doing a remote command? + ora a ;[MF]... + jnz errr2a ;[MF]Yes, print message, quiet or not! + lda quietd ; a quiet display? + ana a + rnz ; so dont say a thing +errr2a: call prtstr + ret + +error3: lda quietd ; a quiet display? + ana a + rnz ; so dont say a thing + lda remtxt ;[MF]Doing a remote command? + ora a ;[MF]... + jnz err3a ;[MF]Yes, don't position cursor + push d ;Save the pointer to the message. + call screrr ;Position the cursor. + pop d ;Get the pointer back. +err3a: 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 + lda quietd ; a quiet display? + ana a + jnz init1 ; so dont say a thing + call sysscr ; fix up screen +init1: 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: lhld numrtr + inx h ;Increment the number of retries + shld numrtr + lda remtxt ;[MF]Doing a remote server command? + ora a ;[MF]... + rnz ;[MF]Yes, keep mum + lda quietd ; a quiet display? + ana a + rnz ; so dont say a thing + call scrnrt ;Position cursor + lhld numrtr ;[MF] +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: lda quietd ; a quiet display? + ana a + jz finme0 ; so do usual stuff + push d ;[MF]Save pointer to completion message + call prcrlf ; best do a new line + pop d ;[MF]Restore completion message pointer + call prtstr ; and send message + mvi e,space ; send a space or two + mvi c,dconio + push b + push d + call bdos + pop d + pop b + call bdos + ret ; and exit back +; +;else for screaming screens... + +finme0: push d ;Save message. + call scrst ;Position cursor + pop d ;Print the termination message + call prtstr + ret ; may not want this ************** + + mvi c,4 ;[2] copy across user no and drive + lxi h,kerm1 ;[2] as we have the text already +finme1: mov e,m + push h ;[2] conout probably destroys these + push b + call conout + pop b + pop h + inx h ;[2] next character + dcr c ;[2] ah, but have we done? + jnz finme1 ;[2] nope + lxi d,spac15 ;[2] send 15 spaces (clears previous filename) + call prtstr ;[2] + 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 + + +; Output a null-terminated string to the PRINTER We assume that the +; console has been selected. Called with HL = address of string. +; called by: spack, inpkt + +printm: 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 outprn ; output character to printer + pop h ; restore string address + inx h ; point past printed character + jmp printm ; go output rest of string + + +; +; test if character in A is the start of header character. We get +; the start of packet character from sohchr, which can be SET +tstsoh: push b ; save these registers for a bit + mov c,a ; we have to test if this is the character + lda sohchr + cmp c ; if zero, then it is + mov a,c ; restore accumulator but not flags + pop b + ret ; return with flags set +; + + +; Little code to allow some expansion of code without changing +; every futher address, only up to the end of this file. +; TO BE REMOVED FRO RELEASE! + +; org ($+100h) AND 0FF00H + + +IF lasm + LINK CPSREM +ENDIF;lasm -- cgit v1.2.3