; 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