2 ; KERMIT - (Celtic for "FREE")
4 ; This is the CP/M-80 implementation of the Columbia University
5 ; KERMIT file transfer protocol.
9 ; Copyright June 1981,1982,1983,1984
12 ; Originally written by Bill Catchings of the Columbia University Center for
13 ; Computing Activities, 612 W. 115th St., New York, NY 10025.
15 ; Contributions by Frank da Cruz, Daphne Tzoar, Bernie Eiben,
16 ; Bruce Tanner, Nick Bush, Greg Small, Kimmo Laaksonen, Jeff Damens, and many
19 ; This file contains the (system-independent) routines that implement
20 ; the KERMIT protocol, and the commands that use them:
21 ; RECEIVE, SEND, FINISH, and LOGOUT.
25 ;edit 11, 21-Mar-1991 by MF. After "inchr7", close TAKE-file (if any) so
26 ; ^C will halt all processing (including commands from TAKE-files)
27 ; and put the user back at Kermit command-level.
28 ;edit 10, 3-Jan-1991 by MF. Modify routine "inchr" after label "inchr5" to
29 ; not take retry (nonskip) return if ^X/^Z seen on the Console. This
30 ; will prevent multiple copies of packets being sent if user aborts
31 ; some files in a stream being sent via ^X and is a better fix to this
32 ; problem than flushing comm input before sending the "Z" packet
33 ; requesting the remote Kermit to discard the current file being
34 ; received (as implemented in CPSPK1.ASM edit of 2-jan-1991).
35 ;edit 9, 14-Dec-1990 by MF. Modified "gofil" routine to allow for
36 ; specification of a drive in the local filespec for GET and
37 ; RECEIVE commands. Thus commands such as
38 ; GET HELLO.TXT B:GOODBYE.TXT
40 ; RECEIVE B:GOODBYE.TXT
41 ; now work as expected.
42 ;edit 8, 22-Oct-1990 by MF. Fixed bug in completion-message routine
43 ; "finmes" wherein the completion message was not printed if the
44 ; terminal was set to QUIET because the message pointer was clobbered
46 ;edit 7, 14-Sep-1990 by MF. Add hooks for SET COLLISION command.
47 ; Eliminate commented-out old file warning rename routine.
48 ; Clear communication input buffers (call flsmdm) before
49 ; BYE, FINISH and LOGOUT commands.
50 ;edit 6, 9-Sep-1990 by MF. Implemented fixes in CPKERM.BWR for
51 ; garbage printout during quiet transfers and for file existence/
53 ; Also implemented hooks for Remote commands.
54 ; edit 5, 18 June 1990 by Russell Lang [rjl@monu1.cc.monash.edu.au]
55 ; When trying to generate a unique file name on receive, zero
56 ; the attribute bits between file opening attempts. This is
57 ; to fix a bug which caused the unique file name to have the
58 ; attributes of the already existing file. If the attribute
59 ; was R/O, a bdos error occured later when an attempt was made
60 ; to write to the file.
62 ; edit 4, 27 October, 1987 By OBSchou. Changed the rename routine to
63 ; be more like the MSDOS issue.
65 ; edit 3, 28 July, by OBSchou. Added traps to NOT print to screen during
66 ; file transfers if quietd is non zero (ie we SET TERMINAL QUIET)
67 ; This hopefully speeds up transfers in systems spending an age
68 ; updating the screen.
70 ; edit 2, 8 April, 1987 by OBSchou. Minor edit to put drive and user number
71 ; in the "filename" field on the transfer screen. This means that the
72 ; offset on the line foe the file name proper has moved along 4 space.
73 ; Also, it writes 15 spaces AFER the xxd: string to clear the field
74 ; of any prevous file. Needed for thos terminals that cannot
75 ; clear to end of line...
77 ; edit 1, 28 January, 1987 by OBSchou.
78 ; Hived off about 1/2 of CPSPKT.ASM to form two (smaller => easier
83 pk2ver: db 'CPSPK2.ASM (11) 21-Mar-1991$' ; name, edit number, date
87 ; Get the file name (including host to micro translation)
91 sta fcb ;Set the drive to default to current.
92 lxi h,data ;Get the address of the file name.
93 ; allow use of local name if one was given [gnn]
95 ora a ;[gnn] anything there?
96 jz gofil0 ;[gnn] no, use the one in the data packet
97 lxi h,remnam ;[gnn] yes, use this instead
98 lda remnam+1 ;[MF]Get 2nd char of local filename
99 cpi ':' ;[MF]Was a drive specified?
100 jnz gofil0 ;[MF]No, proceed as of old
101 mov a,m ;[MF]Yes, get drive
102 ani 5fh ;[MF]Force uppercase
103 sui 'A'-1 ;[MF]Make valid drive for fcb
104 sta fcb ;[MF]and store in fcb
105 inx h ;[MF]Skip drive and delimiter
107 gofil0: ;[gnn] continue to set up the file [gnn]
109 shld datptr ;Store the address.
110 lxi h,fcb+1 ;Address of the FCB.
111 shld fcbptr ;Save it.
113 sta temp1 ;Initialize the char count.
116 gofil1: mov m,b ;Blank the FCB.
119 ; cpi 0CH ;Twelve?[5a]
120 cpi 0BH ; Eleven? [5a]
122 mvi m,0 ; [5a] Specify extent 0
123 gofil2: lhld datptr ;Get the NAME field.
125 cpi 'a' ;Force upper case
131 shld datptr ;[jd] update ptr (moved from above)
140 gofil3: ora a ;Trailing null?
141 jz gofil7 ;Then we're done.
142 shld datptr ;[jd] no, can update ptr now.
147 lda temp1 ;Get the char count.
150 cpi 8H ;Are we finished with this field?
159 cpi '.' ;Is this the terminator?
160 jnz gofil4 ;Go until we find it.
161 gofil6: lhld datptr ;Get the TYPE field.
163 cpi 'a' ;Force upper case
166 gofl6a: ora a ;Trailing null?
167 jz gofil7 ;Then we're done.
168 ;[jd] move above two lines so we don't increment pointer if char is null
175 lda temp1 ;Get the char count.
178 cpi 0CH ;Are we finished with this field?
181 mvi m,'$' ;Put in a dollar sign for printing.
182 lda quietd ; quiet display?
184 jnz gofi70 ; yes, so skip it.
185 call scrfln ;Position cursor
186 gofi70: lxi d,data ;Print the file name
187 lda getrxflg ;[obs 8] are we doing a get or receive?
189 jz gofi7a ;[obs 8] if zero, receive
190 lxi d,remnam ;[obs 8]
194 gofi7b: xra a ;[MF]Zero "discard" flag
196 lda flwflg ;Is file warning on?
198 jz gofil9 ;If not, just proceed.
199 mvi c,openf ;See if the file exists.
202 cpi 0FFH ;Does it exist?
203 jz gofil9 ;If not create it.
205 lda flwflg ;[MF]Get flag again
206 cpi 3 ;[MF]SET COLLISION DISCARD?
208 mvi a,0ffh ;[MF]Yes, order rejection of the file
210 jmp rskp ;[MF]and pretend successful open
211 gofi7h: push psw ;[MF]Save Collision status
214 pop psw ;[MF]Restore Collision status
215 cpi 1 ;[MF]SET COLLISION RENAME?
216 jz gofi7i ;[MF]Yes, same as SET WARNING ON
217 ;[MF]If we come here, SET COLLISION BACKUP
218 lxi h,fcb ;[MF]Copy original fcb to a safe place
219 lxi d,colfcb ;[MF]...
222 ;[MF]and fall into rename code
225 ; Replacement file name renamer routine. Incomming
226 ; files are renamed in this manner:
227 ; original file name: filex.ext
228 ; first rename: filex001.ext
230 ; ninth rename filex009.ext
231 ; 10th rename fail - would we really want 10
232 ; files of the same name??
236 ; Assume that we need to "rename" the file, so lets make sure
237 ; that there is a full. 8 character filename. (We make it if
238 ; it does not already exist)
239 ; 1a) If full file name, last character is to be replaced
240 ; by a zero. This gives us up to no#ine renames.
242 ; 2a)If exists, increment last character by one
243 ; 2b)if = '9' then abort
244 ; 2c)If does not exist, got 2)
245 ; 3)we have a valid 'renamed' file
247 ;Part 1) - fill out filename part
249 mvi c,8 ; max 8 characters to test for
250 mvi a,'0' ; spaces to be replaced by a zero.
251 lxi h,fcb+8 ; start at the end
252 gofi7c: mov m,a ; put a zero in here
253 dcr c ; come to the end?
254 jz gofi7d ; should not have, but just in case...
255 dcx h ; previous chararcter
257 cpi ' ' ; if this character a space as well, zero it
258 mvi a,'0' ; set it to ascii zero just in case...
261 ; Part 2) open the file (if success, then it exists)
264 ;zero the attribute bits. [rjl@monu1.cc.monash.edu.au]
267 gofi7z: mov a,m ;[rjl]
276 inr a ; if 0ffh returned, error (ie does not exist)
278 lda fcb+8 ; get last character
281 cpi '9'+1 ; more than '9' => too far, lets give up.
282 jnz gofi7d ; else try again
283 ;Giving up, so lets exit
286 ret ; return to error routine
288 gofi7e: lxi d,fnbuf ; make the file name into a character string
289 lxi h,fcb+1 ; point to source file name, less drive name
290 mvi c,8 ; 11 characters (8+3) + dot to copy across
292 gofi7f: mov a,m ; get character
297 jnz gofi7f ; loop until all done
299 mvi a,'.' ; then the dot
303 mvi c,3 ; then the file extention
310 jnz gofi7g ; loop until extention copied across
312 mvi a,'$' ; dollar terminate string
314 lxi d,fnbuf ;[MF]Point to string
315 call prtstr ; write string to console
317 lda flwflg ;[MF]Get warning (SET COLLISION) flag
318 cpi 2 ;[MF]SET COLLISION BACKUP?
320 lxi h,fcb ;[MF]Yes, get new filename fcb
321 lxi d,colfcb+16 ;[MF]Where to copy to for rename
322 lxi b,16 ;[MF]Copy 16 bytes
324 lxi d,colfcb ;[MF]Point to rename fcb
325 mvi c,renam ;[MF]Rename function
326 call bdos ;[MF]Try to rename original file
327 cpi 0ffh ;[MF]Did we win?
329 lxi d,erms16 ;[MF]No, complain and bomb
331 gofl82: lxi h,colfcb ;[MF]Now recopy original filename into fcb
332 lxi d,fcb ;[MF]to create new file with original name
337 ;Now lets make the file (create it)
339 gofil9: call makfil ; Create the file.
340 jmp gofl91 ; Disk was full.
347 ; This is the FINISH command. It tells the remote KERSRV to exit.
351 call selmdm ;[MF]Select modem
352 call flsmdm ;[MF]Flush buffers
353 call selcon ;[MF]Select keyboard again
355 sta numtry ;Inititialize count.
356 mvi a,'1' ;Reset block check type to single character
359 finsh1: lda numtry ;How many times have we tried?
360 cpi maxtry ;Too many times?
361 jm finsh3 ;No, try it.
362 finsh2: lxi d,erms18 ;Say we couldn't do it.
366 finsh3: inr a ;Increment the number of tries.
369 sta argblk ;Make it packet number zero.
371 sta argblk+1 ;One piece of data.
373 mvi m,'F' ;Finish running Kermit.
374 mvi a,'G' ;Generic command packet.
376 jmp finsh2 ; Tell the user and die.
377 call rpack ;Get an acknowledgement.
378 jmp finsh1 ; Go try again.
380 jz kermit ;Yes, we are done.
381 cpi 'E' ;Is it an error packet?
382 jnz finsh1 ;Try sending the packet again.
383 call error1 ;Print the error message.
386 ; This is the LOGOUT command. It tells the remote KERSRV to logout.
390 call logo ;Send the logout packet.
391 jmp kermit ;Go get another command
392 jmp kermit ; whether we succeed or not.
394 ; do logout processing.
395 ; called by: bye, logout
397 logo: call selmdm ;[MF]Select modem
398 call flsmdm ;[MF]Flush buffers
399 call selcon ;[MF]Select keyboard again
401 sta numtry ;Inititialize count.
402 mvi a,'1' ;Reset block check type to single character
405 logo1: lda numtry ;How many times have we tried?
406 cpi maxtry ;Too many times?
407 jm logo3 ;No, try it.
408 logo2: lxi d,erms19 ;Say we couldn't do it.
412 logo3: inr a ;Increment the number of tries.
415 sta argblk ;Make it packet number zero.
417 sta argblk+1 ;One piece of data.
419 mvi m,'L' ;Logout the remote host.
420 mvi a,'G' ;Generic command packet.
422 jmp logo2 ; Tell the user and die.
423 call rpack ;Get an acknowledgement
424 jmp logo1 ; Go try again.
426 jz rskp ;Yes, we are done.
427 cpi 'E' ;Is it an error packet?
428 jnz logo1 ;Try sending the packet again.
429 call error1 ;Print the error message.
435 ; This routine assembles a packet from the arguments given and sends it
438 ; Expects the following:
439 ; A - Type of packet (D,Y,N,S,R,E,F,Z,T)
440 ; ARGBLK - Packet sequence number
441 ; ARGBLK+1 - Number of data characters
442 ; Returns: nonskip if failure
444 ; called by: read, rinit, rfile, rdata, sinit, sfile, sdata, seof, seot,
445 ; finish, logout, nak, ackp
448 lxi h,packet ;Get address of the send packet.
449 lda sndsop ;[gnn] send start-of-pkt char.
450 mov m,a ;Put in the packet.
451 inx h ;Point to next char.
452 lda curchk ;Get current checksum type
453 sui '1' ;Determine extra length of checksum
455 lda argblk+1 ;Get the number of data chars.
456 adi ' '+3 ;Real packet character count made printable.
457 add b ;Determine overall length
458 mov m,a ;Put in the packet.
459 inx h ;Point to next char.
460 lxi b,0 ;Zero the checksum AC.
461 mov c,a ;Start the checksum.
462 lda argblk ;Get the packet number.
463 adi ' ' ;Add a space so the number is printable.
464 mov m,a ;Put in the packet.
465 inx h ;Point to next char.
467 mov c,a ;Add the packet number to the checksum.
468 mvi a,0 ;Clear A (Cannot be XRA A, since we can't
470 adc b ;Get high order portion of checksum
471 mov b,a ;Copy back to B
472 lda argblk+2 ;Get the packet type.
473 mov m,a ;Put in the packet.
474 inx h ;Point to next char.
476 mov c,a ;Add the packet number to the checksum.
478 adc b ;Get high order portion of checksum
479 mov b,a ;Copy back to B
480 spack2: lda argblk+1 ;Get the packet size.
481 ora a ;Are there any chars of data?
482 jz spack3 ; No, finish up.
483 dcr a ;Decrement the char count.
484 sta argblk+1 ;Put it back.
485 mov a,m ;Get the next char.
486 inx h ;Point to next char.
488 mov c,a ;Add the packet number to the checksum.
490 adc b ;Get high order portion of checksum
491 mov b,a ;Copy back to B
492 jmp spack2 ;Go try again.
494 spack3: lda curchk ;Get the current checksum type
495 cpi '2' ;Two character?
496 jz spack4 ;Yes, go handle it
497 jnc spack5 ;No, go handle CRC if '3'
498 mov a,c ;Get the character total.
499 ani 0C0H ;Turn off all but the two high order bits.
500 ;Shift them into the low order position.
501 rlc ;Two left rotates same as 6 rights
503 add c ;Add it to the old bits.
504 ani 3FH ;Turn off the two high order bits. (MOD 64)
505 adi ' ' ;Add a space so the number is printable.
506 mov m,a ;Put in the packet.
507 inx h ;Point to next char.
508 jmp spack7 ;Go store eol character
510 ;Here for 3 character CRC-CCITT
512 spack5: mvi m,0 ;Store a null for current end
514 lxi h,packet+1 ;Point to first checksumed character
515 call crcclc ;Calculate the CRC
516 pop h ;Restore the pointer
517 mov c,e ;Get low order half for later
518 mov b,d ;Copy the high order
519 mov a,d ;Get the high order portion
520 rlc ;Shift off low 4 bits
524 ani 0FH ;Keep only low 4 bits
525 adi ' ' ;Put into printing range
526 mov m,a ;Store the character
527 inx h ;Point to next position
529 ;Here for two character checksum
531 spack4: mov a,b ;Get high order portion
532 ani 0FH ;Only keep last four bits
533 rlc ;Shift up two bits
535 mov b,a ;Copy back into safe place
536 mov a,c ;Get low order half
537 rlc ;Shift high two bits
539 ani 03H ;Keep only two low bits
540 ora b ;Get high order portion in
541 adi ' ' ;Convert to printing character range
542 mov m,a ;Store the character
543 inx h ;Point to next character
544 mov a,c ;get low order portion
545 ani 3FH ;Keep only six bits
546 adi ' ' ;Convert to printing range
548 inx h ;Bump the pointer
551 ora a ; is debugging enabled?
553 push h ; yes. save address of end of packet
554 mvi m,0 ; null-terminate the packet for display
555 lda quietd ; a quiet display?
557 jnz spac7a ; so dont say a thing
558 call sppos ; position cursor
559 lxi h,packet+1 ; print the packet
561 lda prnflg ; is the printer on too?
564 lxi h,sstatm ; print state
565 call printm ; dumptext but to printer
569 lxi h,princr ; cr lf to printer
580 spac7a: pop h ; restore address of end of packet
581 spack8: lda seol ;Get the EOL the other host wants.
582 mov m,a ;Put in the packet.
583 inx h ;Point to next char.
585 mov m,a ;Put in the packet.
586 ; Write out the packet.
587 outpkt: call selmdm ; Set up for output to comm port if iobyt
588 lda spad ;Get the number of padding chars.
590 outpk2: lda temp1 ;Get the count.
593 jm outpk6 ;If none left proceed.
595 lda spadch ;Get the padding char.
596 call setpar ;Set parity appropriately
597 mov e,a ;Put the char in right AC.
598 call outmdm ;Output it.
601 outpk6: lxi h,packet ; Point to the packet.
602 outlup: mov a,m ; Get the next character.
603 ora a ; Is it a null?
604 jz outlud ; If so return success.
605 call setpar ; Set parity for the character
606 mov e,a ; Put it in right AC
607 call outmdm ; and output it.
608 ; TAC trap: If this character is the TAC intercept character, and the TAC
609 ; trap is enabled, we have to output it twice. If the TAC trap is enabled,
610 ; tacflg contains the intercept character. (The current character cannot
611 ; be NUL, so we don't have to worry about doubling nulls in the message)
612 lda tacflg ; get current intercept character, or zero.
613 cmp m ; compare against current data character.
614 jnz outpk8 ; if different, do nothing.
615 call setpar ; match. set appropriate parity,
616 mov e,a ; put it in the right register,
617 call outmdm ; and output it a second time.
619 inx h ; Increment the char pointer.
622 outlud: call selcon ; select console
623 jmp rskp ; and return success
626 ; This routine waits for a packet to arrive from the host. It reads
627 ; characters until it finds a SOH. It then reads the packet into packet.
629 ; Returns: nonskip if failure (checksum wrong or packet trashed)
630 ; skip if success, with
632 ; ARGBLK - message number
633 ; ARGBLK+1 - length of data
634 ; called by: rinit, rfile, rdata,
635 ; sinit, sfile, sdata, seof, seot, finish, logout
637 rpack: call inpkt ;Read up to the end-of-line character
639 rpack0: call getchr ;Get a character.
640 jmp rpack ; Hit eol;null line;just start over.
641 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
643 jnz rpack0 ; No, go until it is.
644 rpack1: call getchr ;Get a character.
645 jmp r ; Hit end of line, return bad.
646 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
648 jz rpack1 ; Yes, then go start over.
649 sta packet+1 ;Store in packet also
650 mov c,a ;Start the checksum.
651 lda curchk ;Get block check type
652 sui '1' ;Determine extra length of block check
654 mov a,c ;Get back length character
655 sui ' '+3 ;Get the real data count.
656 sub b ;Get total length
658 mvi b,0 ;Clear high order half of checksum
659 call getchr ;Get a character.
660 jmp r ; Hit end of line, return bad.
661 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
663 jz rpack1 ; Yes, then go start over.
665 sta packet+2 ;Save also in packet
667 mov c,a ;Add the character to the checksum.
669 adc b ;Get high order portion of checksum
670 mov b,a ;Copy back to B
672 sui ' ' ;Get the real packet number.
674 call getchr ;Get a character.
675 jmp r ; Hit end of line, return bad.
676 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
678 jz rpack1 ; Yes, then go start over.
679 sta temp1 ;Save the message type.
680 sta packet+3 ;Save in packet
682 mov c,a ;Add the character to the checksum.
684 adc b ;Get high order portion of checksum
685 mov b,a ;Copy back to B
686 lda argblk+1 ;Get the number of data characters.
688 lxi h,data ;Point to the data buffer.
691 sui 1 ;Any data characters?
692 jm rpack3 ; If not go get the checksum.
694 call getchr ;Get a character.
695 jmp r ; Hit end of line, return bad.
696 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
698 jz rpack1 ; Yes, then go start over.
700 mov m,a ;Put the char into the packet.
701 inx h ;Point to the next character.
704 mov c,a ;Add the character to the checksum.
706 adc b ;Get high order portion of checksum
707 mov b,a ;Copy back to B
708 jmp rpack2 ;Go get another.
710 rpack3: call getchr ;Get a character.
711 jmp r ; Hit end of line, return bad.
712 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
714 jz rpack1 ; Yes, then go start over.
715 sui ' ' ;Turn the char back into a number.
717 ;Determine type of checksum
719 lda curchk ;Get the current checksum type
720 cpi '2' ;1, 2 or 3 character?
721 jz rpack4 ;If zero, 2 character
722 jnc rpack5 ;Go handle 3 character
723 mov a,c ;Get the character total.
724 ani 0C0H ;Turn off all but the two high order bits.
725 ;Shift them into the low order position.
726 rlc ;Two left rotates same as six rights
728 add c ;Add it to the old bits.
729 ani 3FH ;Turn off the two high order bits. (MOD 64)
731 lda temp3 ;Get the real received checksum.
732 cmp b ;Are they equal?
733 jz rpack7 ;If so, proceed.
734 rpack9: call updrtr ;If not, update the number of retries.
737 ;Here for three character CRC-CCITT
739 rpack5: lhld datptr ;Get the address of the data
740 mvi m,0 ;Store a zero in the buffer to terminate packet
741 lxi h,packet+1 ;Point at start of checksummed region
742 call crcclc ;Calculate the CRC
743 mov c,e ;Save low order half for later
744 mov b,d ;Also copy high order
745 mov a,d ;Get high byte
746 rlc ;Want high four bits
748 rlc ;And shift two more
750 ani 0FH ;Keep only 4 bits
752 lda temp3 ;Get first value back
755 call getchr ;Get a character.
756 jmp r ; Hit end of line, return bad.
757 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
759 jz rpack1 ; Yes, then go start over.
760 sui ' ' ;Remove space offset
761 sta temp3 ;Store for later check
764 ;Here for a two character checksum and last two characters of CRC
766 rpack4: mov a,b ;Get high order portion
767 ani 0FH ;Only four bits
768 rlc ;Shift up two bits
770 mov b,a ;Save back in B
771 mov a,c ;Get low order
772 rlc ;move two high bits to low bits
774 ani 03H ;Save only low two bits
775 ora b ;Get other 4 bits
776 mov b,a ;Save back in B
777 lda temp3 ;Get this portion of checksum
778 cmp b ;Check first half
779 jnz rpack9 ;If bad, go give up
780 call getchr ;Get a character.
781 jmp r ; Hit end of line, return bad.
782 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
784 jz rpack1 ; Yes, then go start over.
785 sui ' ' ;Remove space offset
786 mov b,a ;Save in safe place
787 mov a,c ;Get low 8 bits of checksum
788 ani 3FH ;Keep only 6 bits
790 jnz rpack9 ;Bad, give up
792 mvi m,0 ;Put a null at the end of the data.
793 lda temp1 ;Get the type.
796 ; inpkt - receive and buffer packet
797 ; returns: nonskip if error (timeout)
798 ; skip if success; packet starts at recpkt (which holds the SOH)
799 ; and is terminated by a null.
800 ; console is selected in either case.
803 inpkt: lxi h,recpkt ;Point to the beginning of the packet.
805 inpkt1: call inchr ;Get first character
806 jmp r ;Return failure
807 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
809 jnz inpkt1 ;if not, ignore leading junk
810 jmp inpkt3 ;else go put it in packet
812 inpkt2: call inchr ;Get a character.
813 jmp r ; Return failure.
814 lxi h,rcvsop ;[gnn] Is it receive start-of-pkt char.
816 jnz inpkt3 ;if not continue
817 lxi h,recpkt ;else throw away what we've got so far
819 inpkt3: lhld pktptr ;
820 mov m,a ;Put the char in the packet.
824 lxi d,-recpkx ;Start over if packet buffer overflow
826 jc inpkt ;buffer overflow
827 lda reol ;Get the EOL char.
829 jnz inpkt2 ;If not loop for another.
830 ;[gnn] *** added by Godfrey Nix Nottingham University ***
831 ;[gnn] to allow Kermit server to echo our packets back
832 lxi h,recpkt+3 ;[gnn] point to packet type
833 lda packet+3 ;[gnn] get the one we sent
834 cmp m ;[gnn] are they the same?
835 jz inpkt ;[gnn] yes, get another packet
836 ;[gnn] *** end of patch *****
840 ;Begin IBM change/fdc
841 ;This moved from OUTPK7 -- it appears that waiting until we're
842 ;ready to send a packet before looking for turnaround character
843 ;is long enough for it to get lost. Better to look now.
845 lda ibmflg ;Is this the IBM?
847 jz inpkt6 ;If not then proceed.
848 lda state ;Check if this is the Send-Init packet.
850 jz inpkt6 ;If so don't wait for the XON.
851 inpkt5: call inchr ;Wait for the turn around char.
853 cpi xon ;Is it the IBM turn around character?
854 jnz inpkt5 ;If not, go until it is.
855 inpkt6: lhld pktptr ;Reload packet pointer
857 dcx h ;Back up to end of line character
858 mvi m,0 ;Replace it with a null to stop rpack:
859 call selcon ;We've got the packet. Return to console.
861 lda dbgflg ; Is debugging enabled?
864 inx h ; Point to next char.
865 lda quietd ; a quiet display?
867 jnz inpkt7 ; so dont say a thing
868 call rppos ; position cursor
869 lxi h,recpkt+1 ; print the packet
872 lda prnflg ; is the printer on too?
875 lxi h,rstatm ; print state
876 call printm ; dumptext but to printer
880 lxi h,princr ; cr lf to printer
893 shld pktptr ;Save the packet pointer.
894 jmp rskp ;If so we are done.
896 ; getchr - get next character from buffered packet.
897 ; returns nonskip at end of packet.
900 getchr: lhld pktptr ;Get the packet pointer.
901 mov a,m ;Get the char.
904 ora a ;Is it the null we put at the end of the packet?
905 jnz rskp ;If not return retskp.
906 ret ;If so return failure.
909 ; inchr - character input loop for file transfer
910 ; returns: nonskip if timeout or character typed on console
912 ; skip with character from modem in A (parity stripped
913 ; if necessary; modem selected)
914 ; preserves bc, de, hl in either case.
917 inchr: push h ; save hl and bc
919 lhld timout ;Get initial value for timeout
921 inchr0: call selmdm ;select modem
922 call inpmdm ;Try to get a character from the modem
924 jz inchr2 ;if zero, nothing there.
926 lda parity ;Is the parity none?
929 jz inchr1 ;If so just return.
930 ani 7FH ;Turn off the parity bit.
931 inchr1: pop b ;restore registers
933 jmp rskp ;take skip return, character in A
935 inchr2: call selcon ;select console
936 call inpcon ; Try to get a character from the console
938 jz inchr6 ;If not go do timer thing
939 cpi cr ;Is it a carriage return?
940 jz inchr4 ;If so return
941 cpi ('Z'-100O) ;Control-Z?
942 jz inchr5 ;Yes, go flag it
943 cpi ('C'-100O) ;Control-C?
944 jz inchr7 ;re-enter, he wants to get out
945 cpi ('X'-100O) ;Control-X?
946 jnz inchr6 ;No, ignore it. do timer thing.
947 inchr5: adi 100O ;Convert to printing range
948 sta czseen ;Flag we saw a control-Z
949 jmp inchr6 ;[MF] and do timer thing
950 inchr4: pop b ; restore registers
954 inchr6: lda timflg ;[jd] pick up timer flag
955 ora a ;[jd] are we allowed to use timer?
956 jz inchr0 ;[jd] no, don't time out
957 lhld timval ; decrement fuzzy time-out
959 shld timval ;((timout-1) * loop time)
960 mov a,h ;(Retry if not time-out)
963 call updrtr ;Count as retry (?)
964 pop b ;restore registers
966 ret ;and return to do retry
968 inchr7: call clrtop ;[hh] clear screen and home cursor
969 lda takflg ;[MF]Take-file in progress?
971 cnz closet ;[MF]Yes, close it and reset TAKE-flag
972 ;[MF]so all processing is halted
973 jmp kermit ;[hh] then re-enter kermit
976 ; CRCCLC - Routine to calculate a CRC-CCITT for a string.
978 ; This routine will calculate a CRC using the CCITT polynomial for
981 ; call with: HL/ Address of null-terminated string
982 ; 16-bit CRC value is returned in DE.
983 ; Registers BC and HL are preserved.
985 ; called by: spack, rpack
987 crcclc: push h ;Save HL
989 lxi d,0 ;Initial CRC value is 0
991 crccl0: mov a,m ;Get a character
993 jz crccl1 ;If so, all done
994 push h ;Save the pointer
995 xra e ;Add in with previous value
997 ani 0FH ;Get last 4 bits of combined value
999 mvi b,0 ;And make high order zero
1000 lxi h,crctb2 ;Point at low order table
1001 dad b ;Point to correct entry
1003 push h ;Save the address
1004 mov a,e ;Get combined value back again
1005 rrc ;Shift over to make index
1008 ani 1EH ;Keep only 4 bits
1009 mov c,a ;Set up to offset table
1010 lxi h,crctab ;Point at high order table
1011 dad b ;Correct entry
1012 mov a,m ;Get low order portion of entry
1013 xra d ;XOR with previous high order half
1014 inx h ;Point to high order byte
1016 pop h ;Get back pointer to other table entry
1017 xra m ;Include with new high order half
1018 mov e,a ;Copy new low order portion
1019 inx h ;Point to other portion
1020 mov a,m ;Get the other portion of the table entry
1021 xra d ;Include with other high order portion
1022 mov d,a ;Move back into D
1025 inx h ;Point to next character
1026 jmp crccl0 ;Go get next character
1028 crccl1: pop b ;Restore B
1031 ret ;And return, DE=CRC-CCITT
1067 ; This is where we go if we get an error during a protocol communication.
1068 ; error prints the error packet on line 6 or so, and aborts the
1070 ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot
1071 ; error1 print CRLF followed by the error packet.
1072 ; called by: finish, logout
1073 ; error2 just prints the error packet.
1074 ; error3 positions cursor and prints error message specified in DE.
1075 ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof,
1076 ; seot, parwrn, gofil, outbuf
1078 error: lda quietd ; a quiet display?
1080 jnz error0 ; so dont say a thing
1081 lda remtxt ;[MF]Doing a remote command?
1083 jnz error0 ;[MF]Yes, don't position cursor
1084 call screrr ;Position the cursor.
1085 error0: mvi a,'A' ;Set the state to abort.
1089 error1: lxi d,crlf ;Print a CRLF.
1090 lda quietd ; a quiet display?
1092 jnz error2 ; so dont say a thing
1094 error2: lda argblk+1 ;Get the length of the data.
1096 mvi b,0 ;Put it into BC
1097 lxi h,data ;Get the address of the data.
1098 dad b ;Get to the end of the string.
1099 mvi m,'$' ;Put a dollar sign at the end.
1100 lxi d,data ;Print error message
1101 lda remtxt ;[MF]Doing a remote command?
1103 jnz errr2a ;[MF]Yes, print message, quiet or not!
1104 lda quietd ; a quiet display?
1106 rnz ; so dont say a thing
1110 error3: lda quietd ; a quiet display?
1112 rnz ; so dont say a thing
1113 lda remtxt ;[MF]Doing a remote command?
1115 jnz err3a ;[MF]Yes, don't position cursor
1116 push d ;Save the pointer to the message.
1117 call screrr ;Position the cursor.
1118 pop d ;Get the pointer back.
1119 err3a: call prtstr ;Print error message
1122 ; Set up for file transfer.
1123 ; called by read, send.
1125 init: lxi d,version ; point at Kermit's version string
1126 lda quietd ; a quiet display?
1128 jnz init1 ; so dont say a thing
1129 call sysscr ; fix up screen
1130 init1: call selmdm ; select modem
1131 call flsmdm ; purge any pending data
1132 call selcon ; select console again.
1135 ; Set state to ABORT
1136 ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot,
1139 abort: mvi a,'A' ;Otherwise abort.
1143 ; nak - send NAK packet
1144 ; here from: rinit, rfile, rdata
1145 ; nak0 - update retry count and send NAK packet
1146 ; here from: rinit, rfile, rdata, tryagn
1148 nak0: call updrtr ;Update number of retries.
1149 nak: lda pktnum ;Get the packet number we're waiting for.
1153 mvi a,'N' ;NAK that packet.
1155 jmp abort ; Give up.
1156 ret ;Go around again.
1158 ; increment and display retry count
1159 ; called by: rfile, sinit, sfile, sdata, seof, seot,
1160 ; nak, rpack, inchr, tryagn
1163 inx h ;Increment the number of retries
1165 lda remtxt ;[MF]Doing a remote server command?
1167 rnz ;[MF]Yes, keep mum
1168 lda quietd ; a quiet display?
1170 rnz ; so dont say a thing
1171 call scrnrt ;Position cursor
1173 call nout ;Write the number of retries.
1176 ; [jd] this routine prints parity warnings. All registers are
1177 ; saved except for a.
1189 ;[jd] end of addition
1191 ; print message in status field. address of message is in DE.
1192 ; called by: read, send
1194 finmes: lda quietd ; a quiet display?
1196 jz finme0 ; so do usual stuff
1197 push d ;[MF]Save pointer to completion message
1198 call prcrlf ; best do a new line
1199 pop d ;[MF]Restore completion message pointer
1200 call prtstr ; and send message
1201 mvi e,space ; send a space or two
1211 ;else for screaming screens...
1213 finme0: push d ;Save message.
1214 call scrst ;Position cursor
1215 pop d ;Print the termination message
1217 ret ; may not want this **************
1219 mvi c,4 ;[2] copy across user no and drive
1220 lxi h,kerm1 ;[2] as we have the text already
1222 push h ;[2] conout probably destroys these
1227 inx h ;[2] next character
1228 dcr c ;[2] ah, but have we done?
1229 jnz finme1 ;[2] nope
1230 lxi d,spac15 ;[2] send 15 spaces (clears previous filename)
1232 call scrend ;Position cursor for prompt
1235 ; Compare expected packet number against received packet number.
1236 ; return with flags set (Z = packet number valid)
1237 ; called by: rfile, rdata, sinit, sfile, sdata, seof, seot
1239 compp: lda pktnum ;Get the packet Nr.
1245 ; Increment the packet number, modulo 64.
1246 ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot
1248 countp: inr a ;Increment packet Nr.
1249 ani 3FH ;Turn off the two high order bits
1250 sta pktnum ;Save modulo 64 of number
1252 inx h ;Increment Nr. of packets
1256 ; Send an ACK-packet
1257 ; called by: rfile, rdata, tryagn
1260 sta numtry ;Reset number of retries
1261 sta argblk+1 ;No data. (The packet number is in argblk)
1262 mvi a,'Y' ;Acknowledge packet
1263 call spack ;Send packet
1268 ; called with A/ current retry count
1269 ; called by: rfile, rdata
1271 tryagn: inr a ;Increment it.
1272 sta oldtry ;Save the updated number of tries.
1273 lda pktnum ;Get the present packet number.
1277 lda argblk ;Get the packet's number
1278 cmp b ;Is the packet's number one less than now?
1279 jnz nak0 ;No, NAK it and try again.
1280 call updrtr ;Update the number of retries.
1284 ; Output a null-terminated string to the console. We assume that the
1285 ; console has been selected. Called with HL = address of string.
1286 ; called by: spack, inpkt
1288 dmptxt: mov a,m ; get character from string
1291 push h ; save string address
1292 mov e,a ; move character to E for outcon
1293 call outcon ; output character to console
1294 pop h ; restore string address
1295 inx h ; point past printed character
1296 jmp dmptxt ; go output rest of string
1299 ; Output a null-terminated string to the PRINTER We assume that the
1300 ; console has been selected. Called with HL = address of string.
1301 ; called by: spack, inpkt
1303 printm: mov a,m ; get character from string
1306 push h ; save string address
1307 mov e,a ; move character to E for outcon
1308 call outprn ; output character to printer
1309 pop h ; restore string address
1310 inx h ; point past printed character
1311 jmp printm ; go output rest of string
1315 ; test if character in A is the start of header character. We get
1316 ; the start of packet character from sohchr, which can be SET
1317 tstsoh: push b ; save these registers for a bit
1318 mov c,a ; we have to test if this is the character
1320 cmp c ; if zero, then it is
1321 mov a,c ; restore accumulator but not flags
1323 ret ; return with flags set
1327 ; Little code to allow some expansion of code without changing
1328 ; every futher address, only up to the end of this file.
1329 ; TO BE REMOVED FRO RELEASE!
1331 ; org ($+100h) AND 0FF00H
projects / kermit-80.git / blob