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 23, 16-Jan-1991 by MF. The bug of (22) was not fixed (although
26 ; the error described needed to be corrected). Really fixed the bug this:
27 ; time. changed "lda 'E'" after "ptch9b" to "mvi a,'E'" -- Zilog
28 ; mnemonic thinking must've addled my brain!
29 ;edit 22, 14-Jan-1991 by MF. Fix bug in the code which sends an "E" packet
30 ; to the remote Kermit on encountering "disk full" so that
31 ; uncontrollified <CR><LF> is not copied to the packet data area (and
32 ; hence sent to the remote Kermit). This should fix a bug reported
33 ; by Russell Lang of Monash University in Australia wherein a PC
34 ; running Kermit in Server mode complained of invalid characters when
35 ; receiving the "disk full" error packet from CP/M Kermit.
36 ;edit 21 of 3-Jan-1991 by MF. Reverse part of edit 20 which flushes comm
37 ; input at EOF send: the problem of multiple copies of packets being
38 ; sent when a stream of files being sent is partially interrupted with
39 ; ^X has been fixed by modifying "inchr" in CPSPK2.ASM.
40 ;edit 20, 2-Jan-1991 by MF. Tightened up code just after "sdata1" and around
41 ; "sdat14". Added code to flush comm input after user has typed ^X
42 ; or ^Z to interrupt file sends so that duplicate packets are not
43 ; sent after the interrupt character (especially ^X) has been typed.
44 ;edit 19, 14-Dec-1990 by MF. Place "<<>>" around "F" and "X" packets coming
45 ; as replies to REMOTE commands a la VMS Bliss Kermit.
46 ; Also type each character of "X" or "F" packet explicitly in case
47 ; dollar-signs are part of the filename (as in VMS Bliss Kermit
48 ; when a REMOTE TYPE is given and SET FILE NAMING FULL is in effect).
49 ; Expanded code is at label rfil3f.
50 ;edit 18, 27-Nov-1990 by MF. Fix bug introduced with edit 17 which resulted
51 ; in "E" packet being sent twice when receiving file(s) and disk-full
52 ; occurred. Sorry about that, folks!
53 ;edit 17, 27-Nov-1990 by MF. When receiving files, make the decision as to
54 ; whether to delete a partially-received file on a "disk full"
55 ; condition subject to the setting of the SET INCOMPLETE-FILES
56 ; switch in conformity with the behavior of MSDOS Kermit.
57 ; An "E" packet is still sent to the remote Kermit. Also try to close
58 ; any incomplete file whether deleting it or not (labels rdat16 and
59 ; rdat3a). If keeping incomplete files, try to write outstanding
60 ; buffers to disk, giving an error if the disk is full.
61 ;edit 16, 23-Nov-1990 by MF. When receiving, cause the file being written
62 ; to disk to **always** be deleted and an "E" packet to be sent when a
63 ; "disk full" condition is encountered (per suggestion of
64 ; RJL@MONU1.CC.MONASH.EDU.AU).
65 ;edit 15, 15-Nov-1990 by MF. Changed code for the Receive Complete state
66 ; to always go into RECEIVE if AUTORECEIVE is on. This will happen
67 ; most of the time anyway as most mainframe Kermits issue a prompt
68 ; after a single SEND command (wild-carded or not), thus guaranteeing
69 ; that the modem status check of Kermit-80 ver. 4.09 would **always**
70 ; have characters ready for input (the mainframe Kermit's prompt),
71 ; defeating the status check and the Console input check (originally
72 ; intended to drop the user out of the loop if he/she typed a key with
73 ; no comm input present). Eliminate "any key" message there also.
74 ; the user can drop out by hitting ^C.
75 ; Of course, none of the foregoing applies if the Receive Complete
76 ; state occurs as the result of a "Get" command where Autoreceive
77 ; is meaningless and we just drop back to Kermit command-level.
78 ;edit 14, 1-Oct-1990 by MF. Added code to send an "I" packet before an
79 ; "R" packet in GET command.
80 ; Modified routine "sinit" to ignore "E" packets when sending an
81 ; "i" packet (per KPROTO.DOC).
82 ;edit 13, 14-Sep-1990 by MF. Added code to implement SET FILE COLLISION
83 ; and SET INCOMPLETE commands.
84 ;edit 12, 9-Sep-1990 by MF. Added code to prevent packet counts
85 ; from being displayed during Remote commands. Fixed
86 ; AUTORECEIVE code, file colision Rename algorithm and eliminated
87 ; multiple display of initial messages during GET/RECEIVE.
88 ; edit 11, 28 July, 1987 by OBSchou. Commented out capas etc support
89 ; (Long packets etc) as this is not worth the effort coding... but
90 ; I have left what WAS done for any enthusiast. Also set in a few
91 ; to NOT write to screen if SET TERMINAL QUIET set. Hopefully speeds
92 ; up transfers on systems taking forever to update screens.
94 ; edit 10, 8 April, 1987 by OBSchou. Tarted up all sorts of bits n bobs
95 ; to cope with all the new aditions for Kermit-80 V 4.09
96 ; Look for the [10] for most cahnges. spar and rpar largely replaced
98 ; edit 9, March 30th by OBSchou. Set bits for automatically receiving
99 ; another file if a remote sender sends files in seperate sessions.
100 ; The code simply checks the serial line, and if there is some
101 ; activity, assume its another SEND INIT packet. As there is no
102 ; simple way to go to receive with the control-a, just ignore the
103 ; packet. Causes one retry on the sender, but so what. Really
104 ; should make it a server gizzmo.
106 ; edit 8: January 28, 1987 by OBSchou
107 ; Two major issues: firstly split CPSPKT.ASM into CPSPK(1 2).ASM
108 ; making it far easier to handle this file.
109 ; Second, some mode to the GET routines to correctly print the file
110 ; name instead of the fireworks. Trouble was with GET <file> <file>
111 ; and RECEIVE <file>. However, new bugs discovered...
113 ; edit 7: August 11, 1986 Godfrey N. Nix [gnn] Nottingham University
114 ; To ignore echoed packets (ie send 'S' receive 'S' before 'A');
115 ; To allow character other than SOH for packet header (see also
116 ; updates to CP4MIT and CP4UTL for other code needed);
117 ; To permit SEND and RECEIVE to specify a host filename which
118 ; is of a different structure to that of CP/M.
120 ; edit 6a: [OBSchou] 7 March, 1985.
121 ; Edited file with additions from MJ Carter. He writes:
122 ; 25th September 1985, M J Carter [majoc], Nottingham University
123 ; Code in gofil() amended, for exactly the same reasons to the
124 ; alteration to cmifil() in cpscmd.asm. If there is any deep
125 ; reason why gofil() has to be used instead of a call to comnd(cmofil),
126 ; I can't see it. The bug (on a British Micro Mimi 803) caused
127 ; gofil() to overwrite existing files in GET and RECEIVE, even
128 ; with file warning SET ON.
130 ;edir 6: November 22, 1984
131 ; Change SEND's 'Unable to find file' error exit from calling
132 ; error3 to calling prtstr instead. I don't know about you, but
133 ; I greatly dislike having messages dumped into pre-existing
134 ; junk on the screen where I have to spend lots of time hunting
135 ; for them. [Hal Hostetler]
137 ; edit 5: September 9, 1984
138 ; Call flsmdm in init to flush old input when starting transfers.
139 ; Select console before returning from inpkt.
140 ; Replace inline code with calls to makfil/clofil to set up for
141 ; multisector buffering on output.
142 ; Remove superfluous call to clrlin in error3.
144 ; edit 4: August 21, 1984 (CJC)
145 ; Fix comment in inpkt: packet is terminated by NUL on return, not CR.
146 ; If debugging, display the outgoing packet before putting the EOL
147 ; character on, so the dumped packet doesn't get overwritten.
149 ; edit 3: July 27, 1984
150 ; add link directive for LASM. CP4PKT is linked by CP4MIT, and links
151 ; to CP4TT. Add Toad Hall TACtrap to permit operations through a TAC.
153 ; edit 2: June 8, 1984
154 ; formatting and documentation; remove some unused labels; move setpar
155 ; to cp4mit.m80; add module version string; make all arithmetic on
156 ; 'pktnum' modulo 64; apply defaults correctly for missing parameters
157 ; in send-init packet (and corresponding ack).
160 ; extracted from CPMBASE.M80 version 3.9; modifications are described
161 ; in the accompanying .UPD file.
163 pk1ver: db 'CPSPK1.ASM (23) 16-Jan-1991$' ; name, edit number, date
168 read: mvi a,0ffh ;[obs 8] we are doing a get
169 sta getrxflg ;[obs 8] so set flag
170 lxi d,remdat ;Where to put the text (if any.)
172 call comnd ;Get either some text or a confirm.
173 jmp kermt3 ; Didn't get anything.
174 ora a ;Get any chars?
175 jz kermt3 ;[gnn] GET must have a filename
176 sta rdl ;Store the number of chars.
177 xchg ;Get pointer into HL.
178 mvi m,'$' ;Put in a dollar sign for printing.
179 call init ;Clear the line and initialize the buffers.
180 lda quietd ; quiet display?
182 jz read01 ;[MF]No, go ahead and position cursor
183 call prcrlf ;[MF]Yes, keep from overwriting the prompt
184 jmp read00 ;[MF]and write filename
185 read01: call scrfln ;Position cursor [MF]
186 read00: lxi d,remdat ;Print the file name, in either case
188 jmp read0a ;[gnn] go get local name if any
191 ; enter here for RECEIVE command [gnn]
192 read0: mvi a,0 ;[gnn]
193 sta rdl ;[gnn][MF] flag entry as receive, not get
194 sta getrxflg ;[obs 8] doing a receive, so reset flag
195 call init ;clear line, initialise buffers
196 read0a: lxi d,remnam ;[gnn] save local name here
198 call comnd ;[gnn] read second filename if present
199 jmp kermt3 ;[gnn] error exit
200 sta remlen ;[gnn] save length of name, may be zero
201 sta getrxflg ;[obs 8] May also be receive <fnam> so
202 ;[obs 8]pretend get for printing filename
203 lda rdl ;[gnn] look at first name
204 ora a ;[gnn] receive or get?
205 jz read1 ;[gnn] receive
207 mvi a,'I' ;[MF]Set state to send "I" packet
210 ; jmp read12 ;[obs] [gnn] does not want this
212 read1: ;call init ;Clear the line and initialize the buffers.
214 sta czseen ;Clear the ^X/^Z flag initially.
216 shld numpkt ;Set the number of packets to zero.
217 shld numrtr ;Set the number of retries to zero.
218 sta pktnum ;Set the packet number to zero.
219 sta numtry ;Set the number of tries to zero.
220 lda quietd ; quiet display?
222 jnz read13 ; yes, so dont write...
223 call scrnrt ;Position cursor
225 call nout ;Write the number of retries.
226 read13: lda rdl ;[MF]Get or receive?
228 jnz read2 ;[MF]Get, don't reset state
230 sta state ;Set the state to receive initiate.
233 ;RECEIVE state table switcher.
235 read2: lda quietd ; noisy display?
237 jnz read21 ; no, a quiet one
238 lda remtxt ;[MF] In Remote command?
240 jnz read21 ;[MF] Yes, don't write to screen
241 call scrnp ;Position cursor
243 call nout ;Write the current packet number.
244 read21: lda state ;Get the state.
245 cpi 'D' ;Are we in the DATA receive state?
250 read22: cpi 'X' ; F packet but not an F packet?
251 jnz read3 ; nope, so try next one
252 call rfile ; 'get' the filename (but dont open it)
255 read3: cpi 'F' ;Are we in the FILE receive state?
257 call rfile ;Call receive file.
260 read4: cpi 'R' ;Are we in the Receive-Initiate state?
263 lda state ;[jd] get new state
264 cpi 'F' ;[jd] went into receive state?
266 lxi d,inms24 ;[jd] yes, get receiving... message
267 call finmes ;[jd] go print it
270 read5: cpi 'C' ;Are we in the Receive-Complete state?
272 lxi d,infms3 ;Put in "Complete" message.
273 lda czseen ;Or was it interrupted?
276 xra a ;Yes, clear flag.
278 lxi d,inms13 ;Issue "interrupted" message.
279 read5a: lda remtxt ;[MF] Doing a Remote command?
281 cz finmes ;Print completion message in right place if not
283 lda rdl ;[MF]Receive or Get?
285 jnz kermit ;[MF]Get, Autoreceive means nothing.
286 lda autorc ; see if we want autoreceives
288 jz kermit ;[MF]No autoreceives, so drop out
289 lxi d,autmes ;[MF]Yes, tell the user what we're doing
291 jmp read1 ;[MF]Try another Receive (we get one
292 ;[MF]retry from the sender as the ^A is lost)
294 read6: cpi 'Y' ;[MF]Simple ack (from remote command)?
297 cpi 'I' ;[MF]Exchanging parameters via info packet?
299 call sinit ;[MF]Yes, send the packet
300 lda state ;[MF]Now see what happened
301 cpi 'X' ;[MF]Did we exchange parameters successfully?
302 jz read6a ;[MF]Yes, go send the filespec
303 cpi 'A' ;[MF]No, are we in abort state?
304 jnz read2 ;[MF]No, try again
305 jmp kermit ;[MF]Yes, it's a real disaster, we must stop
306 read6a: lda rdl ;[MF]Get length of filespec
307 sta argblk+1 ;[MF]as length of packet
308 mov c,a ;[MF]We must copy the filespec
310 lxi h,remdat ;[MF]from the temporary buffer
311 lxi d,data ;[MF]to the packet data area
312 call mover ;[MF]Do it.
313 ; for GET we must send the name of the file we want [gnn]
315 mvi a,'1' ;Start with single character checksum
316 sta curchk ;Save the type
317 xra a ;Start a packet zero.
319 mvi a,'R' ;Receive init packet.
320 call spack ;Send the packet.
323 sta czseen ;Clear the ^X/^Z flag initially.
325 shld numpkt ;Set the number of packets to zero.
326 sta pktnum ;Set the packet number to zero.
327 sta numtry ;Set the number of tries to zero.
328 mvi a,'R' ;[MF]Set state to Receive-Initiate
330 jmp read21 ;[MF]and go around again
331 ;[MF]without retyping packet-number
333 read7: cpi 'A' ;Are we in the Receive-"Abort" state?
335 read8: lxi d,infms4 ;Anything else is equivalent to "abort".
344 rinit: lda numtry ;Get the number of tries.
345 cpi imxtry ;Have we reached the maximum number of tries?
348 call error3 ;Move cursor and print an error message.
349 jmp abort ;Change the state to abort.
351 rinit2: inr a ;Increment it.
352 sta numtry ;Save the updated number of tries.
353 mvi a,'1' ;Reset block check type to single character
354 sta curchk ;Store as current type for initialization
355 call rpack ;Get a packet.
356 jmp nak ; Trashed packet: nak, retry.
357 cpi 'S' ;Is it a send initiate packet?
358 jnz rinit3 ;If not see if its an error.
359 rini2a: lda numtry ;Get the number of tries.
362 sta numtry ;Reset the number of tries.
363 lda argblk ;Returned packet number. (Synchronize them.)
365 lda argblk+1 ;Get the number of arguments received.
366 lxi h,data ;Get a pointer to the data.
367 call spar ;Get the data into the proper variables.
368 lxi h,data ;Get a pointer to our data block.
369 call rpar ;Set up the receive parameters.
370 sta argblk+1 ;Store the returned number of arguments.
371 mvi a,'Y' ;Acknowledge packet.
372 call spack ;Send the packet.
373 jmp abort ; Failed, abort.
374 lda inichk ;Now switch to agreed upon check-type
375 sta curchk ;For all future packets
376 mvi a,'F' ;Set the state to file send.
380 rinit3: cpi 'E' ;Is it an error packet.
381 jnz nak0 ;If not NAK whatever it is.
388 rfile: lda numtry ;Get the number of tries.
389 cpi maxtry ;Have we reached the maximum number of tries?
392 call error3 ;Move cursor and print an error message.
393 jmp abort ;Change the state to abort.
395 rfile1: inr a ;Increment it.
396 sta numtry ;Save the updated number of tries.
397 call rpack ;Get a packet.
398 jmp nak ; Trashed packet: nak, retry.
399 cpi 'S' ;Is it a send initiate packet?
400 jnz rfile2 ; No, try next type.
401 lda oldtry ;Get the number of tries.
402 cpi imxtry ;Have we reached the maximum number of tries?
403 jm rfil12 ;If not proceed.
405 call error3 ;Move cursor and print an error message.
406 jmp abort ;Change the state to abort.
408 rfil12: inr a ;Increment it.
409 sta oldtry ;Save the updated number of tries.
410 lda pktnum ;Get the present packet number.
414 lda argblk ;Get the packet's number
415 cmp b ;Is the packet's number one less than now?
416 jnz nak0 ;No, NAK and try again.
417 call updrtr ;Update the retry count.
419 sta numtry ;Reset the number of tries.
420 lxi h,data ;Get a pointer to our data block.
421 call rpar ;Set up the parameter information.
422 sta argblk+1 ;Save the number of arguments.
423 mvi a,'Y' ;Acknowledge packet.
424 call spack ;Send the packet.
425 jmp abort ; Failed, abort.
428 rfile2: cpi 'Z' ;Is it an EOF packet?
429 jnz rfile3 ; No, try next type.
430 lda oldtry ;Get the number of tries.
431 cpi maxtry ;Have we reached the maximum number of tries?
432 jm rfil21 ;If not proceed.
434 call error3 ;Move cursor and print an error message.
435 jmp abort ;Change the state to abort.
440 rfile3: cpi 'F' ;Start of file?
442 mov c,a ;[MF]Save packet type
443 lda remtxt ;[MF]Doing a remote server command?
445 mov a,c ;[MF]Restore packet type
446 jnz rfil3d ;[MF]If yes, same as x packet
448 jnz nak0 ;No, NAK it and try again.
451 lda remtxt ;[MF]Doing a remote command?
454 jnz rfil3a ;[MF]Yes, don't open a file
455 call gofil ;Get a file to write to, and init output buffer.
457 rfil3a: lda numtry ;Get the number of tries.
460 mvi a,'D' ;Set the state to data receive.
462 lda czseen ;Check if we punted a file
463 cpi 'Z' ;and didn't want any more
464 rz ;If that was the request, keep telling other end
465 xra a ;Otherwise, clear flag (^X is only for one file)
466 sta czseen ;And store the flag back
469 rfil3b: cpi 'X' ;Start of 'file?' , but not a file?
472 jnz nak0 ;No, NAK it and try again.
475 call selcon ;[MF]Select Console
476 lda argblk+1 ; get length
477 ora a ;[MF]Anything to write?
479 push psw ;[MF]Yes, save character count
480 mvi e,'<' ;[MF]Write "<<" as in VMSKermit
485 pop psw ;[MF]Restore character count
486 lxi h,data ; lets write the filename (?) to display
487 rfil3f: push psw ;[MF]Save loop counter
488 mov e,m ;[MF]Get character to write
489 inx h ;[MF]and increment character pointer
490 push h ;[MF]Save the pointer
491 call outcon ;[MF]Write character to display
492 pop h ;[MF]Restore pointer
493 pop psw ;[MF]and loop counter
494 dcr a ;[MF]Decrement the counter
495 jnz rfil3f ;[MF]Display entire filename
496 mvi e,'>' ;[MF]Put in ">>" as in VMSKermit
501 call prcrlf ;[MF]New line
502 rfil3e: lda numtry ;Get the number of tries.
505 mvi a,'D' ; expecting a D packet
507 lda czseen ;Check if we punted a file
508 cpi 'Z' ;and didn't want any more
509 rz ;If that was the request, keep telling other end
510 xra a ;Otherwise, clear flag (^X is only for one file)
511 sta czseen ;And store the flag back
514 rfile4: cpi 'B' ;End of transmission.
517 jnz nak0 ;No, NAK it and try again.
518 xra a ;No data. (Packet number already in argblk).
520 mvi a,'Y' ;Acknowledge packet.
521 call spack ;Send the packet.
523 mvi a,'C' ;Set the state to complete.
527 rfile5: cpi 'E' ;Is it an error packet.
535 rdata: lda numtry ;Get the number of tries.
536 cpi maxtry ;Have we reached the maximum number of tries?
539 call error3 ;Display error message.
540 rdat16: lda remtxt ;[MF]Is a Remote command in progress?
542 jnz abort ;[MF]Yes, don't worry about file disposition
543 lda incflg ;[MF]Are we keeping incomplete files?
546 lxi d,fcb ;[MF]No, close the file, ignoring errors
547 push d ;[MF]while protecting the pointer
550 pop d ;[MF]Now delete the file, ignoring errors
553 jmp abort ;Change the state to abort.
554 rdat17: call clofil ;[MF]Try to close the file, writing
555 ;[MF]outstanding buffers to disk
556 jmp rdat37 ;[MF]We can't, the disk is full
557 jmp abort ;[MF]Change the state to "abort"
559 rdata1: inr a ;Increment it.
560 sta numtry ;Save the updated number of tries.
561 call rpack ;Get a packet.
562 jmp nak ; Trashed packet: nak, retry.
563 cpi 'D' ;Is it a data packet?
564 jnz rdata2 ; No, try next type.
565 call compp ;check for correct packet number (zero flag = ok)
566 jz rdat14 ;its correct
567 lda oldtry ;Get the number of tries.
568 cpi maxtry ;Have we reached the maximum number of tries?
569 jm rdat12 ;If not proceed.
571 call error3 ;Display err msg.
572 jmp rdat16 ;[MF]Change the state to abort.
578 lda numtry ;Get the number of tries.
580 lda argblk+1 ;Get the length of the data.
582 jmp rdat3b ;[MF] Unable to write out chars;abort.
584 sta numtry ;Reset the number of tries.
585 sta argblk+1 ;No data. (Packet number still in argblk.)
586 mov c,a ;Assume no data
587 lda czseen ;Check if control-X typed
589 jz rdat15 ;Zero if not typed
590 mov c,a ;Get the type of character typed
591 mvi a,1 ;One data character
592 sta argblk+1 ;Save the count
593 mov a,c ;Get the possible data character
594 sta data ;Store in data area
595 rdat15: mvi a,'Y' ;Acknowledge packet.
596 call spack ;Send the packet.
600 rdata2: cpi 'F' ;Start of file?
601 jnz rdata3 ; No, try next type.
602 lda oldtry ;Get the number of tries.
603 cpi maxtry ;Have we reached the maximum number of tries?
604 jm rdat21 ;If not proceed.
606 call error3 ;Display err msg.
607 jmp rdat16 ;[MF]Change the state to abort.
612 rdata3: cpi 'Z' ;Is it a EOF packet?
613 jnz rdata4 ;Try and see if its an error.
615 jnz nak0 ;No, NAK it and try again.
617 lda argblk+1 ;Get the data length
618 cpi 1 ;Have one item?
619 jnz rdat33 ;If not, ignore data
620 lda data ;Yes, get the character
621 cpi 'D' ;Is it a 'D' for discard?
622 jz rdat36 ;If so, punt file
623 rdat33: lda remtxt ;[MF]Writing text to disk?
625 jnz rdat38 ;[MF]No, don't close file
626 call clofil ;Finish off the file.
627 jmp rdat37 ; Give up if the disk is full.
628 rdat38: xra a ;Since we kept the file,
629 sta czseen ;don't say it was discarded.
630 lda numtry ;Get the number of tries. [MF]
631 sta oldtry ;Save it. [MF]
633 jmp rdat39 ;[MF]and get ready to get more files
634 rdat36: lda numtry ;Get the number of tries.
637 lda remtxt ;[MF]Is a Remote command in progress?
639 jnz rdat39 ;[MF]Yes, don't worry about file disposition
640 lda dscflg ;[MF]Is the file being punted because
641 ora a ;[MF]of a collision?
642 jnz rdat39 ;[MF]Yes, don't delete the existing file
643 lda incflg ;[MF]No, are we keeping incomplete files?
646 lxi d,fcb ;[MF]No, close the file,
647 mvi c,closf ;[MF]ignoring errors
650 pop d ;[MF]Now delete the file,
651 mvi c,delf ;[MF]ignoring errors
653 jmp rdat39 ;[MF]and continue
654 rdat3a: call clofil ;[MF]Try to close the file, writing
655 ;[MF]outstanding buffers to disk
656 jmp rdat37 ;[MF]Can't, disk is full
661 rdat37: call ptchr9 ; Send "?Disk full" on the error line [MF]
662 ; and to the remote Kermit [MF]
663 rdat3b: lda remtxt ;[MF]Doing a Remote command?
665 jnz abort ;[MF]Yes, just abort
666 lxi d,fcb ;[MF]Close the file, ignoring errors
667 push d ;[MF]Protect fcb pointer
670 pop d ;[MF]Restore pointer
671 lda incflg ;[MF]Are we keeping incomplete files?
673 jnz abort ;[MF]Yes, just abort transfer
674 mvi c,delf ;[MF]No, delete the file, ignoring errors
676 jmp abort ;[MF] abort transfer
678 rdata4: cpi 'E' ;Is it an error packet.
686 send: mvi a,cmifi ;Parse an input file spec.
687 lxi d,fcb ;Give the address for the FCB.
689 jmp kermit ; Give up on bad parse.
690 ; section to get remote filename [gnn]
691 lxi d,remnam ;[gnn] where to put filename
693 call comnd ;[gnn] get the text to end of the line
694 jmp kermt3 ;[gnn] failure in reading buffer
695 sta remlen ;[gnn] save length (may be zero)
698 sta mfflg1 ; clear flags...
701 sta fcbcnt ;[gnn] clear fcbcount
702 lxi h,fcb0 ;[gnn] and fcb pointer
705 call mfname ;handle (multi) files
706 jnc send14 ;got a valid file-name
708 call prtstr ;Display error msg. ([hh] where it's visible)
711 send14: call init ;Clear the line and initialize the buffers.
713 sta pktnum ;Set the packet number to zero.
714 sta numtry ;Set the number of tries to zero.
715 sta wrn8 ;[jd] we haven't sent the 8-bit-lost warning
717 shld numpkt ;Set the number of packets to zero.
718 shld numrtr ;Set the number of retries to zero.
719 lda quietd ; a quiet display?
721 jnz send15 ; yup, dont write
722 call scrnrt ;Position cursor
724 call nout ;Write the number of retries.
725 send15: mvi a,'1' ;Reset to use single character checksum
726 sta curchk ;For startup
728 sta state ;Set the state to receive initiate.
731 ;SEND state table switcher
733 send2: lda quietd ; a quiet display?
735 jnz send21 ; yes, so dont write
736 call scrnp ;Position cursor
738 call nout ;Write the packet number.
739 send21: lda state ;Get the state.
740 cpi 'D' ;Are we in the data send state?
745 send3: cpi 'F' ;Are we in the file send state?
747 call sfile ;Call send file.
750 send4: cpi 'Z' ;Are we in the EOF state?
755 send5: cpi 'S' ;Are we in the send initiate state?
758 lda state ;[jd] get state back
759 cpi 'F' ;[jd] into file send state yet?
761 lxi d,inms23 ;[jd] yes, print sending...
765 send6: cpi 'B' ;Are we in the eot state?
770 send7: cpi 'C' ;Are we in the send complete state?
772 lxi d,infms3 ;Yes, write "Complete" message.
773 lda czseen ;Or was it interrupted?
776 lxi d,inms13 ;Yes, then say "Interrupted" instead.
780 send8: cpi 'A' ;Are we in the send "abort" state?
782 lxi d,infms4 ;Print message.
786 send9: lxi d,infms4 ;Anything else is equivalent to "abort".
795 sinit: lda numtry ;Get the number of tries.
796 cpi imxtry ;Have we reached the maximum number of tries?
799 call error3 ;Display ermsg
800 jmp abort ;Change the state to abort.
802 sinit2: inr a ;Increment it.
803 sta numtry ;Save the updated number of tries.
804 mvi a,'1' ;Reset to use single character checksum
805 sta curchk ;For startup
806 lda chktyp ;Get our desired block check type
807 sta inichk ;Store so we tell other end
808 lxi h,data ;Get a pointer to our data block.
809 call rpar ;Set up the parameter information.
810 sta argblk+1 ;Save the number of arguments.
811 lda numpkt ;Get the packet number.
813 lda state ; load state (I or S)
815 call spack ;Send the packet.
816 jmp abort ; Failed, abort.
817 call rpack ;Get a packet.
818 jmp r ; Trashed packet don't change state, retry.
820 jnz sinit3 ;If not try next.
821 call compp ;compare packets. If ok, zero flag set
822 rnz ;If not try again.
823 call countp ;increment packet number modulo 64
824 lda argblk+1 ;Get the number of pieces of data.
825 lxi h,data ;Pointer to the data.
826 call spar ;Read in the data. (decode what they want)
827 lda numtry ;Get the number of tries.
830 sta numtry ;Reset the number of tries.
831 lda state ; se if S or I state
832 cpi 'I' ; I state, so set X as next state
838 sinita: lda inichk ;Get the agreed upon block check type
839 sta curchk ;Store as type to use for packets now
840 mvi a,'F' ;Set the state to file send. (Assumed)
842 call getfil ;Open the file.
843 ret ; assume success; mfname thinks the file exists.
845 sinit3: cpi 'N' ;NAK?
846 jnz sinit4 ;If not see if its an error.
847 call updrtr ;Update the number of retries.
848 lda pktnum ;Get the present packet number.
852 lda argblk ;Get the packet's number.
853 cmp b ;Is the packet's number one more than now?
854 rnz ;If not assume its for this packet, go again.
856 sta numtry ;Reset number of tries.
857 mvi a,'F' ;Set the state to file send.
861 sinit4: cpi 'E' ;Is it an error packet.
863 lda state ;[MF]Get state
864 cpi 'I' ;[MF]If an "I" packet was sent,
865 jz sinitb ;[MF]Ignore the error, pretend success
866 call error ;[MF]else display the error info
867 jmp abort ;[MF]and abort
871 ;[5a] Question [majoc]: Why could not the filename
872 ; parsing have been done by comnd, like all the rest?
874 sfile: lda numtry ;Get the number of tries.
875 cpi maxtry ;Have we reached the maximum number of tries?
879 jmp abort ;Change the state to abort.
881 sfile1: inr a ;Increment it.
882 sta numtry ;Save the updated number of tries.
884 sta czseen ;No control-Z or X seen
885 lxi h,data ;Get a pointer to our data block.
886 shld datptr ;Save it.
887 ; use remote name if given, else use local name [gnn]
888 lda remlen ;[gnn] anything given?
890 jnz sfile4 ;[gnn] use remote name
892 lxi h,fcb+1 ;Pointer to the file name in the FCB.
893 shld fcbptr ;Save position in FCB.
894 mvi b,0 ;No chars yet.
897 cpi 8H ;Is this the ninth char?
898 jnz sfil12 ;If not proceed.
899 mvi a,'.' ;Get a dot.
901 mov m,a ;Put the char in the data packet.
903 shld datptr ;Save position in data packet.
905 sfil12: inr b ;Increment the count.
911 ani 7fH ;Turn off CP/M 2 or 3's high bits.
913 shld fcbptr ;Save position in FCB.
914 cpi '!' ;Is it a good character?
915 jm sfil11 ;If not get the next.
917 mov m,a ;Put the char in the data packet.
919 shld datptr ;Save position in data packet.
921 jmp sfil11 ;Get another.
923 sfil13: mov a,c ;Number of char in file name.
927 mov m,a ;Put in a dollar sign for printing.
928 lda quietd ; a quiet display
930 jnz sfi13a ; yes, dont write
931 call scrfln ;Position cursor
932 sfi13a: lxi d,data ;Print the file name though, in either case
934 lda pktnum ;Get the packet number.
936 mvi a,'F' ;File header packet.
937 call spack ;Send the packet.
938 jmp abort ; Failed, abort.
939 call rpack ;Get a packet.
940 jmp r ; Trashed packet don't change state, retry.
942 jnz sfile2 ;If not try next.
944 rnz ;If not hold out for the right one.
946 lda numtry ;Get the number of tries.
949 sta numtry ;Reset the number of tries.
950 sta bytes ;[10] clear the "bytes transferred" counter
954 call gtchr ;Fill the first data packet
955 jmp sfil16 ;Error go see if its EOF.
956 ; ;Got the chars, proceed.
957 sta size ;Save the size of the data gotten.
958 mvi a,'D' ;Set the state to data send.
962 sfil16: cpi 0FFH ;Is it EOF?
963 jnz abort ;If not give up.
964 mvi a,'Z' ;Set the state to EOF.
968 sfile2: cpi 'N' ;NAK?
969 jnz sfile3 ;Try if error packet.
970 call updrtr ;Update the number of retries.
971 lda pktnum ;Get the present packet number.
975 lda argblk ;Get the packet's number.
976 cmp b ;Is the packet's number one more than now?
977 rnz ;If not go try again.
978 jmp sfil14 ;Just as good as a ACK;go to the ACK code.
980 sfile3: cpi 'E' ;Is it an error packet.
985 ; copy remote name into packet to send [gnn]
986 sfile4: xchg ;[gnn] keep pointer to packet
987 lxi h,remnam ;[gnn] set pointer to name
988 mov c,a ;[gnn] keep count of length
989 mov b,a ;[gnn] and set as loop counter
990 sfil41: mov a,m ;[gnn] get a character
991 stax d ;[gnn] copy it to packet
993 inx d ;[gnn] move pointers
996 ora a ;[gnn] done them all?
997 jnz sfil41 ;[gnn] repeat until done
998 xchg ;[gnn] get final position
999 shld datptr ;[gnn] and save it
1000 jmp sfil13 ;[gnn] now go and send packet
1006 sdata: lda numtry ;Get the number of tries.
1007 cpi maxtry ;Have we reached the maximum number of tries?
1011 jmp abort ;Change the state to abort.
1013 sdata1: inr a ;Increment it.
1014 sta numtry ;Save the updated number of tries.
1015 lxi h, data ;Get a pointer to our data block.
1016 shld datptr ;Save it.
1017 lxi h,filbuf ;Pointer to chars to be sent.
1018 shld cbfptr ;Save position in char buffer.
1019 mvi b,1 ;First char.
1023 shld cbfptr ;Save position in char buffer.
1024 mov c,a ;[jd] preserve character temporarily
1025 lda quot8 ;[jd] doing eighth-bit quoting?
1027 mov a,c ;[jd] restore char
1028 jnz sdat4 ;[jd] using eighth-bit quoting, no warning
1029 lda parity ;[jd] get parity
1030 cpi parnon ;[jd] none?
1031 mov a,c ;[jd] restore character
1032 jz sdat4 ;[jd] no parity, leave char alone
1033 lda wrn8 ;[jd] look at warning flag
1034 ora a ;[jd] have we already given the warning?
1035 jnz sdat5 ;[jd] yes, skip this
1036 mov a,c ;[jd] restore character...
1037 ani 80h ;[jd] examine parity
1038 jz sdat5 ;[jd] no parity, no warning.
1039 call parwrn ;[jd] ...print warning - parity lost
1040 mvi a,0ffh ;[jd] remember that we sent the message
1042 sdat5: mov a,c ;[jd] restore character again
1043 ani 7fh ;[jd] strip parity so not checksummed
1045 mov m,a ;Put the char in the data packet.
1047 shld datptr ;Save position in data packet.
1048 inr b ;Increment the count.
1049 lda size ;Get the number of chars in char buffer.
1050 cmp b ;Have we transfered that many?
1051 jp sdat11 ;If not get another.
1052 lda size ;Number of char in char buffer.
1054 lda pktnum ;Get the packet number.
1056 mvi a,'D' ;Data packet.
1057 call spack ;Send the packet.
1058 jmp abort ; Failed, abort.
1059 call rpack ;Get a packet.
1060 jmp r ; Trashed packet don't change state, retry.
1062 jnz sdata2 ;If not try next.
1064 rnz ;If not hold out for the right one.
1065 lda argblk ;Get the packet number back
1067 lda numtry ;Get the number of tries.
1068 sta oldtry ;Save it.
1070 sta numtry ;Reset the number of tries.
1071 lda argblk+1 ;Get the data length
1072 cpi 1 ;Check if only 1 character?
1073 jnz sdat15 ;If not, just continue
1074 lda data ;Got one character, get it from data
1075 cpi 'Z' ;Want to abort entire stream?
1076 jnz sdat14 ;If not, check for just this file
1077 sta czseen ;Yes, remember it
1078 jmp sdat16 ;[MF] and set EOF state
1079 sdat14: cpi 'X' ;Desire abort of current file?
1080 jnz sdat15 ;If not, just continue
1081 sta czseen ;Yes, remember that
1082 jmp sdat16 ;[MF] and set EOF
1083 sdat15: lda czseen ;Also get control-Z flag
1084 ora a ;Check if either given
1085 jz sdat12 ;If neither given, continue
1086 sdat16: mvi a,'Z' ;Change state to EOF
1091 jmp sdat13 ;Error go see if its EOF.
1092 sta size ;Save the size of the data gotten.
1095 sdat13: cpi 0FFH ;Is it EOF?
1096 jnz abort ;If not give up.
1097 mvi a,'Z' ;Set the state to EOF.
1101 sdata2: cpi 'N' ;NAK?
1102 jnz sdata3 ;See if is an error packet.
1103 call updrtr ;Update the number of retries.
1104 lda pktnum ;Get the present packet number.
1108 lda argblk ;Get the packet's number.
1109 cmp b ;Is the packet's number one more than now?
1110 rnz ;If not go try again.
1111 jmp sdat12 ;Just as good as a ACK;go to the ACK code.
1113 sdata3: cpi 'E' ;Is it an error packet.
1121 seof: lda numtry ;Get the number of tries.
1122 cpi maxtry ;Have we reached the maximum number of tries?
1126 jmp abort ;Change the state to abort.
1128 seof1: inr a ;Increment it.
1129 sta numtry ;Save the updated number of tries.
1130 lda pktnum ;Get the packet number.
1133 sta argblk+1 ;No data.
1134 lda czseen ;Check if C-Z or C-X typed
1136 jz seof14 ;If not aborted, just keep going
1137 mvi a,'D' ;Tell other end to discard packet
1138 sta data ;Store in data portion
1139 mvi a,1 ;One character
1140 sta argblk+1 ;Store the length
1141 seof14: mvi a,'Z' ;EOF packet.
1142 call spack ;Send the packet.
1143 jmp abort ; Failed, abort.
1144 call rpack ;Get a packet.
1145 jmp r ; Trashed packet don't change state, retry.
1147 jnz seof2 ;If not try next.
1149 rnz ;If not hold out for the right one.
1151 lda numtry ;Get the number of tries.
1152 sta oldtry ;Save it.
1154 sta numtry ;Reset the number of tries.
1155 mvi c,closf ;Close the file.
1158 ;* Check if successful
1159 lda czseen ;Desire abort of entire stream?
1160 cpi 'Z' ;Desire abort of entire stream?
1161 jz seof13 ;If so, just give up now
1162 call mfname ;Get the next file.
1163 jc seof13 ; No more.
1164 call getfil ;and open it (assume success)
1166 sta czseen ;Since we have not aborted this file
1167 mvi a,'F' ;Set the state to file send.
1171 seof13: mvi a,'B' ;Set the state to EOT.
1175 seof2: cpi 'N' ;NAK?
1176 jnz seof3 ;Try and see if its an error packet.
1177 call updrtr ;Update the number of retries.
1178 lda pktnum ;Get the present packet number.
1182 lda argblk ;Get the packet's number.
1183 cmp b ;Is the packet's number one more than now?
1184 rnz ;If not go try again.
1185 jmp seof12 ;Just as good as a ACK;go to the ACK code.
1187 seof3: cpi 'E' ;Is it an error packet.
1195 seot: lda numtry ;Get the number of tries.
1196 cpi maxtry ;Have we reached the maximum number of tries?
1200 jmp abort ;Change the state to abort.
1202 seot1: inr a ;Increment it.
1203 sta numtry ;Save the updated number of tries.
1204 lda pktnum ;Get the packet number.
1207 sta argblk+1 ;No data.
1208 mvi a,'B' ;EOF packet.
1209 call spack ;Send the packet.
1210 jmp abort ; Failed, abort.
1211 call rpack ;Get a packet.
1212 jmp r ; Trashed packet don't change state, retry.
1214 jnz seot2 ;If not try next.
1216 rnz ;If not hold out for the right one.
1218 lda numtry ;Get the number of tries.
1219 sta oldtry ;Save it.
1221 sta numtry ;Reset the number of tries.
1222 mvi a,'C' ;Set the state to file send.
1226 seot2: cpi 'N' ;NAK?
1227 jnz seot3 ;Is it error.
1228 call updrtr ;Update the number of retries.
1229 lda pktnum ;Get the present packet number.
1233 lda argblk ;Get the packet's number.
1234 cmp b ;Is the packet's number one more than now?
1235 rnz ;If not go try again.
1236 jmp seot12 ;Just as good as a ACK;go to the ACK code.
1238 seot3: cpi 'E' ;Is it an error packet.
1243 ; This routine sets up the data for init packet (either the
1244 ; Send_init or ACK packet).
1245 ; called by: rinit, rfile, sinit
1247 ; Called by rinit, rfile and sinit. See what WE want from the other fella
1249 ; [11] by OBS - Stripped out all the new capas code etc and reverted
1250 ; to Good Ol' Basic Kermit again!
1251 ; Those keen should study the followin gode with care, and remove
1252 ; or add semicolons as indicated.
1254 ; See also SPAR which decodes what comes in. It also decodes bits in
1255 ; the "capability" fields. (Two CAPAS files allowed from remote
1256 ; machines, but we will only send one at max.) Note that not all
1257 ; if any of the capability bits will be used.
1259 ; Definitions - init packet (data section only.. rest of header assumed OK)
1260 ; Byte 0 Maximum length I want to send
1261 ; 1 The Timeout I want you to use
1262 ; 2 Number of PAD characters I want tot use (May be null)
1263 ; 3 The PAD character I want to use (May be Null)
1264 ; 4 The End-of-Line character I will use (Carriage Return)
1265 ; 5 The control character Quote Character I will use (#)
1266 ; 6 The parity bit Quote Character I will use (&)
1267 ; 7 The Checktype I will use
1268 ; 8 The repeat prefix I will use (Null, as we cannot to repeats)
1269 ; 9 Capability Byte 0 (See SPAR for defs)
1270 ; 10 Capability byte 1 ( --- " --- but we will not send it.)
1271 ; 11 The number of packets I will send per window (not used)
1272 ; 12 MAXL1 - Long packet size, ms count
1273 ; 13 MAXL2 - Long packet size, ls count
1276 ; Enter with HL pointing to the "data" part of the packet.
1279 ; older part of rpar follows...
1282 rpar: lda rpsiz ;Get the receive packet size.
1283 adi space ;Add a space to make it printable.
1284 mov m,a ;Put it in the packet.
1285 inx h ;Point to the next char.
1286 lda rtime ;Get the receive packet time out.
1287 adi space ;Add a space.
1288 mov m,a ;Put it in the packet.
1290 lda rpad ;Get the number of padding chars.
1294 lda rpadch ;Get the padding char.
1295 adi 100O ;Uncontrol it.
1299 lda reol ;Get the EOL char.
1303 lda rquote ;Get the quote char.
1306 mvi m,'Y' ;[jd] we know how to do 8-bit quoting
1308 cpi parnon ;[jd] parity none?
1309 jz rpar1 ;[jd] yes, keep going
1310 lda qbchr ;[jd] no, better request 8-bit quoting
1314 inx h ;Advance to next
1315 lda chktyp ;Get desired block check type
1317 inx h ;Advance pointer
1319 ; Comment out the next two lines for capas etc. WILL require debugging
1320 mvi a,8 ; this id the older end for this routine. May be useful.
1323 ; [11] Rest not needed for now, commented out
1325 ; New additions to rpar follows...
1327 ; lda rcap1 ; get the first capability byte
1328 ; ani 3eh ; mask out bit 0, ie only one CAPAS byte
1329 ; adi space ; tochar it
1332 ; mvi m,space ; No windows, ie space to packet
1334 ; push h ; we need the HL regs for maths.
1335 ; lhld rdpkt ; get receive packet length
1336 ; lxi d,95 ; we want hl div 95 and hl mod 95
1337 ; call divide ; return with divsion in hl, remainder in de
1338 ; mov a,l ; two sets of bytes
1340 ; adi space ; tochar(maxl1)
1344 ; adi space ; tochar(maxl2)
1347 ; done all, set databytes = 12 and return
1348 ; mvi a,12 ; 12 bits of data
1351 ;[11] End of commented out code for rpar
1355 ; This routine reads in all the send_init packet information.
1356 ; called by: rinit, sinit
1358 ;[11] As for rpar, restore the "old" kermit code for non-capas Kermit.
1359 ;[10] (to ret at end)
1361 ; SPAR - routine to decode parameters received from the remote end
1363 ; Called by rinit,sinit
1365 ; Entry: a: Number of databytes in packet
1366 ; hl: Pointer to "data" part of packet
1368 ;spar: sta temp4 ; save for a while
1369 ; ; first clear some variables
1370 ; lda dspsiz ; get default "send" packet length
1372 ; lda dstime ; get default time-out
1374 ; xra a ; set no pad characters by default
1376 ; lda dspadc ; get the default padding character
1378 ; mvi a,cr ; default end of line character (CR)
1380 ; mvi a,dsquot ; default quote character
1382 ; mvi a,dsbqut ; default binary quote character
1384 ; mvi a,dschkt ; set checktype = 1 for inits
1386 ; mvi a,space ; no repeat prefixing ( otherwise ~)
1389 ; Now follows the "capabilities" bits... 5 bits per capas byte.
1391 ; Note: Before extracting any data bits, apply unchar() to get the
1392 ; six ls bits. If bit 0 = 1 the a subsequent capaa byte follows
1394 ; Byte0: Bit 0: Set to 1 if there are subsequent CAPAS bytes
1395 ; 1: (Cap. 5) Set to 1 for long packets. Second byte
1396 ; AFTER the last capas byte has packet length DIV 95
1397 ; and Thire byte has length MOD 95
1398 ; 2: (Cap. 4) Sliding Windows. If used, first byte AFTER
1399 ; last capas byte has TOCHAR(no. of packets in window)
1400 ; 3: (Cap. 3) Ability to accept "A" (attribute packets)
1401 ; 4: (Cap. 2) Reserved
1402 ; 5: (Cap. 1) Reserved
1403 ; Byte 2 onward: not used in this implementation. Any capas bytes sent
1404 ; will be stored, however.
1406 ; lda temp4 ; get the number of bytes to test
1407 ; mov c,a ; to a count register
1408 ; mov a,m ; get first byte
1409 ; call decc ; unchar it, and decrement c
1410 ; sta spsiz ; save a send packet size
1411 ; jz sparx ; if no more, exit
1413 ; mov a,m ; get timout
1415 ; sta stime ; save timeout
1418 ; mov a,m ; get pad characters
1420 ; sta spadc ; save it
1423 ; mov a,m ; get pad character count
1428 ; mov a,m ; get send EOL
1433 ; mov a,m ; get control quote character
1438 ; mov a,m ; get binary (parity) quote char
1439 ; mov b,a ; this time we actually WANT accumulator
1440 ; cpi space ; are we doing 8th bit quoteing
1441 ; jz spar1 ; dont know, assume not
1442 ; cpi 'N' ; definately not?
1444 ; cpi 'Y' ; definately - use &
1446 ; sta squote ; else save the new character
1447 ;spar2: lda parity ; see if we are using the parity bit
1448 ; cpi parnon ; no parity => no quoting
1449 ; jz spar3 ; yup, so use the default quote character &
1451 ;spar1: xra a ; save not quoting
1453 ;spar3: call decc ; update counters etc
1456 ; mov a,m ; get repeat prefixing
1458 ; push psw ; save flags
1459 ; cpi space-32 ; we want it?
1462 ;spar4: pop psw ; restore flags
1465 ; lxi d,scapas ; point to start of capability byte(s)
1466 ; push psw ; must do this...
1467 ;spar5: pop psw ; cos we restore the spack
1469 ; call decc ; get scap1 (or n)
1472 ; ani 01 ; another byte following?
1474 ; pop psw ; see if any other data bytes (Windows etc)
1477 ; mov a,m ; get window size
1482 ; mov a,m ; get long packets ms bits
1484 ; mov d,a ; unchared ms bits-ish
1486 ; call decc ; ls bits-ish
1487 ; push h ; and we are doing maths
1488 ; push b ; and an intermediate result in c
1489 ; push psw ; we want flags and the ls bits...
1491 ; mov c,d ; get ms bits-ish to bc
1492 ; push b ; get number to hl
1499 ; push h ; *16 to ...
1502 ; dad d ; *(32+16) = *48
1510 ; pop psw ; restore ls bitsish
1513 ; dad d ; *95 + ls bits. Phew.
1514 ; shld sdpkt ; save long packet length
1516 ; pop h ; restore regs
1518 ;sparx: ret ; if here, (assume) no more data to read in
1519 ;[10] routines required follow
1520 ;decc: mov a,m ; get data byte
1521 ; sui space ; unchar it
1522 ; inx h ; increment input pointer
1523 ; dcr c ; decrement data counter
1525 ;[10] end or spar replacement
1527 ;[11] Restore older spar....
1528 ; Older spar follows...
1529 spar: sta temp4 ;Save the number of arguments.
1530 ; Initialize some variables to their required default values, so we use
1531 ; the right values even if the remote Kermit doesn't send the full packet:
1532 ; ; we don't do anything with timeout values yet.
1533 ; ; no default pad count/pad character?
1534 mvi a,cr ; EOL character = carriage-return
1536 mvi a,'#' ; quote character = '#'
1538 mvi a,'&' ; eighth-bit quote character = '&'
1540 mvi a,'1' ; block-check = 1-character-checksum
1543 mov a,m ;Get the max packet size.
1544 sbi space ;Subtract a space.
1547 cpi 3 ;Fewer than three pieces?
1548 rm ;If so we are done.
1550 inx h ;Increment past the time out info.
1551 mov a,m ;Get the number of padding chars.
1555 cpi 4 ;Fewer than four pieces?
1556 rm ;If so we are done.
1558 mov a,m ;Get the padding char.
1559 adi 100O ;Re-controlify it.
1563 cpi 5 ;Fewer than five pieces?
1564 rm ;If so we are done.
1566 mov a,m ;Get the EOL char.
1570 cpi 6 ;Fewer than six pieces?
1571 rm ;If so we are done.
1573 mov a,m ;Get the quote char.
1575 lda temp4 ;Get the amount of data supplied
1576 cpi 7 ;Have an 8-bit quote?
1577 rm ;If not there, all done
1578 inx h ;Yes, get the character
1580 sta quot8 ;[jd] assume not quoting
1581 mov a,m ;Get the supplied character
1583 jz spar1 ;[jd] then don't try to do it
1584 cpi space ;[jd] maybe they don't know about it...
1585 jz spar1 ;[jd] then don't try to do it.
1587 jnz spar2 ;[jd] if not 'Y', assume it's a quote char.
1588 lda parity ;[jd] using parity?
1589 cpi parnon ;[jd] no, don't need quoting...
1591 mvi a,0ffh ;[jd] else turn on...
1592 sta quot8 ;[jd] ...quote flag
1595 ;[11] Note: If capas etc required, beware of the next two lables, as these
1596 ; are used elswhere.
1598 spar2: sta qbchr ;[jd] use their quote char (should validate)
1600 sta quot8 ;[jd] turn quote flag and fall thru...
1602 spar1: lda temp4 ;Determine if block check type given
1603 cpi 8 ;Is the field there?
1604 rm ;If not, all done
1605 inx h ;Point to the character
1606 mov a,m ;Get the value
1608 lda chktyp ;Get our type
1609 cmp b ;Is it our desired type?
1610 rnz ; If not, use default (1-character-checksum)
1611 sta inichk ; Match, store as type to use after init
1613 ;[10] end of replacement
1614 ;[11] end of replacement of replacement (ie back to original code)
1617 ; Copy characters from packet to disk (or screen)
1620 ptchr: sta temp1 ;Save the size.
1621 lda remtxt ;[MF]Get remote command flag
1622 ora a ;[MF]Remote command in progress?
1623 jnz ptchr0 ;[MF]Yes, don't check for file collisions
1624 lda flwflg ;[MF]Get File Warning (Set Collision) flag
1625 cpi 3 ;[MF]SET COLLISION DISCARD?
1627 lda dscflg ;[MF]Yes, get "discard" flag
1628 ora a ;[MF]Discarding file?
1630 mvi a,'X' ;[MF]Yes, simulate a user rejection
1632 jmp rskp ;[MF]and pretend success
1634 lxi h,data ;Beginning of received packet data.
1635 shld outpnt ;Remember where we are.
1637 mov b,a ;Keep the quote char in b.
1638 mvi c,0 ;[jd] assume no 8-bit quote char
1639 lda quot8 ;[jd] doing 8-bit quoting?
1641 jz ptchr1 ;[jd] no, keep going
1642 lda qbchr ;[jd] else get 8-bit quote char
1643 mov c,a ;[jd] keep this in c
1645 dcr m ;Decrement # of chars in packet.
1646 jm rskp ;Return successfully if done.
1647 lda remtxt ; to screen only?
1649 jnz ptchr2 ; dont do any disk stuff
1650 lxi h,chrcnt ;Number of chars remaining in dma.
1652 jp ptchr2 ;Continue if space left.
1653 call outbuf ;Output it if full.
1654 jmp ptchr9 ; Error return if disk is full.
1655 ptchr2: lhld outpnt ;Get position in output buffer.
1656 mov a,m ;Grab a char.
1658 shld outpnt ;and bump pointer.
1659 mvi e,0 ;[jd] assume nothing to OR in.
1660 cmp c ;[jd] is it the binary quote char?
1661 jnz ptch2a ;[jd] no, keep going
1662 mvi e,80h ;[jd] include parity bit
1665 sta temp1 ;[jd] decrement character count
1666 mov a,m ;[jd] get next character
1669 ptch2a: cmp b ;Is it the quote char?
1670 jnz ptchr3 ;[jd] changed to ptchr3 so includes parity
1671 mov a,m ;Get the quoted character
1673 shld outpnt ;and bump pointer.
1675 dcr m ;Decrement # of chars in packet.
1676 mov d,a ;Save the char.
1677 ani 80H ;Turn off all but the parity bit.
1678 ora e ;[jd] let parity come from either (???)
1679 mov e,a ;Save the parity bit.
1680 mov a,d ;Get the char.
1681 ani 7FH ;Turn off the parity bit.
1682 cmp b ;Is it the quote char?
1683 jz ptchr3 ;If so just go write it out.
1684 cmp c ;[jd] maybe it's the 8-bit prefix character?
1685 jz ptchr3 ;[jd] then don't controllify.
1686 mov a,d ;Get the char.
1687 adi 40H ;Make the character a control char again.
1688 ani 7FH ;Modulo 128.
1689 ptchr3: ora e ;Or in the parity bit.
1690 sta temp3 ; save for a while
1691 lda remtxt ; to screen or disk?
1698 mov e,a ; to display
1704 jmp ptchr1 ; continue
1706 ptch31: lhld bufpnt ;Destination buffer.
1709 shld bufpnt ;Update the pointer
1710 jmp ptchr1 ;and loop to next char.
1712 ptchr9: lxi d,erms11 ; "?Disk full"
1713 push d ;[MF] Save pointer
1714 call error3 ; put it on the error line
1715 pop d ;[MF] Restore pointer
1716 lxi h,data ;[MF] Where to put the message for "e" packet
1717 lda argblk ;[MF] Get packet-number
1718 call countp ;[MF]Increment it
1719 sta argblk ;[MF] as packet to send
1720 xra a ;[MF] Zero length of packet data
1722 ptch9a: ldax d ;[MF] Get a character to copy
1723 cpi cr ;[MF] No more to copy?
1724 jz ptch9b ;[MF] Yes, we can send the packet
1725 mov m,a ;[MF] No, copy the character
1726 inx d ;[MF] and increment source/dest pointers
1728 lda temp1 ;[MF] Get character count
1729 inr a ;[MF] and increment it
1731 jmp ptch9a ;[MF] Copy entire error message
1732 ptch9b: mvi m,0 ;[MF]Put in a zero
1733 lda temp1 ;[MF] Get number of characters in the message
1734 sta argblk+1 ;[MF] and store as number of packet data chars
1735 mvi a,'E' ;[MF] Make it an error packet
1736 call spack ;[MF] Send the error packet
1737 nop ;[MF] Don't really care if
1738 nop ;[MF] the send fails since we're
1739 nop ;[MF] bombing off anyway
1740 ret ; take error return.
1742 ; Fill a data packet from file
1743 ; called by: sfile, sdata
1745 gtchr: lda squote ;Get the quote char.
1746 mov c,a ;Keep quote char in c.
1747 lda curchk ;Get current block check type
1748 sui '1' ;Get the extra overhead
1750 lda spsiz ;Get the maximum packet size.
1751 sui 5 ;Subtract the overhead.
1752 sub b ;Determine max packet length
1753 sta temp1 ;This is the number of chars we are to get.
1754 lxi h,filbuf ;Where to put the data.
1755 shld cbfptr ;Remember where we are.
1758 dcr a ;Decrement the number of chars left.
1759 jp gtchr2 ;Go on if there is more than one left.
1760 mov a,b ;Return the count in A.
1764 lda chrcnt ;Space left in the DMA.
1766 ;* Can improve order here.
1771 gtchr3: call inbuf ;Get another buffer full.
1772 jmp gtch30 ; If no more return what we got.
1773 jmp gtchr4 ;If we got some, proceed.
1775 gtch30: mov a,b ;Return the count in A.
1776 ora a ;Get any chars?
1777 jnz rskp ;If so return them.
1778 jmp gtceof ;If not, say we found the end of the file.
1780 gtchr4: lhld bufpnt ;Position in DMA.
1781 mov a,m ;Get a char from the file.
1784 mov d,a ;Save the char.
1785 ani 80H ;Turn off all but parity.
1786 mov e,a ;Save the parity bit.
1787 jz gtch4a ;[jd] no parity, skip this check...
1788 lda quot8 ;[jd] doing eighth-bit quoting?
1790 jz gtch4a ;[jd] no, just proceed normally
1791 lda temp1 ;[jd] get space remaining
1792 cpi 2 ;[jd] 3 chrs left (one cnted already)?
1793 jm gtchr9 ;[jd] no, skip this
1794 dcr a ;[jd] decrement space remaining
1795 sta temp1 ;[jd] put back.
1796 lhld cbfptr ;[jd] Position in character buffer.
1797 lda qbchr ;[jd] get quote character
1798 mov m,a ;]jd] Put the quote char in the buffer.
1799 inx h ;[jd] increment destination buffer pointer
1800 shld cbfptr ;[jd] store the pointer back
1801 inr b ;[jd] Increment the char count.
1802 mvi e,0 ;[jd] no parity bit to OR in.
1805 gtch4a: mov a,d ;Restore the char.
1806 ani 7FH ;Turn off the parity.
1807 mov d,a ;[jd] save here for later...
1808 cpi space ;Compare to a space.
1809 jm gtchr5 ;If less then its a control char, handle it.
1810 cpi del ;Is the char a delete?
1811 jz gtchr5 ;Go quote it.
1812 lda quot8 ; Are we doing 8th-bit quoting?
1814 jz gtch4c ; if not, skip this test and restore character.
1815 lda qbchr ; get 8th-bit quote character
1816 cmp d ; same as current character?
1817 jz gtch4b ; yes, have to quote it...
1818 gtch4c: mov a,d ; no. get character back again.
1819 cmp c ;Is it the quote char?
1820 jnz gtchr8 ;If not proceed.
1821 gtch4b: lxi h,temp1 ;[jd] point to char count
1822 dcr m ;[jd] decrement (know room for at least one)
1823 lhld cbfptr ;Position in character buffer.
1824 mov m,c ;Put the (quote) char in the buffer.
1827 inr b ;Increment the char count.
1828 mov a,d ;[jd] restore character again
1832 ;[gnn] ignore parity for checking
1833 ; ora e ;Turn on the parity bit.
1835 cpi ('Z'-100O) ;Is it a ^Z?
1836 jnz gtchr7 ;If not just proceed.
1837 lda cpmflg ;Was the file created by CPM...
1838 cpi 1 ;in ASCII-mode ?
1839 jz gtch52 ;Control-Z stops text
1840 cpi 2 ;in BINARY mode?
1841 jz gtchr6 ;Yes, pass the ^Z
1842 ;At this point file-mode is DEFAULT.
1843 ;If the rest of the record is filled with ^Zs, we're at EOF, otherwise
1844 ;its a regular character.
1845 lhld bufpnt ;since CHRCNT is ZERO at EOF-time
1846 lda chrcnt ;(set by INBUF5 B.G.E)
1847 mov d,a ;Get the number of chars left in the DMA.
1850 jp gtch53 ;Any chars left?
1851 gtch52: xra a ;If not, get a zero.
1852 sta chrcnt ;Say no more chars in buffer.
1853 mov a,b ;Return the count in A.
1856 ;Scan rest of buffer for non ^Z -- If we find a non ^Z, fall into gtchr6.
1857 ;If we get to the end of the buffer before finding a non ^Z, fall into gtch52.
1858 gtch53: mov a,m ;Get the next char.
1859 inx h ;Move the pointer.
1860 cpi ('Z'-100O) ;Is it a ^Z?
1861 jz gtch51 ;If so see if the rest are.
1863 gtchr6: mvi a,('Z'-100O) ;Restore the ^Z.
1864 gtchr7: sta temp2 ;Save the char.
1865 lxi h,temp1 ;Point to the char total remaining.
1866 dcr m ;Decrement it.
1867 lhld cbfptr ;Position in character buffer.
1868 mov m,c ;Put the quote in the buffer.
1871 inr b ;Increment the char count.
1872 lda temp2 ;Get the control char back.
1873 adi 40H ;Make the non-control.
1874 ani 7fH ;Modulo 200 octal.
1875 gtchr8: lhld cbfptr ;Position in character buffer.
1876 ora e ;Or in the parity bit.
1877 mov m,a ;Put the char in the buffer.
1880 inr b ;Increment the char count.
1881 jmp gtchr1 ;Go around again.
1883 gtchr9: ;[jd] not enough room left in buffer...
1886 shld bufpnt ;[jd] back up over last character
1887 lxi h,chrcnt ;[jd] point to character count
1888 inr m ;[jd] increment it
1889 mov a,b ;[jd] count of chars transferred
1890 jmp rskp ;[jd] return it
1892 gtceof: mvi a,0FFH ;Get a minus one.
1896 ; Little code to allow some expansion of code without changing
1897 ; every futher address, only up to the end of this file.
1898 ; TO BE REMOVED FRO RELEASE!
1900 ; org ($+100h) AND 0FF00H
1903 LINK CPSPK2 ;[obs] Link to part two of the packet file
projects / kermit-80.git / blob