NAME	msscom
; File MSSCOM.ASM
	include mssdef.h
;  Copyright (C) 1985, 1993, Trustees of Columbia University in the 
;  City of New York.  Permission is granted to any individual or institution
;  to use this software as long as it is not sold for profit.  This copyright
;  notice must be retained.  This software may not be included in commercial
;  products without written permission of Columbia University.
;
; Edit history:
; 8 Dec 1992 version 3.13
; 6 Sept 1991 version 3.11
; 2 March 1991 version 3.10
; Last edit 14 May 1993

	public	spack, rpack, spause, bufclr, pakptr, bufrel
	public	makebuf, getbuf, pakdup, chkwind, firstfree, windused
	public	rpacket, windlow, chkparflg, maxbufparas, peekreply
	public	winusedmax

stat_suc equ	0		; success
stat_tmo equ	1		; timeout
stat_chk equ	2		; checksum mismatch
stat_ptl equ	4		; packet too long
stat_int equ	8		; user interrupt
stat_eol equ	10h		; eol char seen
stat_echo equ	20h		; echo of sent packet
stat_bad equ	80h		; packet is bad (premature EOL)

data	segment
	extrn	flags:byte, trans:byte, fsta:word, ssta:word, fmtdsp:byte
	extrn	pktnum:byte, portval:word, denyflg:word
	extrn	parmsk:byte

badpflag db	0		; flag to say have shown bad parity message
spmes	db	'Spack: $'
rpmes 	db	'Rpack: $'
crlf    db      cr,lf,'$'
msgstl	db	'Internal Error: send packet is too long',0,cr,lf,'$'
msgheader db	'<$'
msgtmo	db	'Timeout$'
msgchk	db	'Bad checksum$'
msgint	db	'Interrupted$'
msgptl	db	'Pkt too long$'
msgbad	db	'Early EOL$'
msgtail	db	'>',cr,lf,'$'
msgecho	db	cr,lf,'<Echo of sent packet>',cr,lf,'$'
msgbadsnd db	cr,lf,'<Error sending packet bytes>',cr,lf,'$'
msgbadpare db	'Unexpected Parity from host! Changing Parity to EVEN'
	db	cr,lf,0
msgbadparo db	'Unexpected Parity from host! Changing Parity to ODD'
	db	cr,lf,0
msgbadparm db	'Unexpected Parity from host! Changing Parity to MARK'
	db	cr,lf,0
tmp	db	0
spause	dw	0		; # millisec to wait before sending pkt
timeval	db	0		; active receive timeout value, seconds
prvtyp  db      0		; Type of last packet sent
prvlen	dw	0		; bytes sent, for echo suppression
chkparflg db	0		; non-zero to check parity on received pkts
chklength db	1		; active checksum length
prevchar db	0		; previous char from comms line (for ^C exit)
SOHchar	db	0		; start of packet char, local copy
lentyp	db	0		; packet length type, 3, 0, 1
debflg	db	0		; debug display, send/receive flag
timeit	db	0		; arm timeout counter
				; sliding windows data structures
windlow	db	0		; lower border of window
windused db	0		; number of window slots in use
winusedmax db	0		; max used window slots
prolog  db	10 dup (0)	; prolog: SOH, LEN, SEQ, TYPE, xlen,...,null
epilog	db	10 dup (0)	; epilog: checksum, eol, handshake + null term
rbuf	db	128 dup (0)	; static packet buffer for replies
	even
pbufseg	dw	0		; segment of packet buffer memory block
maxbufparas dw	0		; paragraphs available in free memory
bufnum	dw	0		; number of buffers available now
buflist dw	maxwind dup (0) ; pointers to packet structures in pktlist
bufuse	dw	maxwind dup (0) ; in-use flag (0 = not in use)
pktlist	pktinfo maxwind dup (<>) ; pktinfo structured members (private)
rpacket	pktinfo <rbuf,0,length rbuf,0,0> ; reply pktinfo
	even
rtemp	dw	0		; address of pktinfo structure for rpack
stemp	dw	0		; address of pktinfo structure for spack
linecnt	db	0		; debug line width counter
colcnt	db	0
chksum	dw	0		; running checksum (two char)
chrcnt	dw	0		; number of bytes in data field of a packet
pktcnt	dw	0		; number of bytes sent/rcvd in this packet
status	dw	0		; status of packet receiver (0 = ok)
fairflg	dw	0		; fairness flag, for console/port reads
rptim	db	4 dup (0)	; read packet timeout slots
sixzero	dw	60		; for div operation in rec packet timeouts
ninefive dw	95		; for mult/div with long packets
bias	db	' '		; ascii bias for checksum calculations
temp	dw	0
data	ends

code	segment
	extrn	prtchr:near, outchr:near, isdev:near
	extrn	sppos:near, ermsg:near, clearl:near, rppos:near
	extrn	pktcpt:near, strlen:near, pcwait:near, peekcom:far

	assume 	cs:code, ds:data, es:nothing
prtchr1	proc	far		; near-far interface routines for code1 seg
	call	prtchr
	ret
prtchr1	endp
outchr1	proc	far
	call	outchr
	ret
outchr1	endp
isdev1	proc	far
	call	isdev
	ret
isdev1	endp
rppos1	proc	far
	call	rppos
	ret
rppos1	endp
sppos1	proc	far
	call	sppos
	ret
sppos1	endp
ermsg1	proc	far
	call	ermsg
	ret
ermsg1	endp
clearl1	proc	far
	call	clearl
	ret
clearl1	endp
fpktcpt	proc	far
	call	pktcpt
	ret
fpktcpt	endp
strlen1	proc	far
	call	strlen
	ret
strlen1	endp
pcwait1	proc	far
	call	pcwait
	ret
pcwait1	endp
code	ends

code1	segment
	assume 	cs:code1, ds:data, es:nothing

; Send_Packet
; This routine assembles a packet from the arguments given and sends it
; to the host.
;
; Expects the following:
;	SI = pointer to pktinfo structure, as
;	[SI].PKTYPE - Packet type letter
;	[SI].SEQNUM - Packet sequence number
;	[SI].DATLEN - Number of data characters
;	[SI].DATADR - DWord Address of data field for packet
; Returns: carry clear if success, carry set if failure.
; Packet construction areas:
; 	Prolog (8 bytes)			Data	 null  Epilog
;+----------------------------------------+---------------+---------------+
;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS |
;+----------------------------------------+---------------+---------------+
; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow.
;
SPACK	PROC	FAR
	mov	stemp,si	; save pkt pointer
	mov	ah,[si].pktype
	mov	prvtyp,ah	; remember packet type
	mov	pktcnt,0	; number of bytes sent in this packet
	mov	ax,spause	; wait spause milliseconds before sending pkt
	or	ax,ax		; zero?
	jz	spac1		; z = yes
	call	pcwait1		;   to let other side get ready
spac1:	mov	cl,trans.spad	; get the number of padding chars
	xor	ch,ch
	jcxz	spac4		; z = none
	xor	al,al
	xchg	al,trans.sdbl	; doubling char, stash and clear it
	push	ax
	mov	al,trans.spadch	; get padding char
spac2:	call	spkout		; send padding char
	jnc	spac3		; nc = success
	ret			; failed
spac3:	loop	spac2
	pop	ax		; recover doubling char
	xchg	trans.sdbl,al

spac4:	call	snddeb		; do debug display (while it's still our turn)
	mov	al,trans.ssoh	; get the start of header char
	mov	prolog,al	; put SOH in the packet
	mov	si,stemp	; address of send pktinfo
	mov	al,[si].seqnum	; SEQ
	add	al,20h		; ascii bias
	mov	prolog+2,al	; store SEQ in packet
	xor	ah,ah
	mov	chksum,ax	; start checksum
	mov	al,prvtyp	; TYPE
	mov	word ptr prolog+3,ax ; store TYPE (and null terminator)
	add	chksum,ax	; add to checksum
;
; packet length type is directly governed here by length of header plus data
; field, [si].datlen, plus chksum: regular <= 94, long <= 9024, else X long.
;
	mov	ax,[si].datlen	; DATA length
	add	ax,2		; add SEQ, TYPE lengths
	cmp	trans.chklen,'B'-'0' ; B blank-free checksum?
	jne	spac12		; ne = no
	add	al,2		; B is a special two byte checksum
	jmp	short spac13
spac12:	add	al,trans.chklen	; add checksum length at the end
spac13:	adc	ah,0		; propagate carry, yields overall new length
	cmp	ax,[si].datsize	; too big?
	jle	spac14		; le = ok
	push	dx		; tell user an internal error has occurred
	mov	dx,offset msgstl ; packet is too long
	call	ermsg1		; display message on error line
	call	captdol		; put into packet log
	pop	dx
	stc
	ret			; return bad

spac14:	mov	lentyp,3	; assume regular packet
	cmp	ax,94		; longer than a regular?
	ja	spac15		; a = use Long
	add	al,20h		; convert length to ascii
	mov	prolog+1,al	; store LEN
	xor	ah,ah
	add	chksum,ax	; add LEN to checksum
	mov	bx,offset prolog+4 ; look at data field
	jmp	spac19		; do regular

				; use Long packets (type 0)
spac15:	sub	ax,2		; deduct SEQ and TYPE from above = data+chksum
	mov	lentyp,0	; assume type 0 packet
	cmp	ax,(95*95-1)	; longest type 0 Long packet (9024)
	jbe	spac16		; be = type 0
	mov	lentyp,1	; type 1 packet, Extra Long
spac16:	mov	cl,lentyp	; add new LEN field to checksum
	add	cl,20h		; ascii bias, tochar()
	xor	ch,ch
	add	chksum,cx	; add to running checksum
	mov	prolog+1,cl	; put LEN into packet
	mov	bx,offset prolog+4
	mov	cx,1		; a counter
	xor	dx,dx		; high order numerator of length
spac17:	div	ninefive	; divide ax by 95. quo = ax, rem = dx
	push	dx		; push remainder
	inc	cx		; count push depth
	cmp	ax,95		; quotient >= 95?
	jae	spac17		; ae = yes, recurse
	push	ax		; push for pop below
spac18:	pop	ax		; get a digit
	add	al,20h		; apply tochar()
	mov	[bx],al		; store in data field
	add	chksum,ax	; accumulate checksum for header
	inc	bx		; point to next data field byte
	loop	spac18		; get the rest
				;
	mov	ax,chksum	; current checksum
	shl	ax,1		; put two highest bits of al into ah
	shl	ax,1
	and	ah,3		; want just those two bits
	shr	al,1		; put al back in place
	shr	al,1
	add	al,ah		; add two high bits to earlier checksum
	and	al,03fh		; chop to lower 6 bits (mod 64)
	add	al,20h		; apply tochar()
	mov	[bx],al		; store that in length's header checksum
	inc	bx
	mov	byte ptr [bx],0 ; terminator to prolog field
	xor	ah,ah
	add	chksum,ax	; add that byte to running checksum
				; end of inserting Long pkt info

spac19:	mov	cx,bx		; where we stopped+1
	mov	bx,offset prolog ; place where prolog section starts
	sub	cx,bx
	jcxz	spac22		; nothing
	mov	prvlen,cx	; count sent bytes for echo suppression
	sub	prvlen,3	;  minus LEN, SEQ, TYPE
spac20:	mov	al,[bx]		; prolog part
	or	al,al		; at the end?
	jz	spac22		; z = yes
	inc	bx
	call	spkout		; send byte to serial port
	jnc	spac21		; nc = good send
	jmp	spac28		; bad send
spac21:	loop	spac20		; do all prolog parts

spac22:	push	es
	mov	si,stemp	; address of pktinfo
	les	bx,[si].datadr	; select from given data buffer
	mov	dx,[si].datlen	; get the number of data bytes in packet
	add	prvlen,dx	; count bytes sent
spac23:	or	dx,dx		; any data chars remaining?
	jle	spac25		; le = no, finish up
	mov	al,es:[bx]	; get a data char
	inc	bx		; point to next char
spac24:	xor	ah,ah
	add	chksum,ax	; add the char to the checksum [umd]
	and	chksum,0fffh	; keep only low order 12 bits
	dec	dx		; say sending one character
	call	spkout		; send it
	jnc	spac23		; nc = success, get more data chars
	pop	es
	jmp	spac28		; bad send

spac25:	mov	byte ptr es:[bx],0	; terminator of data field
	pop	es
	mov	bx,offset epilog ; area for epilog
	mov	cx,chksum
	mov	bias,' '+1	; bias for checksum char (+1 for non-blank)
	cmp	trans.chklen,'B'-'0'; special non-blank checksum?
	je	spac27		; e = yes
	dec	bias		; use ' ' for regular packets
	cmp	trans.chklen,2	; what kind of checksum are we using?
	je	spac27		; e = 2 characters
	jg	spac26		; g = 3 characters
	mov	al,cl		; 1 char: get the character total
	mov	ch,cl		; save here too (need 'cl' for shift)
	and	al,0C0H		; turn off all but the two high order bits
	mov	cl,6
	shr	al,cl		; shift them into the low order position
	mov	cl,ch
	add	al,cl		; add it to the old bits
	and	al,3FH		; turn off the two high order bits.  (MOD 64)
	add	al,' '		; add a space so the number is printable
	mov	[bx],al		; put in the packet
	inc	bx		; point to next char
	jmp	short spac30

spac26: mov	byte ptr[bx],0	; null, to determine end of buffer
	push	bx		; don't lose our place
	push	es
	mov	bx,ds		; set up es for crcclc
	mov	es,bx		; es:[bx] is src of data for crcclc
	mov	bx,offset prolog+1 ; first checksummed char, skip SOH
	xor	dx,dx		; initial CRC value is 0
	call	crcclc		; calculate the CRC of prolog part, to cx
	mov	si,stemp	; address of pktinfo
	les	bx,[si].datadr	; address of data
	push	bx		; save address
	add	bx,[si].datlen	; byte beyond data
	mov	byte ptr es:[bx],0 ; null terminator for CRC
	pop	bx		; recover address of data
	mov	dx,cx		; first part of CRC returned in cx
	call	crcclc		; do CRC of data, using current CRC in dx
	pop	es
	pop	bx		; recover place to store more debug info
	push	cx		; save the crc
	mov	ax,cx		; manipulate it here
	and	ax,0F000H	; get 4 highest bits
	mov	cl,4
	shr	ah,cl		; shift over 4 bits
	add	ah,' '		; make printable
	mov	[bx],ah		; add to buffer
	inc	bx
	pop	cx		; get back checksum value
spac27:	push	cx		; save it for now
	and	cx,0FC0H	; get bits 6-11
	mov	ax,cx
	mov	cl,6
	shr	ax,cl		; shift them bits over
	add	al,bias		; make printable
	mov	[bx],al		; add to buffer
	inc	bx
	pop	cx		; get back the original
	and	cx,003FH	; get bits 0-5
	add	cl,bias		; make printable
	mov	[bx],cl		; add to buffer
	inc	bx

spac30:	mov	al,trans.seol	; get the EOL the other host wants
	xor	ah,ah
	mov	[bx],ax		; put eol and terminator in buffer
	inc	bx
spac32:	xor	ch,ch
	mov	cl,trans.chklen	; checksum length
	cmp	cl,'B'-'0'	; special non-blank checksum?
	jne	spac32a		; ne = no
	mov	cl,2		; Blank checksum is a two byte affair
spac32a:add	prvlen,cx	; bytes sent
	inc	cx		; plus EOL char
	mov	bx,offset epilog; where to find data
spac33:	mov	al,[bx]
	inc	bx
	call	spkout		; send it
	jc	spac28		; c = failure to send
	loop	spac33
	cmp	debflg,0
	je	spac34
	mov	dx,offset crlf
	call	captdol
spac34:	mov	ax,pktcnt	; number of bytes sent in this packet
	add	fsta.psbyte,ax	; file total bytes sent
	adc	fsta.psbyte+2,0	; propagate carry to high word
	add	fsta.pspkt,1	; statistics, count a packet being sent
	adc	fsta.pspkt+2,0	;  ripple carry
	call	chkcon		; check console for user interrupts
	mov	si,stemp	; restore pkt pointer
	clc			; carry clear for success
	ret			; return successfully
spac28:	mov	dx,offset msgbadsnd ; say sending error in log
	call	captdol
	mov	ax,pktcnt	; number of bytes sent in this packet
	add	fsta.psbyte,ax	; file total bytes sent
	adc	fsta.psbyte+2,0	; propagate carry to high word
	add	fsta.pspkt,1	; statistics, count a packet being sent
	adc	fsta.pspkt+2,0	;  ripple carry
	mov	si,stemp	; restore pkt pointer
	stc			; carry set for failure
	ret			; bad send
SPACK	ENDP 

spkout:	cmp	al,trans.sdbl	; double this char?
	jne	spkou1		; ne = no
	call	spkou1		; do it once here and again via fall through
	jnc	spkou1		;  but again only if no failure
	ret			; return failure
spkou1:	push	bx		; send char in al out the serial port
	push	cx		; return carry clear if success
	push	dx
	push	es
	mov	tmp,1		; retry counter
	cmp	debflg,0	; recording material?
	je	spkour		; e = no
	call	captchr		; record in debugging log
spkour:	mov	ah,al		; outchr1 wants char in ah
	push	ax		; save for retries
	call	outchr1		; serial port transmitter procedure
	pop	ax		; recover for retries
	jc	spkoux		; c = bad send, retry
	inc	pktcnt		; count number of bytes sent in this packet
	pop	es
	pop	dx
	pop	cx
	pop	bx
	clc			; carry	clear for good send
	ret
spkoux:	cmp	tmp,5		; done 5 attempts on this char?
	jge	spkoux1		; ge = yes, fail the sending
	inc	tmp
	push	ax
	mov	ax,10		; wait 10 milliseconds
	call	pcwait1
	pop	ax
	jmp	short spkour	; retry
spkoux1:pop	es		; failed to send char
	pop	dx
	pop	cx
	pop	bx
	stc			; set carry for bad send
	ret
     
; Calculate the CRC of the null-terminated string whose address is in ES:BX.
; Returns the CRC in CX.  Destroys BX and AX.
; The CRC is based on the SDLC polynomial: x**16 + x**12 + x**5 + 1.
; Original by Edgar Butt  28 Oct 1987 [ebb].
; Enter with initial CRC in DX (normally 0).
crcclc: push	dx
	mov	cl,4			; load shift count
crc0:   mov	ah,es:[bx]		; get the next char of the string
        or	ah,ah			; if null, then we're done
        jz	crc1			; z = null, stop
        inc	bx
        xor	dl,ah			; XOR input with lo order byte of CRC
        mov	ah,dl			; copy it
        shl	ah,cl			; shift copy
        xor	ah,dl			; XOR to get quotient byte in ah
        mov	dl,dh			; high byte of CRC becomes low byte
        mov	dh,ah			; initialize high byte with quotient
        xor	al,al
        shr	ax,cl			; shift quotient byte
        xor	dl,ah			; XOR (part of) it with CRC
        shr	ax,1			; shift it again
        xor	dx,ax			; XOR it again to finish up
        jmp	short crc0
crc1:   mov	cx,dx			; return CRC in CX
        pop	dx
        ret

; Receive_Packet
; This routine waits for a packet arrive from the host. Two Control-C's in a
; row from the comms line will cause a Control-C interruption exit.
; Returns
;	SI = pointer to pktinfo structure, as
;	[SI].SEQNUM - Packet sequence number
;	[SI].DATLEN - Number of data characters
;	[SI].DATADR - Address of data field for packet
; Returns AH -  packet type (letter code)
; Returns: carry clear if success, carry set if failure.
; Packet construction areas:
; 	Prolog (8 bytes+2 nulls)	null	Data	null  Epilog   null
;+----------------------------------------+---------------+---------------+
;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS |
;+----------------------------------------+---------------+---------------+
; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow.

RPACK	PROC	FAR
	mov	rtemp,si		; save pkt structure address
	xor	ax,ax			; get a zero
	mov	fairflg,ax		; set fairness flag
	mov	badpflag,al		; bad parity flag, clear it
	mov	prevchar,al		; clear previous recv'd char area
	mov	bias,al			; assume not using special B chksum
	mov	[si].pktype,'T'		; assume 'T' type packet (timeout)
	mov	[si].datlen,ax		; init to empty buffer
	push	es
	les	bx,[si].datadr		; caller's data buffer
	mov	word ptr es:[bx],ax	; clear storage areas (asciiz)
	pop	es
	mov	word ptr prolog,ax
	mov	word ptr epilog,ax
	mov	bx,offset prolog
	mov	pktcnt,ax		; number of bytes rcvd in packet
	mov	al,trans.rsoh		; start of packet char
	mov	SOHchar,al		; save, local copy is modified
	call	rcvdeb			; setup debug display
	mov	bx,seg prolog
	mov	es,bx
	mov	bx,offset prolog	; set es:bx for logging
	jmp	rpack0a

; Get here with unexpected char (SOH or before) and echos with printable SOH
rpack0:	push	ax			; save char which got us here
	mov	bx,rtemp		; pktinfo address
	mov	[bx].datlen,0		; say no data yet
	mov	[bx].seqnum,0ffh	; illegal value
	mov	[bx].pktype,0		; illegal value
	xor	ax,ax			; get a zero
	push	es
	les	bx,[bx].datadr	 	; point to data buffer
	mov	word ptr es:[bx],ax	; clear start of that buffer
	pop	es
	mov	bx,seg prolog
	mov	es,bx			; set buffer pointer
	mov	bx,offset prolog
	mov	word ptr prolog,ax	; clear prolog field
	mov	word ptr epilog,ax	; clear epilog field
	mov	pktcnt,ax		; count of chars
	mov	al,trans.rsoh		; start of packet char
	mov	SOHchar,al		; save, local copy is modified
	pop	ax
	test	status,stat_int		; interrupted?
	jz	rpack0d			; z = no
	jmp	rpack60			; yes, exit now

rpack0d:mov	cx,status		; current status
	mov	status,stat_suc		; presume success
	test	cx,stat_echo		; doing echo processing?
	jnz	rpack0h			; nz = yes
	cmp	al,SOHchar		; read SOH?
	jne	rpack0a			; ne = no, get it
	jmp	rpack1			; go read LEN

rpack0h:cmp	trans.rsoh,' '		; printable SOH (special case)?
	jb	rpack0a			; b = no, normal, get normal SOH
	; For printable SOH we need to step over possible repetitions used in
	; the general data stream. Thus we wait the length of the sent pkt.
	; This will hopefully gobble up echos of the last sent packet.
	mov	cx,prvlen		; LEN field of last sent packet
	jcxz	rpack0a			; in case zero by some accident
	mov	timeval,2		; reduce local timer value to 2 secs	
	cmp	cx,256			; keep waiting bounded
	jbe	rpack0f			; be = not very large
	mov	cx,256			; this should be enough bytes to wait
rpack0f:push	cx
	call	inchr			; get and discard cx bytes
	pop	cx
	test	status,stat_tmo+stat_int ; timeout or user intervention?
	jz	rpack0g			; z = no
	jmp	rpack60			; timeout or user intervention, quit
rpack0g:loop	rpack0f			; keep discarding bytes
	
rpack0a:mov	status,stat_suc		; assume success
	mov	cl,trans.stime		; time to wait for start of packet
	mov	timeval,cl		; local timer value, seconds
	call	inchr			; get a character. SOH
	jnc	rpack0b			; nc = got one
				; c=failure (eol, timeout, user intervention)
	test	status,stat_eol		; hit eol from prev packet?
	jnz	rpack0			; nz = yes, restart
	jmp	rpack60			; timeout or user intervention

rpack0b:mov	ah,al			; copy the char
	and	ah,7fh			; strip any parity bit, regardless
	cmp	ah,SOHchar		; start of header char?
	je	rpack0c			; e = yes, SOH
	jmp	rpack0			; ne = no, go until it is
rpack0c:xor	ah,ah			; clear the terminator byte
	cmp	SOHchar,' '		; printable SOHchar?
	jb	rpack1			; b = no (else start crippled mode)
	mov	SOHchar,ah		; yes, set it to null for no matches

rpack1:	mov	timeval,2		; reduce local timer value to 2 secs
	call	inchr			; get a character. LEN
	jc	rpack1a			; failure
	and	al,7fh			; strip any parity bit
	cmp	al,SOHchar		; start of header char?
	jne	rpack1b			; ne = no
rpack1a:jmp	rpack0			; yes, start over (common jmp point)

rpack1b:mov	chksum,ax		; start the checksum
	sub	al,20h			; unchar(LEN) to binary
	jnc	rpack1e			; nc = legal (printable)
	or	status,stat_ptl		; set bad length status
	jmp	rpack40			; and quit
rpack1e:mov	si,rtemp
	mov	[si].datlen,ax		; save the data count (byte)
	call	inchr			; get a character. SEQ
	jc	rpack1a			; c = failure
	and	al,7fh			; strip any parity bit
	cmp	al,SOHchar		; SOH?
	je	rpack1a			; e = yes, then go start over
	add	chksum,ax
	sub	al,' '			; get the real packet number
	jnc	rpack1f			; nc = no overflow
	or	status,stat_ptl		; say bad status
	jmp	rpack40			; and exit now
rpack1f:mov	si,rtemp
	mov	[si].seqnum,al		; save the packet number. SEQ
	call	inchr			; get a character. TYPE
	jc	rpack1a			; c = failure
	and	al,7fh			; strip any parity bit
	cmp	al,SOHchar		; SOH?
	je	rpack1a			; e = yes, then go start over
	mov	[si].pktype,al		; save the message type
	cmp	al,prvtyp		; echo of sent packet?
	jne	rpack1g			; ne = no
	or	status,stat_echo	; status is echo processing
	mov	dx,offset msgecho 	; say echo in log
	call	captdol
	jmp	rpack0			; start over

rpack1g:add	chksum,ax		; add it to the checksum
	call	parchk			; check parity on protocol characters
	call	getlen		; get complicated data length (reg, lp, elp)
				; into [si].datlen and kind into byte lentyp. carry set if error
	jnc	rpack1c			; nc = packet is ok so far
	jmp	rpack40			; failure
rpack1c:
; Start of change.
; Now determine block check type for this packet.  Here we violate the layered
; nature of the protocol by inspecting the packet type in order to detect when
; the two sides get out of sync.  Two heuristics allow us to resync here:
;   a. I and S packets always have a type 1 checksum.
;   b. A NAK never contains data, so its block check type is len - 1.
	mov	si,rtemp		; pktinfo address
	mov	ch,trans.chklen		; current checksum length
	cmp	ch,'B'-'0'		; special non-blank kind?
	jne	rpk4			; ne = no
	mov	ch,2			; yes, it's a special 2-byte flavor
rpk4:	mov	ax,[si].datlen		; length of packet information
	mov	cl,[si].pktype		; packet type byte itself
	cmp	cl,'S'			; "S" packet?
	jne	rpk0			; ne = no
	mov	ch,1			; S packets use one byte checksums
	jmp	short rpk3
rpk0:	cmp	cl,'I'			; I packets are like S packets
	jne	rpk1
	mov	ch,1			; I packets use one byte checksums
	jmp	short rpk3
rpk1:	cmp	cl,'N'			; NAK?
	jne	rpk3			; ne = no
	cmp	ax,1			; NAK, get length of data + chklen
	jb	rpk1a			; b = impossible length
	cmp	ax,3			; longest NAK (3 char checksum)
	jbe	rpk2			; be = possible
rpk1a:	or	status,stat_ptl		; status = bad length
	jmp	rpack40			; return on impossible length
rpk2:	mov	trans.chklen,al		; remainder must be checksum type
	mov	ch,al
rpk3:	sub	al,ch			; minus checksum length, for all pkts
	sbb	ah,0			; propagate borrow
	mov	[si].datlen,ax		; store apparent length of data field
	mov	chklength,ch		; remember for checking below
; End of change.
; For long packets we start the real data (after the extended byte
; count 3 or 4 bytes).

	mov	si,rtemp
	mov	dx,[si].datlen		; length of data field, excl LP header
	mov	chrcnt,dx
	cmp	dx,[si].datsize		; material longer than data buffer?
	ja	rpk8b			; a = yes, give up
	mov	dx,trans.rlong		; longest packet we should receive
	sub	dl,chklength		; minus checksum length
	sbb	dh,0			; propagate borrow
	cmp	dx,chrcnt		; is data too long?
	jae	rpk8c			; ae = not too big
rpk8b:	or	status,stat_ptl		; failure status, packet too long
	jmp	rpack40			; too big, quit now
rpk8c:	les	bx,[si].datadr	 	; point to offset of data buffer
	mov	word ptr es:[bx],0	; clear start of that buffer
					; get DATA field characters
rpack2:	cmp	chrcnt,0		; any chars expected?
	jle	rpack3			; le = no, go do checksum
	call	inchr			; get a character into al. DATA
	jc	rpak2c			; c = Control-C, timeout, eol
	cmp	al,SOHchar		; start of header char?
	jne	rpak2b			; ne = no
	jmp	rpack0			; yes, then go start over
rpak2b:	add	chksum,ax		; inchr clears AH
	dec	chrcnt			; one less char expected
	jmp	short rpack2		; get another data character
rpak2c:	test	status,stat_eol		; bare EOL in data part?
	jz	rpak2d			; z = no
	and	status,not stat_eol	; turn off status bit
	jmp	short rpak2b		;  and carry on regardless
rpak2d:	jmp	rpack40			; Control-C, timeout

rpack3:	and	chksum,0fffh	; keep only lower 12 bits of current checksum
	mov	bx,offset epilog	; record debugging in epilog buffer
	mov	ax,seg epilog
	mov	es,ax
	mov	word ptr es:[bx],0
	call	inchr			; start Checksum bytes
	jc	rpack3b			; failed
	mov	ah,al
	and	ah,7fh			; strip high bit
	cmp	ah,SOHchar		; start of header char?
	jne	rpack3a			; ne = no
	jmp	rpack0			; yes, then go start over
rpack3a:sub	al,' '			; unchar() back to binary
	mov	cx,chksum		; current checksum
	cmp	chklength,2		; which checksum length is in use?
	je	rpack5			; e = Two character checksum
	ja	rpack4			; a = Three char CRC, else one char
	shl	cx,1			; put two highest digits of al into ah
	shl	cx,1
	and	ch,3			; want just those two bits
	shr	cl,1			; put al back in place
	shr	cl,1
	add	cl,ch			;add two high bits to earlier checksum
	and	cl,03fh			; chop to lower 6 bits (mod 64)
	cmp	cl,al		; computed vs received checksum byte (binary)
	je	rpack3b			; e = equal, so finish up
	or	status,stat_chk		; say checksum failure
rpack3b:jmp	rpack40

rpack4:	mov	tmp,al			; save value from packet here
	push	bx			; three character CRC
	push	es
	mov	bx,seg prolog
	mov	es,bx
	mov	bx,offset prolog+1	; where data for CRC is, skipping SOH
	xor	dx,dx			; initial CRC is zero
	call	crcclc			; calculate the CRC and put into CX
	mov	bx,rtemp
	les	bx,[bx].datadr		; data field segment
	mov	dx,cx			; previous CRC
	call	crcclc			; final CRC is in CX
	mov	chksum,cx		; save computed checksum
	pop	es
	pop	bx
	mov	ah,ch			; cx = 16 bit binary CRC of rcv'd data
	and	ah,0f0h			; manipulate it here
	shr	ah,1
	shr	ah,1			; get 4 highest bits
	shr	ah,1
	shr	ah,1			; shift right 4 bits
	cmp	ah,tmp			; is what we got == calculated?
	je	rpack4a			; e = yes
	or	status,stat_chk		; checksum failure
rpack4a:call	inchr			; get next character of checksum
	jc	rpack40			; c = failed
	and	al,7fh			; strip high bit
	cmp	al,SOHchar		; SOH?
	jne	rpack4b			; ne = no
	jmp	rpack0			; start over
rpack4b:sub	al,' '			; get back real value
					; two character checksum + CRC
rpack5:	mov	ch,al			; save last char here for now
	mov	ax,chksum
	and	ax,0fc0h		; get bits 11..6
	mov	cl,6
	shr	ax,cl			; shift bits
	cmp	al,ch			; equal?
	je	rpack5a			; e = yes
	mov	bias,1			; try adding bias
	inc	al			; try 'B' method of +1 on bias
	cmp	al,ch			; same?
	je	rpack5a			; matched
	or	status,stat_chk		; checksum failure
rpack5a:call	inchr			; get last character of checksum
	jc	rpack40			; c = failed
	and	al,7fh			; strip high bit
	cmp	al,SOHchar		; SOH?
	jne	rpack5b			; ne = no
	jmp	rpack0			; e = yes
rpack5b:sub	al,' '			; get back real value
	mov	cx,chksum
	and	cl,3FH			; get bits 0-5
	add	cl,bias			; try 'B' method of +1 on bias
	cmp	al,cl			; do the last chars match?
	je	rpack40			; e = yes
	or	status,stat_chk		; say checksum failure

rpack40:test	status,stat_tmo		; timeout?
	jz	rpack41			; z = no
	jmp	rpack60			; nz = yes
rpack41:test	status,stat_eol		; premature eol?
	jz	rpack42			; z = no
	or	status,stat_bad		; say bad packet overall
	jmp	short rpack45		; now try for handshake

rpack42:call	inchr			; get eol char
	jnc	rpack43			; nc = got regular character
	test	status,stat_int		; interrupted?
	jnz	rpack60			; nz = yes
rpack43:and	status,not stat_tmo	; ignore timeouts on EOL character
	test	status,stat_eol		; eol char?
	jnz	rpack44			; nz = yes, got the EOL char
	and	al,7fh			; strip high bit
	cmp	al,SOHchar		; SOH already?
	jne	rpack44			; ne = no
	jmp	rpack0			; yes, start over

rpack44:and	status,not stat_eol 	; desired eol is not an error
					; test for line turn char
rpack45:mov	bx,portval		;   if doing handshaking
	cmp	[bx].hndflg,0		; doing half duplex handshaking?
	je	rpack60			; e = no
	mov	ah,[bx].hands		; get desired handshake char
	mov	tmp,ah			; keep handshake char here
	mov	bx,seg epilog		; where to store character
	mov	es,bx
	mov	bx,offset epilog
rpack45b:call	inchr			; get handshake char
	jnc	rpack46			; nc = regular character
	test	status,stat_eol		; EOL char?
	jnz	rpack46			; nz = yes
	jmp	short rpack48		; timeout or user intervention
rpack46:and	status,not stat_eol	; ignore unexpected eol status here
	and	al,7fh			; strip high bit
	cmp	al,SOHchar		; SOH already?
	jne	rpack47			; ne = no
	jmp	rpack0			; yes, start over
rpack47:cmp	al,tmp			; compare received char with handshake
	jne	rpack45		; ne = not handshake, try again til timeout
rpack48:and	status,not stat_tmo	; ignore timeouts on handshake char

					; Perform logging and debugging now
rpack60:call	chkcon			; check console for user interrupt
	cmp	debflg,0		; recording packets?
	je	rpack66			; e = no
	mov	dx,offset crlf
	call	captdol			; end current display line
	cmp	status,stat_suc		; success?
	je	rpack66			; e = yes
	mov	dx,offset msgheader	; starting "<"
	call	captdol
	test	status,stat_tmo		; timeout?
	jz	rpack61			; no
	mov	dx,offset msgtmo 	; say timeout in log
	call	captdol
	mov	si,rtemp
	mov	ah,'T'			; return packet type in ah
	mov	[si].pktype,ah		; say 'T' type packet (timeout)
rpack61:test	status,stat_chk		; checksum bad?
	jz	rpack62			; z = no
	mov	dx,offset msgchk
	call	captdol
rpack62:test	status,stat_ptl		; packet too long?
	jz	rpack63			; z = no
	mov	dx,offset msgptl
	call	captdol
rpack63:test	status,stat_int		; user interruption?
	jz	rpack64			; z = no
	mov	dx,offset msgint
	call	captdol
rpack64:test	status,stat_bad		; premature EOL?
	jz	rpack65			; z = no
	mov	dx,offset msgbad
	call	captdol
rpack65:mov	dx,offset msgtail	; end of error cause field
	call	captdol

rpack66:mov	ax,pktcnt		; number of bytes received in packet
	add	fsta.prbyte,ax		; file total received pkt bytes
	adc	fsta.prbyte+2,0		; propagate carry to high word
	add	fsta.prpkt,1		; file received packets
	adc	fsta.prpkt+2,0		;  ripple carry
	mov	si,rtemp		; restore pkt pointer
	mov	ah,[si].pktype		; return packet TYPE in ah
	cmp	status,stat_suc		; successful so far?
	jne	rpack72			; ne = no
	cmp	chkparflg,0		; do parity checking?
	je	rpack71			; e = no
	mov	chkparflg,0		; do only once
	test	badpflag,80h		; get parity error flagging bit
	jz	rpack71			; z = no parity error
	mov	bx,portval
	mov	cl,badpflag		; get new parity plus flagging bit
	and	cl,7fh			; strip flagging bit
	mov	[bx].parflg,cl		; force new parity
rpack71:clc				; carry clear for success
	ret
rpack72:stc				; carry set for failure
	ret				; failure exit
RPACK	ENDP

; Get packet if enough bytes for minimal pkt and SOP has been seen. Returns
; carry set if unable, else use Rpack to deliver the packet. Call the same
; as Rpack.
peekreply proc	far
	call	peekcom			; get comms SOP count
	jnc	peekrp1			; nc = have some bytes
	ret				; return carry set for nothing to do
peekrp1:cmp	cx,6			; enough for basic NAK?
	jb	peekrp2			; be = no
	jmp	rpack			; go decode the packet
peekrp2:stc				; say nothing to do
	ret
peekreply endp

; Check Console (keyboard). Return carry setif "action" chars: cr for forced
; timeout, Control-E for force out Error packet, Control-C for quit work now.
; Return carry clear on Control-X and Control-Z as these are acted upon by
; higher layers. Consume and ignore anything else.
chkcon:	call	isdev1		; is stdin a device and not a disk file?
	jnc	chkco5		; nc = no, a disk file so do not read here
	mov	dl,0ffh
	mov	ah,dconio		; read console
	int	dos
	jz	chkco5			; z = nothing there
	and	al,1fh			; make char a control code
	cmp	al,CR			; carriage return?
	je	chkco3			; e = yes, simulate timeout
	cmp	al,'C'-40h		; Control-C?
	je	chkco1			; e = yes
	cmp	al,'E'-40h		; Control-E?
	je	chkco1			; e = yes
	cmp	al,'X'-40h		; Control-X?
	je	chkco4			; e = yes
	cmp	al,'Z'-40h		; Control-Z?
	je	chkco4		; record it, take no immmediate action here
	cmp	al,'Q'-40h		; Control-Q?
	je	chkco6			; e = yes
	or	al,al			; scan code being returned?
	jnz	chkco5			; nz = no, ignore ascii char
	mov	ah,dconio		; read and discard second byte
	mov	dl,0ffh
	int	dos
	jmp	short chkco5		; else unknown, ignore
chkco1:	or	al,40h			; make Control-C-E printable
	mov	flags.cxzflg,al		; remember what we saw
chkco2:	or	status,stat_int		; interrupted
	stc
	ret				; act now
chkco3:	or	status,stat_tmo		; CR simulates timeout
	stc
	ret				; act now
chkco4:	or	al,40h			; make control-X-Z printable
	mov	flags.cxzflg,al		; put into flags
	clc				; do not act on them here
	ret
chkco5:	cmp	flags.cxzflg,'C'	; control-C intercepted elsewhere?
	je	chkco2			; e = yes
	clc				; else say no immediate action needed
	ret
chkco6:	xchg	ah,al			; put Control-Q in AH for transmission
	call	spkout			; send it now
	jmp	short chkco5

getlen	proc	near		; compute packet length for short & long types
				; returns length in [si].datlen and
				; length type (0, 1, 3) in local byte lentyp
				; returns length of  data + checksum
	mov 	si,rtemp
	mov	ax,[si].datlen	; get LEN byte value
	and	ax,7fh		; clear unused high byte and parity bit

	cmp	al,3		; regular packet has 3 or larger here
	jb	getln1		; b = long packet
	sub	[si].datlen,2	; minus SEQ and TYPE = DATA + CHKSUM
	mov	lentyp,3	; store assumed length type (3 = regular)
	clc			; clear carry for success
	ret

getln1:	push	cx		; counter for number of length bytes
	mov	lentyp,0	; store assumed length type 0 (long)
	mov	cx,2		; two base-95 digits
	or	al,al		; is this a type 0 (long packet)?
	jz	getln2		; z = yes, go find & check length data
	mov	lentyp,1	; store length type (1 = extra long)
	inc	cx		; three base 95 digits
	cmp	al,1		; is this a type 1 (extra long packet)?
	je	getln2		; e = yes, go find & check length data
	pop	cx
	or	status,stat_ptl	; say packet too long (an unknown len code)
	stc			; set carry bit to say error
	ret
getln2:				; chk header chksum and recover binary length
	push	dx		; save working reg
	xor	ax,ax		; clear length accumulator, low part
	mov	[si].datlen,ax	; clear final length too
getln3:	xor	dx,dx		; ditto, high part
	mov	ax,[si].datlen	; length to date
	mul	ninefive	; multiply accumulation (in ax) by 95
	mov	[si].datlen,ax	; save results
	push	cx
	call	inchr		; read another serial port char into al
	pop	cx
	jc	getln4		; c = failure
	add	chksum,ax
	sub	al,20h		; subtract space, apply unchar()
	mov	si,rtemp
	add	[si].datlen,ax	; add to overall length count
	loop	getln3		; cx preset earlier for type 0 or type 1
	mov	dx,chksum	; get running checksum
	shl	dx,1		; get two high order bits into dh
	shl	dx,1
	and	dh,3		; want just these two bits
	shr	dl,1		; put low order part back
	shr	dl,1
	add	dl,dh		; add low order byte to two high order bits
	and	dl,03fh		; chop to lower 6 bits (mod 64)
	add	dl,20h		; apply tochar()
	push	dx
	call	inchr		; read another serial port char
	pop	dx
	jc	getln4		; c = failure
	add	chksum,ax
	cmp	dl,al		; our vs their checksum, same?
	je	getln5		; e = checksums match, success
getln4:	or	status,stat_chk	; checksum failure
	pop	dx		; unsave regs (preserves flags)
	pop	cx
	stc			; else return carry set for error
	ret
getln5:	pop	dx		; unsave regs (preserves flags)
	pop	cx
	clc			; clear carry (say success)
	ret
getlen	endp

; Get char from serial port into al, with timeout and console check.
; Return carry set if timeout or console char or EOL seen,
; return carry clear and char in AL for other characters.
; Sets status of stat_eol if EOL seen.
; Fairflg allows occassional reads from console before looking at serial port.
inchr	proc	near
	mov	timeit,0	; reset timeout flag (do each char separately)
	push	es		; save debug buffer pointer es:bx
	push	bx
	cmp	fairflg,500	; look at console first every now and then
	jbe	inchr1		; be = not console's turn yet
	mov	fairflg,0	; reset fairness flag for next time
	call	chkcon		; check console
	jnc	inchr1		; nc = nothing to interrupt us
	pop	bx		; clean stack
	pop	es
	ret			; return failure for interruption

inchr1:	call	prtchr1		; read a serial port character
	jc	inchr2		; c = nothing there
	pop	bx		; here with char in al from port
	pop	es		; debug buffer pointer
	mov	ah,al		; copy char to temp place AH
	and	ah,7fh		; strip parity bit from work copy
	and	al,parmsk	; apply 7/8 bit parity mask
;;	or	ah,ah		; null char?
;;	jz	inchr		; ignore the null, read another char
;;	cmp	ah,del		; ascii del byte?
;;	je	inchr		; e = yes, ignore it too
	cmp	debflg,0	; recording material?
	je	inchr1a		; e = no
	call	captchr		; log char in al
inchr1a:inc	pktcnt		; count received byte
	cmp	al,trans.rign	; char in al to be ignored?
	je	inchr		; e = yes, do so
	test	flags.remflg,dserver ; acting as a server?
	jz	inchr6		; z = no
	cmp	ah,'C'-40h	; Control-C from comms line?
	jne	inchr6		; ne = no
	cmp	ah,prevchar	; was previous char also Control-C?
	jne	inchr6		; ne = no
	cmp	ah,SOHchar	; could this also be an SOH?
	je	inchr6		; e = yes, do not exit
	cmp	ah,trans.reol	; could this also be an EOL?
	je	inchr6		; e = yes
	test	denyflg,finflg	; is FIN enabled?
	jnz	inchr6		; nz = no, ignore server exit cmd
	mov	flags.cxzflg,'C'; set Control-C flag
	or	status,stat_int+stat_eol ; say interrupted and End of Line
	mov	al,ah		; use non-parity version
	xor	ah,ah		; always return with high byte clear
	mov	es:[bx],ax	; store char and null in debugging buffer
	inc	bx
	stc			; exit failure
	ret
inchr6:	mov	prevchar,ah	; remember current as previous char
	cmp	ah,trans.reol	; eol char we want?
	je	inchr7		; e = yes, ret with carry set
	xor	ah,ah		; always return with high byte clear
	mov	es:[bx],ax	; store char and null in buffer
	inc	bx
	clc			; char is in al
	ret

inchr7:	or	status,stat_eol	; set status appropriately
	xor	ah,ah		; always return with high byte clear
	mov	es:[bx],ax	; store char and null in buffer
	inc	bx
	stc			; set carry to say eol seen
	ret			; and return qualified failure
	
inchr2:	call	chkcon		; check console
	jnc	inchr2a		; nc = nothing to interrupt us
	pop	bx		; clean stack
	pop	es
	ret			; return failure for interruption

inchr2a:cmp	flags.timflg,0	; are timeouts turned off?
	je	inchr1		; e = yes, just check for more input
	cmp	trans.stime,0	; doing time outs?
	jne	inchr2b		; ne = yes
	jmp	inchr1		; go check for more input
inchr2b:push	cx		; save regs
	push	dx		; Stolen from Script code
	cmp	timeit,0	; have we gotten time of day for first fail?
	jne	inchr4		; ne = yes, just compare times
	mov	ah,gettim	; get DOS time of day
	int	dos		; ch = hh, cl = mm, dh = ss, dl = 0.01 sec
	xchg	ch,cl		; get ordering of low byte = hours, etc
	mov	word ptr rptim,cx ; hours and minutes
	xchg	dh,dl
	mov	word ptr rptim+2,dx ; seconds and fraction
	mov	bl,timeval	; our desired timeout interval (seconds)
	xor	bh,bh		; one byte's worth
	mov	temp,bx		; work area
	mov	bx,2	   	; start with seconds field
inchr3: mov	ax,temp		; desired timeout interval, working copy
	add	al,rptim[bx]	; add current tod digit interval
	adc	ah,0
	xor	dx,dx		; clear high order part thereof
	div	sixzero		; compute number of minutes or hours
	mov	temp,ax		; quotient, for next time around
	mov	rptim[bx],dl	; put normalized remainder in timeout tod
	dec	bx		; look at next higher order time field
	or	bx,bx		; done all time fields?
	jge	inchr3		; ge = no
	cmp	rptim[0],24	; normalize hours
	jl	inchr3a		; l = not 24 hours or greater
	sub	rptim[0],24	; discard part over 24 hours
inchr3a:mov	timeit,1	; say have tod of timeout

inchr4:	mov	ah,gettim	; compare present tod versus timeout tod
	int	dos		; get the time of day
	sub	ch,rptim	; hours difference, ch = (now - timeout)
	je	inchr4b		; e = same, check mmss.s
	jl	inchr4d		; l = we are early
	cmp	ch,12		; hours difference, large or small?
	jge	inchr4d		; ge = we are early
	jl	inchr4c		; l = we are late, say timeout
inchr4b:cmp	cl,rptim+1	; minutes, hours match
	jb	inchr4d		; b = we are early
	ja	inchr4c		; a = we are late
	cmp	dh,rptim+2	; seconds, hours and minutes match
	jb	inchr4d		; b = we are early
	ja	inchr4c		; a = we are late
	cmp	dl,rptim+3	; hundredths of seconds, hhmmss match
	jb	inchr4d		; b = we are early
inchr4c:or	status,stat_tmo	; say timeout
	pop	dx
	pop	cx
	pop	bx
	pop	es
	stc			; set carry bit
	ret			; failure
inchr4d:pop	dx
	pop	cx
	jmp	inchr1		; not timed out yet
inchr	endp

				; Packet Debug display routines
rcvdeb:	test	flags.debug,logpkt ; In debug mode?
	jnz	rcvde1		; nz = yes
	test	flags.capflg,logpkt ; log packets?
	jnz	rcvde1		; nz = yes
	ret			; no
rcvde1:	mov	debflg,'R'	; say receiving
	jmp	short deb1

snddeb:	test	flags.debug,logpkt ; In debug mode?
	jnz	sndde1		; nz = yes
	test	flags.capflg,logpkt ; log packets?
	jnz	sndde1		; yes
	ret			; no
sndde1:	mov	debflg,'S'	; say sending

deb1:	push	di		; Debug. Packet display
	test	flags.debug,logpkt	; is debug active (vs just logging)?
	jz	deb1e		; z = no, just logging
	cmp	fmtdsp,0	; non-formatted display?
	je	deb1d		; e = yes, skip extra line clearing
	cmp	debflg,'R'	; receiving?
	je	deb1a		; e = yes
	call	sppos1		; spack: cursor position
	jmp	short deb1b
deb1a:	call	rppos1		; rpack: cursor position
deb1b:	mov	cx,4		; clear 4 lines
deb1c:	push	cx
	call	clearl1		; clear the line
        mov	dx,offset crlf
        mov	ah,prstr	; display
        int	dos
	pop	cx
	loop	deb1c
	cmp	debflg,'R'	; receiving?
	je	deb1d		; e = yes
	call	sppos1		; reposition cursor for spack:
	jmp	short deb1e
deb1d:	call	rppos1		; reposition cursor for rpack:
deb1e:	mov	dx,offset spmes	; spack: message
	cmp	debflg,'R'
	jne	deb2		; ne = sending
	mov	dx,offset rpmes	; rpack: message
deb2:	mov	colcnt,0	; number of columns used so far
	mov	linecnt,0	; no lines completed yet
	call	captdol		; record dollar terminated string in Log file
	pop	di
	ret


captdol	proc	near		; write dollar sign terminated string in dx
				; to the capture file (Log file).
	push	ax		; save regs
	push	si
	push	es
	mov	si,dx		; point to start of string
	cld
captdo1:lodsb			; get a byte into al
	cmp	al,'$'		; at the end yet?
	je	captdo3		; e = yes
	or	al,al		; asciiz?
	jz	captdo3		; z = yes, this is also the end
	inc	colcnt
	cmp	al,lf		; new line?
	jne	captdo4		; ne = no
	inc	linecnt		; count displayed lines
	mov	colcnt,0	; start of new line
captdo4:test	flags.debug,logpkt ; debug display active?
	jz	captdo2		; z = no
	cmp	linecnt,4	; four lines used on screen?
	jae	captdo2		; ae = yes, omit more lines
	push	ax
	mov	dl,al
	mov	ah,conout
	int	dos		; display char in dl
	pop	ax
captdo2:test	flags.capflg,logpkt ; logging active?
	jz	captdo1		; z = no
	call	fpktcpt		; record the char, pktcpt is in msster.asm
	jmp	short captdo1	; repeat until dollar sign is encountered
captdo3:pop	es
	pop	si
	pop	ax
	ret
captdol	endp

captchr	proc	near		; record char in AL into the Log file
	test	flags.debug,logpkt ; debug display active?
	jnz	captch1		; nz = yes
	test	flags.capflg,logpkt ; logging active?
	jnz	captch1		; nz = yes
	ret
captch1:push	ax
	push	es
	test	al,80h		; high bit set?
	jz	captch2		; z = no
	push	ax
	mov	al,'~'
	call	captworker	; record the char
	pop	ax
	and	al,not 80h
captch2:cmp	al,DEL		; DEL?
	je	captch2a	; e = yes
	cmp	al,' '		; control char?
	jae	captch4		; ae = no
captch2a:add	al,40h		; uncontrollify the char
	push	ax		; save char in dl
	mov	al,5eh		; show caret before control code
	call	captworker	; record the char
	cmp	colcnt,70	; exhausted line count yet?
	jb	captch3		; b = not yet
	mov	al,CR
	call	captworker
	mov	al,LF
	call	captworker
captch3:pop	ax		; recover char in dl
captch4:call	captworker	; record the char
	cmp	colcnt,70
     	jb	captch5		; b = not yet
	mov	al,CR
	call	captworker
	mov	al,LF
	call	captworker
captch5:pop	es
	pop	ax
	ret
captchr	endp

captworker proc	near
	inc	colcnt		; count new character
	cmp	al,LF		; new line?
	jne	captw3		; ne = no
	inc	linecnt		; count displayed lines
	mov	colcnt,0	; start of new line
captw3:	test	flags.debug,logpkt ; debug display active?
	jz	captw1		; z = no
	cmp	linecnt,4	; four lines used on screen?
	jae	captw1		; ae = yes, omit more lines
	push	ax
	mov	dl,al
	mov	ah,conout
	int	dos
	pop	ax
captw1:	test	flags.capflg,logpkt ; logging active?
	jz	captw2		; z = no
	call	fpktcpt		; log to file
captw2:	ret
captworker endp

parchk	proc	near			; check parity of pkt prolog chars
	cmp	chkparflg,0		; ok to check parity?
	jne	parchk0			; ne = yes
	ret
parchk0:push	ax
	push	bx
	push	cx
	push	dx
	mov	ax,word ptr prolog	; first two prolog chars
	or	ax,word ptr prolog+2	; next two
	test	ax,8080h		; parity bit set?
	jz	parchk7			; z = no
	mov	parmsk,7fh		; set parity mask for 7 bits
	cmp	badpflag,0		; said bad parity once this packet?
	jne	parchk7			; ne = yes
	mov	cx,4			; do all four protocol characters
	xor	dx,dx			; dl=even parity cntr, dh=odd parity
	mov	bx,offset prolog
parchk1:mov	al,[bx]			; get a char
	inc	bx			; point to next char
	or	al,al			; sense parity
	jpo	parchk2			; po = odd parity
	inc	dl			; count even parity
	jmp	short parchk3
parchk2:inc	dh			; count odd parity
parchk3:loop	parchk1			; do all four chars
	cmp	dl,4			; got four even parity chars?
	jne	parchk4			; ne = no
	mov	badpflag,parevn+80h	; say even parity and flagging bit
	mov	dx,offset msgbadpare	; say using even parity
	jmp	short parchk6
parchk4:cmp	dh,4			; got four odd parity chars?
	jne	parchk5			; ne = no
	mov	badpflag,parodd+80h	; say odd parity and flagging bit
	mov	dx,offset msgbadparo	; say using odd parity
	jmp	short parchk6
parchk5:mov	badpflag,parmrk+80h	; say mark parity and flagging bit
	mov	dx,offset msgbadparm	; say using mark parity
parchk6:call	ermsg1
	call	captdol			; write in log file too
parchk7:pop	dx
	pop	cx
	pop	bx
	pop	ax
	ret
parchk	endp

; General packet buffer structure manipulation routines. The packet buffers
; consist of a arrays of words, bufuse and buflist, an array of pktinfo
; structure packet descriptors, and a malloc'd main buffer.
; Each pktinfo member describes a packet by holding the address (seg:offset 
; within segment data) of the data field of a packet (datadr), the length of 
; that field in bytes (datsize), the number of bytes currently occupying that 
; field (datlen), the packet sequence number, an ack-done flag byte, and the 
; number of retries of the packet.
; The data field requires a null terminator byte in packet routines rpack and
; spack. Trans.windo buffers are constructed by procedure makebuf.
; Bufuse is an array holding an in-use flag for each pktinfo member; 0 means
; the member is free, otherwise a caller has allocated the member via getbuf.
; Buflist holds the address (offset in segment 'data') of each pktinfo member,
; for rapid list searching.
;
; Packet structures are constructed and initialized by procedure makebuf.
; Other procedures below access the members in various ways. Details of
; buffer construction should remain local to these routines.
; Generally, SI is used to point to a pktinfo member and AL holds a packet
; sequence number (0 - 63 binary). BX and CX are used for some status reports.
;
;  bufuse	buflist		    pktlist (group of pktinfo members)
;  -------	-------		-------------------------------------------
; 0 for unused		      | datadr,datlen,datsize,seqnum,ackdone,numtry |
; 	   	pointers to ->+ datadr,datlen,datsize,seqnum,ackdone,numtry |
; 1 for used		      | datadr,datlen,datsize,seqnum,ackdone,numtry |
;						etc
;
; Construct new buffers, cleared, by computing the amount of DOS free memory,
; allocating as much as (window slots * desired packet length). When there
; is not enough memory shorten the packet length to yield the desired number
; of window slots. 
; This is called two ways: a protocol initialization stage with one normal
; length packet and a post negotiation stage with a stated length of packet.
; The first state finds the maximum available memory for packet buffers as
; well as allocating one regular packet from it. The second stage always
; follows spar() and that routine needs the maximum memory figure.
; Enter with trans.windo equal to the number of buffer slots and CX equal
; to the length of each buffer (we add one byte for null terminator here).
; Return word maxbufparas as number of paragraphs in free memory before
; allocations are done here.
makebuf	proc	far
	push	ax
	push	bx
	push	cx
	push	dx
	push	si
	push	di
	mov	ax,pbufseg		; current buffer segment
	or	ax,ax			; segment allocated already?
	jz	makebu1			; z = no
	push	es
	mov	es,ax			; allocated segment
	mov	ah,freemem		; free it
	int	dos
	pop	es
makebu1:mov	bx,0ffffh		; allocate biggest chunk of memory
	mov	ah,alloc
	int	dos			; must fail, bx gets number paras free
	mov	maxbufparas,bx		; report max paragraphs available
	mov	al,trans.windo		; number of window slots
	xor	ah,ah
	or	ax,ax			; zero?
	jnz	makebu2			; nz = no
	inc	ax
	mov	trans.windo,al		; zero means one slot
makebu2:add	cx,15			; round, space for null at end of pkt
	and	cx,0fff0h		; and truncate
	mul	cx			; times pkt size per window slot
	mov	cx,4
makebu3:shr	dx,1			; divide double word by 16, to paras
	rcr	ax,1
	loop	makebu3			; ax gets paragraphs wanted
	cmp	ax,bx			; wanted versus available
	jae	makebu4			; ae = want more than available
	mov	bx,ax			; set bx to qty paragraphs wanted
makebu4:mov	cx,bx			; remember desired paragraphs
	mov	ah,alloc		; allocate a memory block
	int	dos
	mov	pbufseg,ax		; seg of memory area
	mov	ax,bx			; number paragraphs allocated
	mov	cl,trans.windo		; number of window slots
	xor	ch,ch
	mov	bufnum,cx		; number of buffers = window slots
	cmp	cx,1			; just one window slot?
	je	makebu5			; e = yes, save division
	xor	dx,dx
	div	cx			; paras per window slot to ax
makebu5:mov	dx,ax			; keep paragraphs per buffer in dx
	mov	di,ax			; paragraphs per buffer
	mov	cl,4
	shl	di,cl			; bytes per buffer (9040 max)
	mov	cx,bufnum		; number of buffers wanted
	mov	ax,pbufseg		; seg where buffer starts
	mov	si,offset pktlist	; where pktinfo group starts
	xor	bx,bx			; index (words)
makebu6:mov	bufuse[bx],0		; say buffer slot is not used yet
	mov	buflist[bx],si		; pointer to pktinfo member
	mov	word ptr [si].datadr,0	 ; offset of data field
	mov	word ptr [si].datadr+2,ax ; segment of data field
	mov	[si].datsize,di		; data buffer size, bytes
	mov	[si].numtry,0		; clear number tries for this buffer
	mov	[si].ackdone,0		; not acked yet
	mov	[si].seqnum,0		; a dummy sequence number
	add	si,size pktinfo		; next pktinfo member
	add	ax,dx			; pointer to next buffer segment
	add	bx,2			; next buflist slot
	loop	makebu6			; make another structure member
	mov	windused,0		; no slots used yet
	mov	winusedmax,0		; max slots used
	clc				; success
	pop	di
	pop	si
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	ret
makebuf	endp

; Allocate a buffer. Return carry clear and SI pointing at fresh pktinfo
; structure, or if failure return carry set and all regs preserved.
getbuf	proc	far
	push	ax
	push	cx
	push	si
	xor	si,si			; index
	mov	cx,bufnum		; number of buffers
	jcxz	getbuf2			; 0 means none, error
getbuf1:cmp	bufuse[si],0		; is this slot in use?
	je	getbuf3			; e = no, grab it
	add	si,2			; try next slot
	loop	getbuf1			; fall through on no free buffers
getbuf2:pop	si			; get here if all are in use
	pop	cx
	pop	ax
	stc				; return failure, si preserved
	ret

getbuf3:mov	bufuse[si],1		; mark buffer as being in use
	inc	windused		; one more slot in use
	mov	si,buflist[si]		; address of pktinfo member
	mov	al,pktnum		; next sequence number to be used
	mov	[si].seqnum,al		; use it as sequence number
	mov	[si].datlen,0		; no data in packet
	mov	[si].numtry,0		; clear number tries for this buffer
	mov	[si].ackdone,0		; not acked yet
	pop	cx			; discard originally saved si
	pop	cx
	pop	ax
	clc				; return success, buffer ptr in si
	ret
getbuf	endp

; Release all buffers (marks them as free, releases buffer memory).

bufclr	proc	far
	push	ax
	push	cx
	push	di
	push	es
	push	ds
	pop	es
	mov	cx,maxwind		; max number of buffers
	xor	ax,ax
	mov	di,offset bufuse	; buffer in-use list
	cld
	rep	stosw			; store zeros to clear the buffers
	mov	windused,0		; number now used (none)
	mov	ax,pbufseg		; segment of memory
	mov	es,ax			; es = segment affected
	mov	ah,freemem		; free it
	int	dos
	xor	ax,ax
	mov	pbufseg,ax		; say no buffer segment
	pop	es
	pop	di
	pop	cx
	pop	ax
	ret
bufclr	endp

; Release buffer whose pktinfo pointer is in SI.
; Return carry clear if success, or carry set if failure.
bufrel	proc	far
	push	bx
	push	cx
	mov	cx,bufnum		; number of buffers
	xor	bx,bx
bufrel1:cmp	buflist[bx],si		; compare addresses, match?
	je	bufrel2			; e = yes, found it
	add	bx,2
	loop	bufrel1
	pop	cx
	pop	bx
	stc				; no such buffer
	ret
bufrel2:mov	bufuse[bx],0		; say buffer is no longer in use
	dec	windused		; one less used buffer
	pop	cx
	pop	bx
	clc
	ret
bufrel	endp

; Returns in BX the "packet pointer" for the buffer with the same seqnum as
; provided in AL. Returns carry set if no match found. Modifies BX.
pakptr	proc	far
	push	cx
	push	di
	mov	cx,bufnum		; number of buffers
	xor	di,di			; buffer index for tests
pakptr1:cmp	bufuse[di],0		; is buffer vacant?
	je	pakptr2			; e = yes, ignore
	mov	bx,buflist[di]		; bx = address of pktinfo member
	cmp	al,[bx].seqnum		; is this the desired sequence number?
	je	pakptr3			; e = yes
pakptr2:add	di,2			; next buffer index
	loop	pakptr1			; do next test
	xor	bx,bx			; say no pointer
	stc				; set carry for failure
	pop	di
	pop	cx
	ret
pakptr3:clc				; success, BX has buffer pointer
	pop	di
	pop	cx
	ret
pakptr	endp

; Returns in AH count of packets with a given sequence number supplied in AL
; and returns in BX the packet pointer of the last matching entry.
; Used to detect duplicated packets.
pakdup	proc	far
	push	cx
	push	dx
	push	di
	mov	cx,bufnum		; number of buffers
	xor	di,di			; buffer index for tests
	xor	ah,ah			; number of pkts with seqnum in al
	mov	dx,-1			; a bad pointer
pakdup1:cmp	bufuse[di],0		; is buffer vacant?
	je	pakdup2			; e = yes, ignore
	mov	bx,buflist[di]		; bx = address of pktinfo member
	cmp	al,[bx].seqnum		; is this the desired sequence number?
	jne	pakdup2			; ne = no
	mov	dx,bx			; yes, remember last pointer
	inc	ah			; count a found packet
pakdup2:add	di,2			; next buffer index
	loop	pakdup1			; do next test
	mov	bx,dx			; return last matching member's ptr
	pop	di
	pop	dx
	pop	cx
	or	ah,ah			; any found?
	jz	pakdup3			; z = no
	clc				; return success
	ret
pakdup3:stc				; return failure
	ret
pakdup	endp
	
; Find sequence number of first free window slot and return it in AL,
; Return carry set and al = windlow if window is full (no free slots).
firstfree proc	far
	mov	al,windlow		; start looking at windlow
	mov	ah,al
	add	ah,trans.windo
	and	ah,3fh			; ah = 1+top window seq number, mod 64
firstf1:push	bx
	call	pakptr			; buffer in use for seqnum in AL?
	pop	bx
	jc	firstf2			; c = no, seq number in not in use
	inc	al			; next sequence number
	and	al,3fh			; modulo 64
	cmp	al,ah			; done all yet?
	jne	firstf1			; ne = no, do more
	mov	al,windlow		; a safety measure
	stc				; carry set to say no free slots
	ret
firstf2:clc				; success, al has first free seqnum
	ret
firstfree endp

; Check sequence number for lying in the current or previous window or
; outside either window.
; Enter with sequence number of received packet in [si].seqnum.
; Returns:
;	carry clear and cx =  0 if [si].seqnum is within the current window,
;	carry set   and cx = -1 if [si].seqnum is inside previous window,
;	carry set   and cx = +1 if [si].seqnum is outside any window.
chkwind	proc	far
	mov	ch,[si].seqnum		; current packet sequence number
	mov	cl,trans.windo		; number of window slots
	sub	ch,windlow		; ch = distance from windlow
	jc	chkwin1			; c = negative result
	cmp	ch,cl			; span greater than # window slots?
	jb	chkwinz			; b = no, in current window
	sub	ch,64			; distance measured the other way
	neg	ch
	cmp	ch,cl			; more than window size?
	ja	chkwinp			; a = yes, outside any window
	jmp	short chkwinm		; else in previous window

					; sequence number less than windlow
chkwin1:neg	ch			; distance, positive, cl >= ch
	cmp	ch,cl			; more than window size?
	ja	chkwin2			; a = yes, maybe this window
	jmp	short chkwinm		; no, in previous window

chkwin2:sub	ch,64			; distance measured the other way
	neg	ch
	cmp	ch,cl			; greater than window size?
	jb	chkwinz			; b = no, in current window
					; else outside any window

chkwinp:mov	cx,1			; outside any window
	stc				; carry set for outside current window
	ret
chkwinz:xor	cx,cx			; inside current window
	clc				; carry clear, inside current window
	ret
chkwinm:mov	cx,-1			; in previous window
	stc				; carry set for outside current window
	ret
chkwind	endp

code1	ends
	end