Bugfix in outmdm (output buffer flush)

[kermit-80.git] / cpspk2.asm

; CPSPK2.ASM\r
;       KERMIT - (Celtic for "FREE")\r
;\r
;       This is the CP/M-80 implementation of the Columbia University\r
;       KERMIT file transfer protocol.\r
;\r
;       Version 4.0\r
;\r
;       Copyright June 1981,1982,1983,1984\r
;       Columbia University\r
;\r
; Originally written by Bill Catchings of the Columbia University Center for\r
; Computing Activities, 612 W. 115th St., New York, NY 10025.\r
;\r
; Contributions by Frank da Cruz, Daphne Tzoar, Bernie Eiben,\r
; Bruce Tanner, Nick Bush, Greg Small, Kimmo Laaksonen, Jeff Damens, and many\r
; others. \r
;\r
;       This file contains the (system-independent) routines that implement\r
;       the KERMIT protocol, and the commands that use them:\r
;       RECEIVE, SEND, FINISH, and LOGOUT.\r
;\r
; revision history:\r
;\r
;edit 11, 21-Mar-1991 by MF. After "inchr7", close TAKE-file (if any) so\r
;	^C will halt all processing (including commands from TAKE-files)\r
;	and put the user back at Kermit command-level.\r
;edit 10, 3-Jan-1991 by MF. Modify routine "inchr" after label "inchr5" to\r
;	not take retry (nonskip) return if ^X/^Z seen on the Console. This\r
;	will prevent multiple copies of packets being sent if user aborts\r
;	some files in a stream being sent via ^X and is a better fix to this\r
;	problem than flushing comm input before sending the "Z" packet\r
;	requesting the remote Kermit to discard the current file being\r
;	received (as implemented in CPSPK1.ASM edit of 2-jan-1991).\r
;edit 9, 14-Dec-1990 by MF. Modified "gofil" routine to allow for\r
;	specification of a drive in the local filespec for GET and\r
;	RECEIVE commands. Thus commands such as\r
;	GET HELLO.TXT B:GOODBYE.TXT\r
;	and\r
;	RECEIVE B:GOODBYE.TXT\r
;	now work as expected.\r
;edit 8, 22-Oct-1990 by MF.  Fixed bug in completion-message routine\r
;	"finmes" wherein the completion message was not printed if the\r
;	terminal was set to QUIET because the message pointer was clobbered\r
;	by prcrlf.\r
;edit 7, 14-Sep-1990 by MF.  Add hooks for SET COLLISION command.\r
;	Eliminate commented-out old file warning rename routine.\r
;	Clear communication input buffers (call flsmdm) before\r
;	BYE, FINISH and LOGOUT commands.\r
;edit 6, 9-Sep-1990 by MF.  Implemented fixes in CPKERM.BWR for\r
;	garbage printout during quiet transfers and for file existence/\r
;	rename algorithm.\r
;	Also implemented hooks for Remote commands.\r
; edit 5, 18 June 1990 by Russell Lang [rjl@monu1.cc.monash.edu.au]\r
;	When trying to generate a unique file name on receive, zero\r
;	the attribute bits between file opening attempts.  This is\r
;	to fix a bug which caused the unique file name to have the\r
;	attributes of the already existing file.  If the attribute\r
;	was R/O, a bdos error occured later when an attempt was made\r
;	to write to the file.\r
;\r
; edit 4, 27 October, 1987 By OBSchou.  Changed the rename routine to \r
;	be more like the MSDOS issue.\r
;\r
; edit 3, 28 July, by OBSchou.  Added traps to NOT print to screen during\r
;	file transfers if quietd is non zero (ie we SET TERMINAL QUIET)\r
;	This hopefully speeds up transfers in systems spending an age\r
;	updating the screen.\r
;\r
; edit 2, 8 April, 1987 by OBSchou.  Minor edit to put drive and user number\r
;	in the "filename" field on the transfer screen.  This means that the\r
;	offset on the line foe the file name proper has moved along 4 space.  \r
;	Also, it writes 15 spaces AFER the xxd: string to clear the field \r
;	of any prevous file.  Needed for thos terminals that cannot\r
;	clear to end of line...\r
;\r
; edit 1, 28 January, 1987 by OBSchou.\r
;	Hived off about 1/2 of CPSPKT.ASM to form two (smaller => easier\r
;	to handle) files.  \r
;\r
;\r
\r
pk2ver:	db	'CPSPK2.ASM (11)  21-Mar-1991$'     ; name, edit number, date\r
\r
\r
;\r
;       Get the file name (including host to micro translation)\r
;       called by: rfile\r
\r
gofil:	xra	a\r
	sta	fcb		;Set the drive to default to current.\r
	lxi	h,data		;Get the address of the file name.\r
; allow use of local name if one was given [gnn]\r
	lda	remlen		;[gnn] \r
	ora	a		;[gnn] anything there?\r
	jz	gofil0		;[gnn]  no, use the one in the data packet\r
	lxi	h,remnam	;[gnn] yes, use this instead\r
	lda	remnam+1	;[MF]Get 2nd char of local filename\r
	cpi	':'		;[MF]Was a drive specified?\r
	jnz	gofil0		;[MF]No, proceed as of old\r
	mov	a,m		;[MF]Yes, get drive\r
	ani	5fh		;[MF]Force uppercase\r
	sui	'A'-1		;[MF]Make valid drive for fcb\r
	sta	fcb		;[MF]and store in fcb\r
	inx	h		;[MF]Skip drive and delimiter\r
	inx	h		;[MF]...\r
gofil0:				;[gnn]  continue to set up the file [gnn]\r
;\r
	shld	datptr		;Store the address.\r
	lxi	h,fcb+1		;Address of the FCB.\r
	shld	fcbptr		;Save it.\r
	xra	a\r
	sta	temp1		;Initialize the char count.\r
	sta	temp2\r
	mvi	b,' '\r
gofil1:	mov	m,b		;Blank the FCB.\r
	inx	h\r
	inr	a\r
;       cpi     0CH             ;Twelve?[5a]\r
	cpi	0BH		; Eleven? [5a]\r
	jm	gofil1\r
	mvi	m,0		; [5a] Specify extent 0\r
gofil2:	lhld	datptr		;Get the NAME field.\r
	mov	a,m\r
	cpi	'a'             ;Force upper case\r
	jm	gofl2a		;\r
	ani	5FH		;\r
gofl2a:	inx	h\r
	cpi	'.'             ;Seperator?\r
	jnz	gofil3\r
	shld	datptr		;[jd] update ptr (moved from above)\r
	lxi	h,fcb+9H\r
	shld	fcbptr\r
	lda	temp1\r
	sta	temp2\r
	mvi	a,9H\r
	sta	temp1\r
	jmp	gofil6\r
\r
gofil3:	ora	a		;Trailing null?\r
	jz	gofil7		;Then we're done.\r
	shld	datptr		;[jd] no, can update ptr now.\r
	lhld	fcbptr\r
	mov	m,a\r
	inx	h\r
	shld	fcbptr\r
	lda	temp1		;Get the char count.\r
	inr	a\r
	sta	temp1\r
	cpi	8H		;Are we finished with this field?\r
	jm	gofil2\r
gofil4:	sta	temp2\r
	lhld	datptr\r
	mov	a,m\r
	inx	h\r
	shld	datptr\r
	ora	a\r
	jz	gofil7\r
	cpi	'.'             ;Is this the terminator?\r
	jnz	gofil4		;Go until we find it.\r
gofil6:	lhld	datptr		;Get the TYPE field.\r
	mov	a,m\r
	cpi	'a'             ;Force upper case\r
	jm	gofl6a		;\r
	ani	5FH		;\r
gofl6a:	ora	a		;Trailing null?\r
	jz	gofil7		;Then we're done.\r
;[jd] move above two lines so we don't increment pointer if char is null\r
	inx	h\r
	shld	datptr\r
	lhld	fcbptr\r
	mov	m,a\r
	inx	h\r
	shld	fcbptr\r
	lda	temp1		;Get the char count.\r
	inr	a\r
	sta	temp1\r
	cpi	0CH		;Are we finished with this field?\r
	jm	gofil6\r
gofil7:	lhld	datptr\r
	mvi	m,'$'           ;Put in a dollar sign for printing.\r
	lda	quietd		; quiet display?\r
	ana	a\r
	jnz	gofi70		; yes, so skip it.\r
	call	scrfln		;Position cursor\r
gofi70:	lxi	d,data		;Print the file name\r
	lda	getrxflg	;[obs 8] are we doing a get or receive?\r
	ana	a		;[obs 8]\r
	jz	gofi7a		;[obs 8] if zero, receive\r
	lxi	d,remnam	;[obs 8]\r
gofi7a: 		;[obs 8]\r
\r
	call	prtstr\r
gofi7b:	xra	a		;[MF]Zero "discard" flag\r
	sta	dscflg		;[MF]...\r
	lda	flwflg		;Is file warning on?\r
	ora	a\r
	jz	gofil9		;If not, just proceed.\r
	mvi	c,openf		;See if the file exists.\r
	lxi	d,fcb\r
	call	bdos\r
	cpi	0FFH		;Does it exist?\r
	jz	gofil9		;If not create it.\r
;\r
	lda	flwflg		;[MF]Get flag again\r
	cpi	3		;[MF]SET COLLISION DISCARD?\r
	jnz	gofi7h		;[MF]No\r
	mvi	a,0ffh		;[MF]Yes, order rejection of the file\r
	sta	dscflg		;[MF]...\r
	jmp	rskp		;[MF]and pretend successful open\r
gofi7h:	push	psw		;[MF]Save Collision status\r
	lxi	d,infms5\r
	call	error3\r
	pop	psw		;[MF]Restore Collision status\r
	cpi	1		;[MF]SET COLLISION RENAME?\r
	jz	gofi7i		;[MF]Yes, same as SET WARNING ON\r
				;[MF]If we come here, SET COLLISION BACKUP\r
	lxi	h,fcb		;[MF]Copy original fcb to a safe place\r
	lxi	d,colfcb	;[MF]...\r
	lxi	b,33		;[MF]...\r
	call	mover		;[MF]...\r
				;[MF]and fall into rename code\r
gofi7i:				;[MF]\r
;\r
;	Replacement  file name renamer routine.  Incomming\r
;	files are renamed in this manner:\r
;	original file name:	filex.ext\r
;	first rename:		filex001.ext\r
;	...		...\r
;	ninth rename		filex009.ext\r
;	10th rename		fail - would we really want 10\r
;				files of the same name??\r
;\r
;\r
;	1)\r
;	Assume that we need to "rename" the file, so lets make sure\r
;	that there is a full. 8 character filename. (We make it if \r
;	it does not already exist)\r
;		1a) If full file name, last character is to be replaced\r
;		by a zero.  This gives us up to no#ine renames.\r
;	2)open file\r
;		2a)If exists, increment last character by one\r
;		2b)if = '9' then abort\r
;		2c)If does not exist, got 2)\r
;	3)we have a valid 'renamed' file\r
;\r
;Part 1) - fill out filename part \r
\r
	mvi	c,8		; max 8 characters to test for\r
	mvi	a,'0'		; spaces to be replaced by a zero.\r
	lxi	h,fcb+8		; start at the end\r
gofi7c:	mov	m,a		; put a zero in here\r
	dcr	c		; come to the end?\r
	jz	gofi7d		; should not have, but just in case...\r
	dcx	h		; previous chararcter\r
	mov	a,m		; get it\r
	cpi	' '		; if this character a space as well, zero it\r
	mvi	a,'0'		; set it to ascii zero just in case...\r
	jz	gofi7c		;\r
;\r
; Part 2) open the file (if success, then it exists)\r
\r
gofi7d:\r
;zero the attribute bits.  [rjl@monu1.cc.monash.edu.au]\r
	lxi	h,fcb+1		;[rjl]\r
	mvi	c,11		;[rjl]\r
gofi7z:	mov	a,m		;[rjl]\r
	ani	07fh		;[rjl]\r
	mov	m,a		;[rjl]\r
	inx	h		;[rjl]\r
	dcr	c		;[rjl]\r
	jnz	gofi7z		;[rjl]\r
	lxi	d,fcb\r
	mvi	c,openf\r
	call	BDOS\r
	inr	a		; if 0ffh returned, error (ie does not exist)\r
	jz	gofi7e\r
	lda	fcb+8		; get last character\r
	inr	a\r
	sta	fcb+8\r
	cpi	'9'+1		; more than '9' => too far, lets give up.\r
	jnz	gofi7d		; else try again\r
;Giving up, so lets exit\r
	lxi	d,erms16	;\r
	call	prtstr\r
	ret		; return to error routine\r
\r
gofi7e:	lxi	d,fnbuf		; make the file name into a character string\r
	lxi	h,fcb+1		; point to source file name, less drive name\r
	mvi	c,8		; 11 characters (8+3) + dot to copy across\r
;\r
gofi7f:	mov	a,m		; get character\r
	stax	d\r
	inx	h\r
	inx	d\r
	dcr	c\r
	jnz	gofi7f		; loop until all done\r
\r
	mvi	a,'.'		; then the dot\r
	stax	d\r
	inx	d\r
\r
	mvi	c,3		; then the file extention\r
\r
gofi7g:	mov	a,m\r
	stax	d\r
	inx	h\r
	inx	d\r
	dcr	c\r
	jnz	gofi7g		; loop until extention copied across\r
\r
	mvi	a,'$'		; dollar terminate string\r
	stax	d\r
	lxi	d,fnbuf		;[MF]Point to string\r
	call	prtstr		; write string to console\r
\r
	lda	flwflg		;[MF]Get warning (SET COLLISION) flag\r
	cpi	2		;[MF]SET COLLISION BACKUP?\r
	jnz	gofil9		;[MF]No\r
	lxi	h,fcb		;[MF]Yes, get new filename fcb\r
	lxi	d,colfcb+16	;[MF]Where to copy to for rename\r
	lxi	b,16		;[MF]Copy 16 bytes\r
	call	mover		;[MF]...\r
	lxi	d,colfcb	;[MF]Point to rename fcb\r
	mvi	c,renam		;[MF]Rename function\r
	call	bdos		;[MF]Try to rename original file\r
	cpi	0ffh		;[MF]Did we win?\r
	jnz	gofl82		;[MF]Yes\r
	lxi	d,erms16	;[MF]No, complain and bomb\r
	jmp	error3		;[MF]...\r
gofl82:	lxi	h,colfcb	;[MF]Now recopy original filename into fcb\r
	lxi	d,fcb		;[MF]to create new file with original name\r
	lxi	b,16		;[MF]...\r
	call	mover		;[MF]...\r
;\r
;\r
;Now lets make the file (create it)\r
\r
gofil9:	call	makfil		; Create the file.\r
	jmp	gofl91		; Disk was full.\r
	jmp	rskp		; Success.\r
    \r
gofl91:	lxi	d,erms11\r
	call	error3\r
	ret\r
;\f\r
;       This is the FINISH command.  It tells the remote KERSRV to exit.\r
;       here from kermit\r
\r
finish:	call	cfmcmd\r
	call	selmdm		;[MF]Select modem\r
	call	flsmdm		;[MF]Flush buffers\r
	call	selcon		;[MF]Select keyboard again\r
	xra	a\r
	sta	numtry		;Inititialize count.\r
	mvi	a,'1'           ;Reset block check type to single character\r
	sta	curchk		; .  .  .\r
\r
finsh1:	lda	numtry		;How many times have we tried?\r
	cpi	maxtry		;Too many times?\r
	jm	finsh3		;No, try it.\r
finsh2:	lxi	d,erms18	;Say we couldn't do it.\r
	call	prtstr\r
	jmp	kermit		;Go home.\r
\r
finsh3:	inr	a		;Increment the number of tries.\r
	sta	numtry\r
	xra	a\r
	sta	argblk		;Make it packet number zero.\r
	mvi	a,1\r
	sta	argblk+1	;One piece of data.\r
	lxi	h,data\r
	mvi	m,'F'           ;Finish running Kermit.\r
	mvi	a,'G'           ;Generic command packet.\r
	call	spack\r
	jmp	finsh2		; Tell the user and die.\r
	call	rpack		;Get an acknowledgement.\r
	jmp	finsh1		; Go try again.\r
	cpi	'Y'             ;ACK?\r
	jz	kermit		;Yes, we are done.\r
	cpi	'E'             ;Is it an error packet?\r
	jnz	finsh1		;Try sending the packet again.\r
	call	error1		;Print the error message.\r
	jmp	kermit\r
;\f\r
;       This is the LOGOUT command.  It tells the remote KERSRV to logout.\r
;       here from: kermit\r
\r
logout:	call	cfmcmd\r
	call	logo		;Send the logout packet.\r
	jmp	kermit		;Go get another command\r
	jmp	kermit		; whether we succeed or not.\r
\r
;       do logout processing.\r
;       called by: bye, logout\r
\r
logo:	call	selmdm		;[MF]Select modem\r
	call	flsmdm		;[MF]Flush buffers\r
	call	selcon		;[MF]Select keyboard again\r
	xra	a\r
	sta	numtry		;Inititialize count.\r
	mvi	a,'1'           ;Reset block check type to single character\r
	sta	curchk		; .  .  .\r
\r
logo1:	lda	numtry		;How many times have we tried?\r
	cpi	maxtry		;Too many times?\r
	jm	logo3		;No, try it.\r
logo2:	lxi	d,erms19	;Say we couldn't do it.\r
	call	prtstr\r
	ret		;Finished.\r
\r
logo3:	inr	a		;Increment the number of tries.\r
	sta	numtry\r
	xra	a\r
	sta	argblk		;Make it packet number zero.\r
	mvi	a,1\r
	sta	argblk+1	;One piece of data.\r
	lxi	h,data\r
	mvi	m,'L'           ;Logout the remote host.\r
	mvi	a,'G'           ;Generic command packet.\r
	call	spack\r
	jmp	logo2		; Tell the user and die.\r
	call	rpack		;Get an acknowledgement\r
	jmp	logo1		; Go try again.\r
	cpi	'Y'             ;ACK?\r
	jz	rskp		;Yes, we are done.\r
	cpi	'E'             ;Is it an error packet?\r
	jnz	logo1		;Try sending the packet again.\r
	call	error1		;Print the error message.\r
	ret		;All done.\r
;\f\r
;       Packet routines\r
\r
;       Send_Packet\r
;       This routine assembles a packet from the arguments given and sends it\r
;       to the host.\r
;\r
;       Expects the following:\r
;               A        - Type of packet (D,Y,N,S,R,E,F,Z,T)\r
;               ARGBLK   - Packet sequence number\r
;               ARGBLK+1 - Number of data characters\r
;       Returns: nonskip if failure\r
;                skip if success\r
;       called by: read, rinit, rfile, rdata, sinit, sfile, sdata, seof, seot,\r
;                  finish, logout, nak, ackp\r
\r
spack:	sta	argblk+2\r
	lxi	h,packet	;Get address of the send packet.\r
	lda	sndsop		;[gnn] send start-of-pkt char.\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	lda	curchk		;Get current checksum type\r
	sui	'1'             ;Determine extra length of checksum\r
	mov	b,a		;Copy length\r
	lda	argblk+1	;Get the number of data chars.\r
	adi	' '+3           ;Real packet character count made printable.\r
	add	b		;Determine overall length\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	lxi	b,0		;Zero the checksum AC.\r
	mov	c,a		;Start the checksum.\r
	lda	argblk		;Get the packet number.\r
	adi	' '             ;Add a space so the number is printable.\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	add	c\r
	mov	c,a		;Add the packet number to the checksum.\r
	mvi	a,0		;Clear A (Cannot be XRA A, since we can't\r
				; touch carry flag)\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
	lda	argblk+2	;Get the packet type.\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	add	c\r
	mov	c,a		;Add the packet number to the checksum.\r
	mvi	a,0		;Clear A\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
spack2:	lda	argblk+1	;Get the packet size.\r
	ora	a		;Are there any chars of data?\r
	jz	spack3		; No, finish up.\r
	dcr	a		;Decrement the char count.\r
	sta	argblk+1	;Put it back.\r
	mov	a,m		;Get the next char.\r
	inx	h		;Point to next char.\r
	add	c\r
	mov	c,a		;Add the packet number to the checksum.\r
	mvi	a,0		;Clear A\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
	jmp	spack2		;Go try again.\r
\r
spack3:	lda	curchk		;Get the current checksum type\r
	cpi	'2'             ;Two character?\r
	jz	spack4		;Yes, go handle it\r
	jnc	spack5		;No, go handle CRC if '3'\r
	mov	a,c		;Get the character total.\r
	ani	0C0H		;Turn off all but the two high order bits.\r
				;Shift them into the low order position.\r
	rlc		;Two left rotates same as 6 rights\r
	rlc		; .  .  .\r
	add	c		;Add it to the old bits.\r
	ani	3FH		;Turn off the two high order bits.  (MOD 64)\r
	adi	' '             ;Add a space so the number is printable.\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	jmp	spack7		;Go store eol character\r
\r
;Here for 3 character CRC-CCITT\r
\r
spack5:	mvi	m,0		;Store a null for current end\r
	push	h		;Save H\r
	lxi	h,packet+1	;Point to first checksumed character\r
	call	crcclc		;Calculate the CRC\r
	pop	h		;Restore the pointer\r
	mov	c,e		;Get low order half for later\r
	mov	b,d		;Copy the high order\r
	mov	a,d		;Get the high order portion\r
	rlc		;Shift off low 4 bits\r
	rlc		; .  .  .\r
	rlc		; .  .  .\r
	rlc		; .  .  .\r
	ani	0FH		;Keep only low 4 bits\r
	adi	' '             ;Put into printing range\r
	mov	m,a		;Store the character\r
	inx	h		;Point to next position\r
\r
;Here for two character checksum\r
\r
spack4:	mov	a,b		;Get high order portion\r
	ani	0FH		;Only keep last four bits\r
	rlc		;Shift up two bits\r
	rlc		; . .  .\r
	mov	b,a		;Copy back into safe place\r
	mov	a,c		;Get low order half\r
	rlc		;Shift  high two bits\r
	rlc		;to low two bits\r
	ani	03H		;Keep only two low bits\r
	ora	b		;Get high order portion in\r
	adi	' '             ;Convert to printing character range\r
	mov	m,a		;Store the character\r
	inx	h		;Point to next character\r
	mov	a,c		;get low order portion\r
	ani	3FH		;Keep only six bits\r
	adi	' '             ;Convert to printing range\r
	mov	m,a		;Store it\r
	inx	h		;Bump the pointer\r
\r
spack7:	lda	dbgflg\r
	ora	a		; is debugging enabled?\r
	jz	spack8\r
	push	h		; yes. save address of end of packet\r
	mvi	m,0		; null-terminate the packet for display\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	jnz	spac7a		; so dont say a thing\r
	call	sppos		; position cursor\r
	lxi	h,packet+1	; print the packet\r
	call	dmptxt\r
	lda	prnflg		; is the printer on too?\r
	ana	a\r
	jz	spac7a\r
	lxi	h,sstatm		; print state\r
	call	printm		; dumptext but to printer\r
	lda	state\r
	mov	e,a\r
	call	outprn\r
	lxi	h,princr	; cr lf to printer\r
	call	printm\r
	lxi	h,spackm\r
	call	printm\r
	lxi	h,packet+1\r
	call	printm\r
	lxi	h,princr\r
	call	printm\r
	lxi	h,princr\r
	call	printm\r
\r
spac7a:	pop	h		; restore address of end of packet\r
spack8:	lda	seol		;Get the EOL the other host wants.\r
	mov	m,a		;Put in the packet.\r
	inx	h		;Point to next char.\r
	xra	a		;Get a null.\r
	mov	m,a		;Put in the packet.\r
;       Write out the packet.\r
outpkt:	call	selmdm		; Set up for output to comm port if iobyt\r
	lda	spad		;Get the number of padding chars.\r
	sta	temp1\r
outpk2:	lda	temp1		;Get the count.\r
	dcr	a\r
	ora	a\r
	jm	outpk6		;If none left proceed.\r
	sta	temp1\r
	lda	spadch		;Get the padding char.\r
	call	setpar		;Set parity appropriately\r
	mov	e,a		;Put the char in right AC.\r
	call	outmdm		;Output it.\r
	jmp	outpk2\r
\r
outpk6:	lxi	h,packet	; Point to the packet.\r
outlup:	mov	a,m		; Get the next character.\r
	ora	a		; Is it a null?\r
	jz	outlud		; If so return success.\r
	call	setpar		; Set parity for the character\r
	mov	e,a		; Put it in right AC\r
	call	outmdm		; and output it.\r
; TAC trap: If this character is the TAC intercept character, and the TAC\r
; trap is enabled, we have to output it twice.  If the TAC trap is enabled,\r
; tacflg contains the intercept character.  (The current character cannot\r
; be NUL, so we don't have to worry about doubling nulls in the message)\r
	lda	tacflg		; get current intercept character, or zero.\r
	cmp	m		; compare against current data character.\r
	jnz	outpk8		; if different, do nothing.\r
	call	setpar		; match. set appropriate parity,\r
	mov	e,a		;  put it in the right register,\r
	call	outmdm		;  and output it a second time.\r
outpk8:\r
	inx	h		; Increment the char pointer.\r
	jmp	outlup\r
\r
outlud:	call	selcon		; select console\r
	jmp	rskp		; and return success\r
;\f\r
;       Receive_Packet\r
;       This routine waits for a packet to arrive from the host.  It reads\r
;       characters until it finds a SOH.  It then reads the packet into packet.\r
;\r
;       Returns:  nonskip if failure (checksum wrong or packet trashed)\r
;          skip if success, with\r
;               A        - message type\r
;               ARGBLK   - message number\r
;               ARGBLK+1 - length of data\r
;       called by: rinit, rfile, rdata,\r
;                  sinit, sfile, sdata, seof, seot, finish, logout\r
\r
rpack:	call	inpkt		;Read up to the end-of-line character\r
	jmp	r		; Return bad.\r
rpack0:	call	getchr		;Get a character.\r
	jmp	rpack		; Hit eol;null line;just start over.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jnz	rpack0		; No, go until it is.\r
rpack1:	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sta	packet+1	;Store in packet also\r
	mov	c,a		;Start the checksum.\r
	lda	curchk		;Get block check type\r
	sui	'1'             ;Determine extra length of block check\r
	mov	b,a		;Get a copy\r
	mov	a,c		;Get back length character\r
	sui	' '+3           ;Get the real data count.\r
	sub	b		;Get total length\r
	sta	argblk+1\r
	mvi	b,0		;Clear high order half of checksum\r
	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sta	argblk\r
	sta	packet+2	;Save also in packet\r
	add	c\r
	mov	c,a		;Add the character to the checksum.\r
	mvi	a,0		;Clear A\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
	lda	argblk\r
	sui	' '             ;Get the real packet number.\r
	sta	argblk\r
	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sta	temp1		;Save the message type.\r
	sta	packet+3	;Save in packet\r
	add	c\r
	mov	c,a		;Add the character to the checksum.\r
	mvi	a,0		;Clear A\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
	lda	argblk+1	;Get the number of data characters.\r
	sta	temp2\r
	lxi	h,data		;Point to the data buffer.\r
	shld	datptr\r
rpack2:	lda	temp2\r
	sui	1		;Any data characters?\r
	jm	rpack3		; If not go get the checksum.\r
	sta	temp2\r
	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	lhld	datptr\r
	mov	m,a		;Put the char into the packet.\r
	inx	h		;Point to the next character.\r
	shld	datptr\r
	add	c\r
	mov	c,a		;Add the character to the checksum.\r
	mvi	a,0		;Clear A\r
	adc	b		;Get high order portion of checksum\r
	mov	b,a		;Copy back to B\r
	jmp	rpack2		;Go get another.\r
\r
rpack3:	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sui	' '             ;Turn the char back into a number.\r
	sta	temp3\r
;Determine type of checksum\r
\r
	lda	curchk		;Get the current checksum type\r
	cpi	'2'             ;1, 2 or 3 character?\r
	jz	rpack4		;If zero, 2 character\r
	jnc	rpack5		;Go handle 3 character\r
	mov	a,c		;Get the character total.\r
	ani	0C0H		;Turn off all but the two high order bits.\r
				;Shift them into the low order position.\r
	rlc		;Two left rotates same as six rights\r
	rlc		; .  .  .\r
	add	c		;Add it to the old bits.\r
	ani	3FH		;Turn off the two high order bits.  (MOD 64)\r
	mov	b,a\r
	lda	temp3		;Get the real received checksum.\r
	cmp	b		;Are they equal?\r
	jz	rpack7		;If so, proceed.\r
rpack9:	call	updrtr		;If not, update the number of retries.\r
	ret		;Return error.\r
\r
;Here for three character CRC-CCITT\r
\r
rpack5:	lhld	datptr		;Get the address of the data\r
	mvi	m,0		;Store a zero in the buffer to terminate packet\r
	lxi	h,packet+1	;Point at start of checksummed region\r
	call	crcclc		;Calculate the CRC\r
	mov	c,e		;Save low order half for later\r
	mov	b,d		;Also copy high order\r
	mov	a,d		;Get high byte\r
	rlc		;Want high four bits\r
	rlc		; .  .  .\r
	rlc		;And shift two more\r
	rlc		; .  .  .\r
	ani	0FH		;Keep only 4 bits\r
	mov	d,a		;Back into D\r
	lda	temp3		;Get first value back\r
	cmp	d		;Correct?\r
	jnz	rpack9		;No, punt\r
	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sui	' '             ;Remove space offset\r
	sta	temp3		;Store for later check\r
	;...\r
\r
;Here for a two character checksum and last two characters of CRC\r
\r
rpack4:	mov	a,b		;Get high order portion\r
	ani	0FH		;Only four bits\r
	rlc		;Shift up two bits\r
	rlc		; .  .  .\r
	mov	b,a		;Save back in B\r
	mov	a,c		;Get low order\r
	rlc		;move two high bits to low bits\r
	rlc		; .  .  .\r
	ani	03H		;Save only low two bits\r
	ora	b		;Get other 4 bits\r
	mov	b,a		;Save back in B\r
	lda	temp3		;Get this portion of checksum\r
	cmp	b		;Check first half\r
	jnz	rpack9		;If bad, go give up\r
	call	getchr		;Get a character.\r
	jmp	r		; Hit end of line, return bad.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jz	rpack1		; Yes, then go start over.\r
	sui	' '             ;Remove space offset\r
	mov	b,a		;Save in safe place\r
	mov	a,c		;Get low 8 bits of checksum\r
	ani	3FH		;Keep only 6 bits\r
	cmp	b		;Correct value\r
	jnz	rpack9		;Bad, give up\r
rpack7:	lhld	datptr\r
	mvi	m,0		;Put a null at the end of the data.\r
	lda	temp1		;Get the type.\r
	jmp	rskp\r
;\f\r
;       inpkt - receive and buffer packet\r
;       returns: nonskip if error (timeout)\r
;               skip if success; packet starts at recpkt (which holds the SOH)\r
;               and is terminated by a null.\r
;               console is selected in either case.\r
;       called by: rpack\r
\r
inpkt:	lxi	h,recpkt	;Point to the beginning of the packet.\r
	shld	pktptr\r
inpkt1:	call	inchr		;Get first character\r
	jmp	r		;Return failure\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jnz	inpkt1		;if not, ignore leading junk\r
	jmp	inpkt3		;else go put it in packet\r
\r
inpkt2:	call	inchr		;Get a character.\r
	jmp	r		; Return failure.\r
	lxi	h,rcvsop	;[gnn] Is it receive start-of-pkt char.\r
	cmp	m		;[gnn]\r
	jnz	inpkt3		;if not continue\r
	lxi	h,recpkt	;else throw away what we've got so far\r
	shld	pktptr		;\r
inpkt3:	lhld	pktptr		;\r
	mov	m,a		;Put the char in the packet.\r
	inx	h\r
	shld	pktptr\r
	mov	b,a\r
	lxi	d,-recpkx	;Start over if packet buffer overflow\r
	dad	d		;\r
	jc	inpkt		;buffer overflow\r
	lda	reol		;Get the EOL char.\r
	cmp	b\r
	jnz	inpkt2		;If not loop for another.\r
;[gnn]                  ***  added by Godfrey Nix   Nottingham University ***\r
;[gnn]                  to allow Kermit server to echo our packets back\r
	lxi	h,recpkt+3	;[gnn] point to packet type\r
	lda	packet+3	;[gnn] get the one we sent\r
	cmp	m		;[gnn] are they the same?\r
	jz	inpkt		;[gnn] yes, get another packet\r
;[gnn]                  *** end of patch *****\r
 ;...\r
	;...\r
\r
;Begin IBM change/fdc\r
;This moved from OUTPK7 -- it appears that waiting until we're\r
;ready to send a packet before looking for turnaround character\r
;is long enough for it to get lost.  Better to look now.\r
\r
	lda	ibmflg		;Is this the IBM?\r
	ora	a\r
	jz	inpkt6		;If not then proceed.\r
	lda	state		;Check if this is the Send-Init packet.\r
	cpi	'S'\r
	jz	inpkt6		;If so don't wait for the XON.\r
inpkt5:	call	inchr		;Wait for the turn around char.\r
	jmp	inpkt6\r
	cpi	xon		;Is it the IBM turn around character?\r
	jnz	inpkt5		;If not, go until it is.\r
inpkt6:	lhld	pktptr		;Reload packet pointer\r
;End IBM change/fdc.\r
	dcx	h		;Back up to end of line character\r
	mvi	m,0		;Replace it with a null to stop rpack:\r
	call	selcon		;We've got the packet. Return to console.\r
\r
	lda	dbgflg		; Is debugging enabled?\r
	ora	a\r
	jz	inpkt7\r
	inx	h		; Point to next char.\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	jnz	inpkt7		; so dont say a thing\r
	call	rppos		; position cursor\r
	lxi	h,recpkt+1	; print the packet\r
	call	dmptxt\r
\r
	lda	prnflg		; is the printer on too?\r
	ana	a\r
	jz	inpkt7\r
	lxi	h,rstatm		; print state\r
	call	printm		; dumptext but to printer\r
	lda	state\r
	mov	e,a\r
	call	outprn\r
	lxi	h,princr	; cr lf to printer\r
	call	printm\r
	lxi	h,rpackm\r
	call	printm\r
	lxi	h,recpkt+1\r
	call	printm\r
	lxi	h,princr\r
	call	printm\r
	lxi	h,princr\r
	call	printm\r
\r
\r
inpkt7:	lxi	h,recpkt\r
	shld	pktptr		;Save the packet pointer.\r
	jmp	rskp		;If so we are done.\r
\r
;       getchr - get next character from buffered packet.\r
;       returns nonskip at end of packet.\r
;       called by: rpack\r
\r
getchr:	lhld	pktptr		;Get the packet pointer.\r
	mov	a,m		;Get the char.\r
	inx	h\r
	shld	pktptr\r
	ora	a		;Is it the null we put at the end of the packet?\r
	jnz	rskp		;If not return retskp.\r
	ret		;If so return failure.\r
;\f\r
;\r
;       inchr - character input loop for file transfer\r
;       returns: nonskip if timeout or character typed on console\r
;                       (console selected)\r
;               skip with character from modem in A (parity stripped\r
;                       if necessary; modem selected)\r
;               preserves bc, de, hl in either case.\r
;       called by: inpkt\r
\r
inchr:	push	h		; save hl and bc\r
	push	b\r
	lhld	timout		;Get initial value for timeout\r
	shld	timval		;[jd] \r
inchr0:	call	selmdm		;select modem\r
	call	inpmdm		;Try to get a character from the modem\r
	ora	a\r
	jz	inchr2		;if zero, nothing there.\r
	mov	b,a\r
	lda	parity		;Is the parity none?\r
	cpi	parnon\r
	mov	a,b\r
	jz	inchr1		;If so just return.\r
	ani	7FH		;Turn off the parity bit.\r
inchr1:	pop	b		;restore registers\r
	pop	h\r
	jmp	rskp		;take skip return, character in A\r
\r
inchr2:	call	selcon		;select console\r
	call	inpcon		; Try to get a character from the console\r
	ora	a\r
	jz	inchr6		;If not go do timer thing\r
	cpi	cr		;Is it a carriage return?\r
	jz	inchr4		;If so return\r
	cpi	('Z'-100O)      ;Control-Z?\r
	jz	inchr5		;Yes, go flag it\r
	cpi	('C'-100O)      ;Control-C?\r
	jz	inchr7		;re-enter, he wants to get out\r
	cpi	('X'-100O)      ;Control-X?\r
	jnz	inchr6		;No, ignore it. do timer thing.\r
inchr5:	adi	100O		;Convert to printing range\r
	sta	czseen		;Flag we saw a control-Z\r
	jmp	inchr6		;[MF] and do timer thing\r
inchr4:	pop	b		; restore registers\r
	pop	h\r
	ret		;And return\r
\r
inchr6:	lda	timflg		;[jd] pick up timer flag\r
	ora	a		;[jd] are we allowed to use timer?\r
	jz	inchr0		;[jd] no, don't time out\r
	lhld	timval		; decrement fuzzy time-out\r
	dcx	h		;\r
	shld	timval		;((timout-1) * loop time)\r
	mov	a,h		;(Retry if not time-out)\r
	ora	l		;\r
	jnz	inchr0		;\r
	call	updrtr		;Count as retry (?)\r
	pop	b		;restore registers\r
	pop	h\r
	ret		;and return to do retry\r
\r
inchr7:	call	clrtop		;[hh] clear screen and home cursor\r
	lda	takflg		;[MF]Take-file in progress?\r
	ani	1		;[MF]...\r
	cnz	closet		;[MF]Yes, close it and reset TAKE-flag\r
				;[MF]so all processing is halted\r
	jmp	kermit		;[hh] then re-enter kermit\r
\r
;\f\r
;       CRCCLC - Routine to calculate a CRC-CCITT for a string.\r
;\r
;       This routine will calculate a CRC using the CCITT polynomial for\r
;       a string.\r
;\r
;       call with: HL/ Address of null-terminated string\r
;       16-bit CRC value is returned in DE.\r
;       Registers BC and HL are preserved.\r
;\r
;       called by: spack, rpack\r
\r
crcclc:	push	h		;Save HL\r
	push	b		;And BC\r
	lxi	d,0		;Initial CRC value is 0\r
\r
crccl0:	mov	a,m		;Get a character\r
	ora	a		;Check if zero\r
	jz	crccl1		;If so, all done\r
	push	h		;Save the pointer\r
	xra	e		;Add in with previous value\r
	mov	e,a		;Get a copy\r
	ani	0FH		;Get last 4 bits of combined value\r
	mov	c,a		;Get into C\r
	mvi	b,0		;And make high order zero\r
	lxi	h,crctb2	;Point at low order table\r
	dad	b		;Point to correct entry\r
	dad	b		; .  .  .\r
	push	h		;Save the address\r
	mov	a,e		;Get combined value back again\r
	rrc		;Shift over to make index\r
	rrc		; .  .  .\r
	rrc		; .  .  .\r
	ani	1EH		;Keep only 4 bits\r
	mov	c,a		;Set up to offset table\r
	lxi	h,crctab	;Point at high order table\r
	dad	b		;Correct entry\r
	mov	a,m		;Get low order portion of entry\r
	xra	d		;XOR with previous high order half\r
	inx	h		;Point to high order byte\r
	mov	d,m		;Get into D\r
	pop	h		;Get back pointer to other table entry\r
	xra	m		;Include with new high order half\r
	mov	e,a		;Copy new low order portion\r
	inx	h		;Point to other portion\r
	mov	a,m		;Get the other portion of the table entry\r
	xra	d		;Include with other high order portion\r
	mov	d,a		;Move back into D\r
\r
	pop	h		;And H\r
	inx	h		;Point to next character\r
	jmp	crccl0		;Go get next character\r
\r
crccl1:	pop	b		;Restore B\r
	pop	h		;And HL\r
\r
	ret		;And return, DE=CRC-CCITT\r
\r
CRCTAB:	DW	00000H\r
	DW	01081H\r
	DW	02102H\r
	DW	03183H\r
	DW	04204H\r
	DW	05285H\r
	DW	06306H\r
	DW	07387H\r
	DW	08408H\r
	DW	09489H\r
	DW	0A50AH\r
	DW	0B58BH\r
	DW	0C60CH\r
	DW	0D68DH\r
	DW	0E70EH\r
	DW	0F78FH\r
\r
CRCTB2:	DW	00000H\r
	DW	01189H\r
	DW	02312H\r
	DW	0329BH\r
	DW	04624H\r
	DW	057ADH\r
	DW	06536H\r
	DW	074BFH\r
	DW	08C48H\r
	DW	09DC1H\r
	DW	0AF5AH\r
	DW	0BED3H\r
	DW	0CA6CH\r
	DW	0DBE5H\r
	DW	0E97EH\r
	DW	0F8F7H\r
;\f\r
;       This is where we go if we get an error during a protocol communication.\r
;       error prints the error packet on line 6 or so, and aborts the\r
;       transfer.\r
;         called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot\r
;       error1 print CRLF followed by the error packet.\r
;         called by: finish, logout\r
;       error2 just prints the error packet.\r
;       error3 positions cursor and prints error message specified in DE.\r
;         called by: rinit, rfile, rdata, sinit, sfile, sdata, seof,\r
;                    seot, parwrn, gofil, outbuf\r
\r
error:	lda	quietd		; a quiet display?\r
	ana	a\r
	jnz	error0		; so dont say a thing\r
	lda	remtxt		;[MF]Doing a remote command?\r
	ora	a		;[MF]...\r
	jnz	error0		;[MF]Yes, don't position cursor\r
	call	screrr		;Position the cursor.\r
error0:	mvi	a,'A'           ;Set the state to abort.\r
	sta	state\r
	jmp	error2\r
\r
error1:	lxi	d,crlf		;Print a CRLF.\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	jnz	error2		; so dont say a thing\r
		call	prtstr\r
error2:	lda	argblk+1	;Get the length of the data.\r
	mov	c,a\r
	mvi	b,0		;Put it into BC\r
	lxi	h,data		;Get the address of the data.\r
	dad	b		;Get to the end of the string.\r
	mvi	m,'$'           ;Put a dollar sign at the end.\r
	lxi	d,data		;Print error message\r
	lda	remtxt		;[MF]Doing a remote command?\r
	ora	a		;[MF]...\r
	jnz	errr2a		;[MF]Yes, print message, quiet or not!\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	rnz		; so dont say a thing\r
errr2a:	call	prtstr\r
	ret\r
\r
error3:	lda	quietd		; a quiet display?\r
	ana	a\r
	rnz		; so dont say a thing\r
	lda	remtxt		;[MF]Doing a remote command?\r
	ora	a		;[MF]...\r
	jnz	err3a		;[MF]Yes, don't position cursor\r
	push	d		;Save the pointer to the message.\r
	call	screrr		;Position the cursor.\r
	pop	d		;Get the pointer back.\r
err3a:	call	prtstr		;Print error message\r
	ret\r
;\f\r
;       Set up for file transfer.\r
;       called by read, send.\r
\r
init:	lxi	d,version	; point at Kermit's version string\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	jnz	init1		; so dont say a thing\r
	call	sysscr		; fix up screen\r
init1:	call	selmdm		; select modem\r
	call	flsmdm		; purge any pending data\r
	call	selcon		; select console again.\r
	ret\r
\r
;       Set state to ABORT\r
;       called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot,\r
;                  nak, ackp\r
\r
abort:	mvi	a,'A'           ;Otherwise abort.\r
	sta	state\r
	ret\r
\r
;       nak - send NAK packet\r
;       here from: rinit, rfile, rdata\r
;       nak0 - update retry count and send NAK packet\r
;       here from: rinit, rfile, rdata, tryagn\r
\r
nak0:	call	updrtr		;Update number of retries.\r
nak:	lda	pktnum		;Get the packet number we're waiting for.\r
	sta	argblk\r
	xra	a		;No data.\r
	sta	argblk+1\r
	mvi	a,'N'           ;NAK that packet.\r
	call	spack\r
	jmp	abort		; Give up.\r
	ret		;Go around again.\r
\r
;       increment and display retry count\r
;       called by: rfile, sinit, sfile, sdata, seof, seot,\r
;                  nak, rpack, inchr, tryagn\r
\r
updrtr:	lhld	numrtr\r
	inx	h		;Increment the number of retries\r
	shld	numrtr\r
	lda	remtxt		;[MF]Doing a remote server command?\r
	ora	a		;[MF]...\r
	rnz		;[MF]Yes, keep mum\r
	lda	quietd		; a quiet display?\r
	ana	a\r
	rnz		; so dont say a thing\r
	call	scrnrt		;Position cursor\r
	lhld	numrtr		;[MF]\r
call	nout		;Write the number of retries.\r
	ret\r
\r
;       [jd] this routine prints parity warnings.  All registers are\r
;       saved except for a.\r
;       called by: sdata\r
\r
parwrn:	push	b\r
	push	d\r
	push	h\r
	lxi	d,inms25\r
	call	error3\r
	pop	h\r
	pop	d\r
	pop	b\r
	ret\r
;[jd] end of addition\r
\r
;       print message in status field.  address of message is in DE.\r
;       called by: read, send\r
\r
finmes:	lda	quietd		; a quiet display?\r
	ana	a\r
	jz	finme0		; so do usual stuff\r
	push	d		;[MF]Save pointer to completion message\r
	call	prcrlf		; best do a new line\r
	pop	d		;[MF]Restore completion message pointer\r
	call	prtstr		; and send message\r
	mvi	e,space		; send a space or two\r
	mvi	c,dconio\r
	push	b\r
	push	d\r
	call	bdos\r
	pop	d\r
	pop	b\r
	call	bdos\r
	ret		; and exit back\r
;\r
;else for screaming screens...\r
\r
finme0:	push	d		;Save message.\r
	call	scrst		;Position cursor\r
	pop	d		;Print the termination message\r
	call	prtstr\r
	ret		; may not want this **************\r
\r
	mvi	c,4		;[2] copy across user no and drive\r
	lxi	h,kerm1		;[2] as we have the text already\r
finme1:	mov	e,m\r
	push	h		;[2] conout probably destroys these\r
	push	b\r
	call	conout\r
	pop	b\r
	pop	h\r
	inx	h		;[2] next character\r
	dcr	c		;[2] ah, but have we done?\r
	jnz	finme1		;[2] nope\r
	lxi	d,spac15	;[2] send 15 spaces (clears previous filename)\r
	call	prtstr		;[2]\r
	call	scrend		;Position cursor for prompt\r
	ret\r
\r
;       Compare expected packet number against received packet number.\r
;       return with flags set (Z = packet number valid)\r
;       called by: rfile, rdata, sinit, sfile, sdata, seof, seot\r
\r
compp:	lda	pktnum		;Get the packet Nr.\r
	mov	b,a\r
	lda	argblk\r
	cmp	b\r
	ret\r
\r
;       Increment the packet number, modulo 64.\r
;       called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot\r
\r
countp:	inr	a		;Increment packet Nr.\r
	ani	3FH		;Turn off the two high order bits\r
	sta	pktnum		;Save modulo 64 of number\r
	lhld	numpkt\r
	inx	h		;Increment Nr. of packets\r
	shld	numpkt\r
	ret\r
\r
;       Send an ACK-packet\r
;       called by: rfile, rdata, tryagn\r
\r
ackp:	xra	a\r
	sta	numtry		;Reset number of retries\r
	sta	argblk+1	;No data. (The packet number is in argblk)\r
	mvi	a,'Y'           ;Acknowledge packet\r
	call	spack		;Send packet\r
	jmp	abort\r
	ret\r
\r
;       ?\r
;       called with A/ current retry count\r
;       called by: rfile, rdata\r
\r
tryagn:	inr	a		;Increment it.\r
	sta	oldtry		;Save the updated number of tries.\r
	lda	pktnum		;Get the present packet number.\r
	dcr	a		;Decrement\r
	ani	3FH		; modulo 64\r
	mov	b,a\r
	lda	argblk		;Get the packet's number\r
	cmp	b		;Is the packet's number one less than now?\r
	jnz	nak0		;No, NAK it and try again.\r
	call	updrtr		;Update the number of retries.\r
	call	ackp\r
	ret\r
\r
;       Output a null-terminated string to the console.  We assume that the\r
;       console has been selected.  Called with HL = address of string.\r
;       called by: spack, inpkt\r
\r
dmptxt:	mov	a,m		; get character from string\r
	ora	a\r
	rz		; done if null\r
	push	h		; save string address\r
	mov	e,a		; move character to E for outcon\r
	call	outcon		; output character to console\r
	pop	h		; restore string address\r
	inx	h		; point past printed character\r
	jmp	dmptxt		; go output rest of string\r
\r
\r
;       Output a null-terminated string to the PRINTER  We assume that the\r
;       console has been selected.  Called with HL = address of string.\r
;       called by: spack, inpkt\r
\r
printm:	mov	a,m		; get character from string\r
	ora	a\r
	rz		; done if null\r
	push	h		; save string address\r
	mov	e,a		; move character to E for outcon\r
	call	outprn		; output character to printer\r
	pop	h		; restore string address\r
	inx	h		; point past printed character\r
	jmp	printm		; go output rest of string\r
\r
\r
;\f\r
;       test if character in A is the start of header character.  We get\r
;       the start of packet character from sohchr, which can be SET\r
tstsoh:	push	b		; save these registers for a bit\r
	mov	c,a		; we have to test if this is the character\r
	lda	sohchr\r
	cmp	c		; if zero, then it is\r
	mov	a,c		; restore accumulator but not flags\r
	pop	b\r
	ret		; return with flags set\r
;\r
\r
\r
; Little code to allow some expansion of code without changing\r
;  every futher address, only up to the end of this file.\r
;   TO BE REMOVED FRO RELEASE!\r
\r
;	org ($+100h) AND 0FF00H\r
\r
\r
IF lasm\r
	LINK	CPSREM\r
ENDIF;lasm\r