.title	KRTPAK	Packet driver
	.ident	"V03.62"

; /62/	27-Jul-93  Billy Youdelman
;
;	move erbfsiz to KRTMAC
;	patch PRINTM to also write to a logfile, when same is in use
;	add logfile error handler and provide for logfile errors
;	write error messages to logfile
;	include file spec in getnxt error messages
;	add individual packet exchange duration timer, for debugging
;	make BUFFIL limit test max-0 (was max-4), allows bigger packets
;	don't log bogus data for timout
;	make ERROR send an error packet, use PRINTM elsewhere
;	don't modify SET time_out value
;	add/enforce SET SEND PACKET_LEN limit
;	move bufpak to KRTSER, no one else uses it
;	move buffil to KRTSEN, ditto..
;	move bufemp to KRTREC
;	add passed buffer length to rpack$

; /BBS/	 1-Dec-91  Billy Youdelman  V03.61
;
;	added lun.ld == 12 for TSX logical disk support
;	added lun.at == 5 for file attributes support
;	prefixing error messages with the prompt string moved to KRTERR
;	waitsoh - ^Z abort changed to ^C abort, thus not killing the pgm
;
;	spack$ packet length test fixed to determine the true length of
;	a packet near or equal to 94 bytes when long packets are used.
;	it was possible to generate a "normal" packet with an out-of-
;	range LENGTH character (using all eight bits) when reaching the
;	the EOF produced a last packet in a long packet series close to
;	94 bytes, as the routine filling the packet data input buffer
;	is still looking for enough to make a long packet, with no
;	consideration for the added SEQ and TYP bytes nor the checksum
;	size (up to three more bytes with CRC block checking)..
;
;	rpakst patched to hose link device whenever the "T" (time_out)
;	packet count is incremented, or when a NAK xxx NAK series
;	(indicating resonating packets) occurs.  this is very helpful
;	when telephone line noise crashes/hangs the handler..
;
;	space padding between elements of an error message moved from
;	error: to the err msgs themselves as printm doesn't do it, and
;	it's too confusing otherwise..
;
;	patched to compensate for crossing midnight, as long as
;	there's less than 24 hours between calls to it, thus 32-bit
;	time data from incsta are thought to be sufficient here
;	note: the display routine in krtsho limits max to 18.2 hours..
;
;	patched bufemp to not output the lead-in char to TT under TSX
;
;	moved RPACK debug stuff to rawio: as when it was in rpakrd: it
;	missed the SOH, which is handled by waitsoh: (both call rawio)..
;	also cleaned up display at the EOL and added display of TIMOUTs
;
;	fixed non-init'd repeat count reg bug in bufunpack

;	Brian Nelson	30-Nov-83  10:20:09
;	13-Oct-84  14:01:32  BDN	moved SENDSW and RECSW out
;
;	Change Software, Toledo, Ohio
;	University of Toledo, Toledo, Ohio


;				 PACKET FORMAT
;
; The KERMIT protocol is built around exchange of packets of this format:
;
;    +------+-----------+-----------+------+- ~ ---- ~ -+-------+-----+
;    | MARK | char(LEN) | char(SEQ) | TYPE |    DATA    | CHECK | EOL |
;    +------+-----------+-----------+------+- ~ ---- ~ -+-------+-----+
;
; where all fields consist of ASCII characters.  The fields are:
;
; MARK  The synchronization character that marks the beginning of the packet.
;      This is normally ^A, but may be redefined.
;
; LEN  The  number  of  ASCII  characters  within  the packet that follow this
;      field, in other words the packet length minus two.  Since  this  number
;      is  transformed  to  a single character via the char() function, packet
;      character  counts  of  0. to 94. are permitted, and  96. is the maximum
;      total packet length.  The length doesn't include end-of-line or padding
;      characters, which are outside  the  packet  and  are  strictly  for the
;      benefit of the operating system,  but  it  does include the block check
;      characters.
;
; SEQ  The packet sequence number modulo 64., ranging from 0. to 63.  Sequence
;      numbers "wrap around" to 0. after each group of 64. packets.
;
; TYPE  The packet type, a single ASCII character.  The following packet types
;      are required:
;
;	 B   Break transmission (EOT)
;	 D   Data packet
;	 E   Error
;	 F   File header
;	 N   Negative acknowledge (NAK)
;	 S   Send initiate (exchange parameters)
;	 Y   Acknowledge (ACK)
;	 Z   End of file (EOF)
;
; DATA  The contents of the packet,  if any contents are required in the given
;      type of packet, interpreted according to  the  packet  type.    Control
;      characters  are  preceded  by a special prefix character, normally "#",
;      and "uncontrollified" via ctl().  A prefixed sequence may not be broken
;      across packets.  Logical records in printable files are delimited  with
;      CR/LFs, suitably prefixed (e.g. "#M#J").  Any prefix characters are in-
;      cluded in the count.  Optional encoding for  8-bit  data  and  repeated
;      characters is also available.
;
; CHECK  A block check on characters in the packet between,  but not including
;      ing, the mark and the block check itself.  The check for each packet is
;      computed by both hosts,  and  must agree if a packet is to be accepted.
;      A single-character arithmetic checksum is the normal and required block
;      check.   Only  six  bits  of the arithmetic sum are included.  In order
;      that all the bits of each data character contribute to  this  quantity,
;      bits  6  and  7  of the final value are added to the quantity formed by
;      bits 0-5.  Thus if s is the arithmetic sum  of  the  ASCII  characters,
;      then
;
;	    check = char((s + ((s & 192.)/64.)) & 63.)
;
;      This  is  the  default  block check, and all Kermits must be capable of
;      performing it.  Other optional block check types are also defined.  The
;      block check  is  based  on  the  ASCII  values of the characters in the
;      packet.    Non-ASCII  systems must translate to ASCII before performing
;      the block check calculation.
;
; EOL  The End Of Line character, normally a carriage return, marks the end of
;      the packet.  This particular implementation (Kermit-11) uses the packet
;      length and ignores the EOL char other than displaying it when debugging
;      to the terminal.


	.include "IN:KRTMAC.MAC"
	.iif ndf  KRTINC  .error	<; .include for IN:KRTMAC.MAC failed>
	.include "IN:KRTDEF.MAC"
	.iif ndf  MSG$DA  .error	<; .include for IN:KRTDEF.MAC failed>

	.mcall	.CLOSE	,.GTIM	,.PURGE	; /62/


	; Misc defaults
	BADCHK	==	377		; pseudo packet type for bad checksum
	DEFCHK	==	'1		; default block_check_type
	DEFDLY	==	6		; delay before starting to send a file
	IN$TRY	==	5		; /BBS/ number of times to retry init
	MX$TRY	==	20		; number of times to retry packet
	MYCHKT	==	defchk		; normal checksumming
	MYEOL	==	cr		; end-of-line
	MYQUOTE	==	'#		; control char quoting prefix char
	MYPAD	==	0		; no padding
	MYPCHAR	==	0		; thus no pad character
	MYQBIN	==	'&		; 8-bit quoting prefix char
	MYREPT	==	176		; tilde for repeat things
	MYRTMO	==	10.		; /62/ RECEIVE default time_out
	MYSTMO	==	13.		; /62/ SEND default time_out
	TIMOUT	==	'T&137		; pseudo packet type for time_out


	.sbttl	Local and some global data

	.psect	$pdata			; /62/ MUST be non-swapping, root/APR1
aspace::.byte	40 ,0			; /62/ consolidated all this here..
null::	.byte	 0 ,0
e$par:	.asciz	", parity is possibly being introduced"
e$retr:	.asciz	"Retry limit reached"
e$sync:	.asciz	"Packet serial numbers are out of sync"
M1$:	.asciz	"Kermit: "
R20$:	.asciz	"<<< RPACK - "
R22$:	.asciz	"<TIMOUT>"
RP2$:	.asciz	"BAD Checksum: RCV,CALC = "
RW1$:	.asciz	"<SOH>"
RW2$:	.ascii	"<EOL>"
RX2$:	.asciz	<cr><lf>
S2$:	.asciz	">>> SPACK - "
	.even


	.psect	$code			; /38/ 06-Nov-85 11:22:14 BDN
	.sbttl	Decide where to get the next character

;	G E T C R 0
;	T G E T C R
;
;	Passed:	  r0	= lun
;	Return:	  r0	= if <>, error code (generally er$eof)
;		  r1	= character just read
;
;	GETCR0  is  the lowest level entry point called in Kermit to
;	obtain the next character for a  send  function  (even  GETC
;	calls  it),  where  that  may  be a normal file transfer, or
;	a server extended response.  The main idea in altering it is
;	so   that   a   server   dispatch  routine  can  change  the
;	default  (get from a file)  to,  say,  get  from  an  .asciz
;	string   in   memory   or  switch  to  some  other  kind  of
;	get_next_character routine.  This requires that  the service
;	routine  insert  its  get_next_char routine address into the
;	global  GETCROUTINE  and  also  reset  it when the action is
;	complete (by use of the textsrc macro sans an argument).

getcr0::tst	getcroutine		; /38/ is there a routine address set?
	bne	10$			; /38/ yes
	call	fgetcr0			; /38/ no, default to file reading
	br	100$
10$:	call	@getcroutine		; /38/ call currently defined routine
100$:	return

tgetcr::tst	tgetaddr		; /38/ have we ever been initted?
	beq	90$			; /38/ no, return er$eof
	movb	@tgetaddr,r1		; /38/ yes, get next character please
	beq	90$			; /38/ nothing is left to do
	inc	tgetaddr		; /38/ text_address++
	clr	r0			; /38/ return(no_error)
	br	100$
90$:	mov	#er$eof	,r0		; /38/ return(end_of_file)
	clr	getcroutine		; /62/ reset to file reading please
100$:	return


	.sbttl	Get next file to send

;	G E T N X T
;
;	input:	srcnam	= possibly wildcarded file name
;		index	= 0 if this is the first time through
;	output:	filnam	= next file to do
;		 r0	= if <>, error code

getnxt::save	<r1>
	calls	lookup	,<#srcnam,#filnam> ; /62/
	tst	r0			; did it work?
	beq	100$			; yes
	cmp	r0	,#er$nmf	; no more files matching name?
	beq	20$			; yes, we are all done then
	cmp	r0	,#er$fnf	; how about file not found?
	bne	30$			; no, print the error message out
20$:	tst	index			; ya, but did any files match yet?
	bne	100$			; yes, that's ok then
	mov	#er$fnf	,r0		; no, convert er$nmf to er$fnf
30$:	mov	r0	,-(sp)		; save lookup error
	calls	syserr	,<r0,#errtxt>	; get the error text
	calls	error	,<#3,#errtxt,#aspace,#filnam> ; /62/ include file name
	.purge	#lun.sr			; /62/ dump search channel
	mov	(sp)+	,r0		; restore saved error code from lookup
100$:	unsave	<r1>
	return


	.sbttl	Read incoming packet

;	R P A C K $
;
;	input:	  (r5)	= packet buffer address
;		 4(r5)	= packet buffer length
;	output:	 2(r5)	= 3 word data structure returns length, number, type

	O$LEN	=  0		; offset for returned packet length
	O$SEQ	=  2		; packet number
	O$TYP	=  4		; packet type

	; /62/	local data allocated on the stack, offsets from r4 
	.TYP	=  0		; packet type
	.CCHECK	=  2		; computed checksum
	.RCHECK	=  4		; received checksum
	.LEN	=  6		; received packet length
	.TIMEO	= 10		; read time_out
	.SEQ	= 12		; received packet number
	.SIZE	= 14		; current size of data portion
	.TOGO	= 26		; loop count control for data portion
	.HDTYPE	= 20		; /62/ header type
	.CBUFF	= 22		; /62/ checksum buffer address
	.LSIZE	= 24		; total size of the above local data

;	internal register usage:
;	r0	= scratch register
;	r1	= current character just read from remote
;	r2	= pointer to packet buffer
;	r3	= pointer to temp buffer containing the packet less the SOH
;		  and the checksum, for computing checksum after the packet
;		  has been read
;	r4	= pointer to local data on stack, as defined above
;	r5	= pointer to argument list

rpack$::call	dcdtst			; /62/ check DCD, report any change..
	save	<r1,r2,r3,r4>
	clr	recbit			; /43/ clear bit sum out
	sub	#.lsize	,sp		; allocate space for local data
	mov	sp	,r4		; and point to it please
	sub	#$allsiz,sp		; /42/ allocate a HUGE buffer
	call	waitsoh			; wait for a packet to start
	tst	r0			; did it work or did we time out?
	beq	5$			; yes it worked
	jmp	95$			; we must have timed out then

5$:	mov	sp	,r3		; the packet less SOH and checksum
	mov	sp	,.cbuff(r4)	; /42/ save start address
	call	rpakin			; initialize things
	call	rpakrd			; read the next character from
	bcs	95$			; packet reader's buffer
	bisb	r1	,recbit		; /43/ so we can determine parity set
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; if the character is senders SOH
	beq	5$			; /62/ then we have to restart, else
	movb	r1	,(r3)+		; *checkpacket++ = ch
	unchar	r1	,r0		; get the length packet next please
	mov	r0	,.hdtype(r4)	; /42/ save header type
	cmp	r0	,#2		; /42/ if the length is 0,1 or 2 then
	ble	15$			; /42/ an extended header instead
	sub	#2	,r0		; this is NOT an extended header so we
	sub	chksiz	,r0		; will check to see if the packet can
	bge	15$			; hold at least SEQ+TYPE+CHECK
	clr	r0			; /44/ couldn't, "fix" bad length
15$:	mov	r0	,.len(r4)	; stuff the packet length

	call	rpakrd			; as before, ask for the next char
	bcs	95$			; and take an error exit if need be
	bisb	r1	,recbit		; /43/ so we can determine parity set
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; if this is the sender's start_of_pak
	beq	5$			; /62/ it's time to restart the loop
	movb	r1	,(r3)+		; insert the sequence number into the
	unchar	r1	,.seq(r4)	; checksum packet and save the SEQ

	call	rpakrd			; read the TYPE field next, exiting
	bcs	95$			; on a read error, of course
	bisb	r1	,recbit		; /43/ so we can determine parity set
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; as always, if we find the sender's
	beq	5$			; /62/ start_of_packet, then restart
	movb	r1	,(r3)+		; save TYPE field into the checksum
	mov	r1	,.typ(r4)	; and also into the field for return

	tst	.hdtype(r4)		; /42/ NOW check for extended header
	bne	19$			; /42/ not extended header
	call	rdexhd			; /42/ ReaD EXtended HeaDer
	tst	r0			; /42/ did this work ok?
	bgt	5$			; /62/ no, got a resync
	bmi	96$			; /42/ no, time_out or checksum error

19$:	mov	.len(r4),.togo(r4)	; loop for the data, if any
	cmp	.togo(r4),4(r5)		; /62/ ensure we don't overwrite buff
	blos	190$			; /62/ received length is ok
	mov	4(r5)	,.togo(r4)	; /62/ bad length, do max possible..
190$:	mov	@r5	,r2		; point to the buffer now

20$:	tst	.togo(r4)		;   for i := 1 to len do
	beq	30$			;    begin
	call	rpakrd			;     read(input,ch)
	bcs	95$			;     exit if error
	tst	parity			; /62/ parity set to none?
	bne	21$			; /62/ no, must be some other type
	tst	image			; /62/ no parity, image mode today?
	bne	23$			; /62/ yes, leave things alone please
21$:	bic	#^c177	,r1		; /62/ ch := ch and chr(177b)
23$:	cmpb	r1	,recsop		;     if ch = SOH
	beq	5$			; /62/  then resync
	cmp	.size(r4),#maxlng	;     if currentsize < maxpaksize
	bhis	25$			;       then
	movb	r1	,(r2)+		;         data[i]  := ch
	movb	r1	,(r3)+		;         checkpacket++ := ch
					;	end
25$:	inc	.size(r4)		;     currentsize:=succ(currentsize)
	dec	.togo(r4)		;    nchar_left := nchar_left-1
	br	20$			;    end

30$:	clrb	@r2			;   data[len] := null
	clrb	@r3			;   checkpacket++ := null
	mov	sp	,r3		;   reset base address of checkpacket
	call	rpakck			;   read the checksum now
	bcs	95$			;   exit on error or time_out
	call	rpakfi			; /62/ finish the checksum
	br	100$

95$:	mov	2(r5)	,r1		; time_out error, flag no packet
	mov	#timout	,o$typ(r1)	; return as pseudo packet type
	mov	#timout	,.typ(r4)	; ditto for rpakst
	clr	o$len(r1)		; /62/ time_out has no length
	clr	.len(r4)		; /62/ don't log bogus data either
	clr	.seq(r4)		; /62/ time_out has no packet number
96$:	call	rpakst			; do stats and disk dumping now

100$:	add	#.lsize+$allsiz,sp	; /42/ pop local buffers
	unsave	<r4,r3,r2,r1>
	return


	.sbttl	RPACK$ wait for a start of packet char (SOH)

;	W A I T S O H
;
;	output:	  r0	= if <>, error code
;		  r1	= the SOH or a null if we timed out

; /BBS/	^Z exit changed to ^C abort (requires two successive ^Cs)

waitsoh:clr	r1			; start with nothing
	clr	-(sp)			; /56/ hold virgin copy of data
	mov	#2	,-(sp)		; /BBS/ counter for ^C's
10$:	cmpb	r1	,recsop		; wait for a packet header please
	beq	40$			; got one, exit
	mov	sertim	,r0		; /62/ if waiting for server command
	bne	11$			; /62/ then use that time_out
	movb	senpar+p.time,r0	; /62/ else use "normal" time_out
11$:	calls	binrea	,<r0>		; read with time_out
	tst	r0			; did the read work?
	bne	30$			; oops, just exit then
	mov	r1	,2(sp)		; /56/ save it
	bic	#^c177	,r1		; /44/ never want parity here
	cmpb	r1	,#'C&37		; /BBS/ ^C returned?
	bne	15$			; /41/ no
	dec	(sp)			; /44/ should we really exit now?
	bne	20$			; /44/ no, in case we got some noise
	mov	cc$max	,cccnt		; /BBS/ force abort thru cptln routine
	mov	sp	,ccflag		; /BBS/ else .spcps will bomb..
	mov	#er$nin	,r0		; /BBS/ a fake time_out until
	br	30$			; /BBS/ the ccast hits (15. ticks max)
15$:	mov	#2	,(sp)		; /BBS/ need TWO ^C's in a row to exit
20$:	call	rawio			; all's not well, perhaps dump packets
	br	10$			; loop back for finding a packet start
30$:	clr	r1			; time_out, return a null
	br	100$			; /56/
40$:	tstb	2(sp)			; /62/ parity perhaps?
	bpl	100$			; /62/ no
	tst	parity			; /BBS/ 8-bit channel?
	bne	100$			; /56/ no
	tst	incpar			; /62/ warning already done?
	bne	100$			; /62/ ya, avoid rollover to zero..
	inc	incpar			; /56/ ya, also want message only once
100$:	cmp	(sp)+	,(sp)+		; /BBS/ pop ^C counter, data buffer
	return


	.sbttl	RPACK$ initialization

rpakin:	mov	r4	,r0		; /62/ copy local buffer pointer
	mov	#11	,r1		; /62/ need to clear this many words
10$:	clr	(r0)+			; /62/ do it
	sob	r1	,10$		; /62/ one word at a time
	bisb	senpar+p.time,.timeo(r4) ; /62/ time_out := SET TIME_OUT value
	mov	2(r5)	,r0
	clr	(r0)+			; packet.length := 0
	clr	(r0)+			; packet.number := 0
	clr	(r0)+			; packet.type   := 0
	return


	.sbttl	RPACK$ read with time_out

rpakrd:	calls	binrea	,<.timeo(r4)>	; read input char
	tst	r0			; did it work?
	bne	110$			; no
	call	rawio			; perhaps raw I/O logging
	clr	r0			; no errors, also clears carry
	return
110$:	sec				; flag the time_out
	return


	.sbttl	RPACK$ extended header type 0 for long packets

rdexhd:	mov	r2	,-(sp)		; /42/ added 08-Jan-86 Brian Nelson
	mov	r5	,-(sp)		; need an odd register for mul
	call	rpakrd			; extended header, read the lenx1
	bcs	90$			; field, exiting on read errors
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; exit if we find the senders
	beq	80$			; start_of_header please
	movb	r1	,(r3)+		; save into checksum buffer
	unchar	r1	,r5		; get the high order of length
	mul	#95.	,r5		; shift over please
	call	rpakrd			; extended header, read the lenx2
	bcs	90$			; field, exiting on read errors
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; exit if we find the senders
	beq	80$			; start_of_header please
	movb	r1	,(r3)+		; save into checksum buffer
	unchar	r1	,r1		; get the next one
	add	r1	,r5		; now we have the extended length
	sub	chksiz	,r5		; drop it by checksum size
	mov	r5	,.len(r4)	; save it here, of course

	mov	.cbuff(r4),r5		; now, at last, get the extended
	mov	#5	,r1		; header checksum data
	clr	-(sp)			; accumulate in stack
10$:	clr	r0			; use the normal safe way to add
	bisb	(r5)+	,r0		; bytes even though we know that
	add	r0	,(sp)		; no sign extends will happen
	sob	r1	,10$		; next please
	mov	(sp)+	,r0		; pop the checksum please
	mov	r0	,r2		; save it
	bic	#^c300	,r2		; compute it as in:
	ash	#-6	,r2		; chk=char((s+((s&0300)/0100))&77)
	add	r0	,r2
	bic	#^c77	,r2		; got it now

	call	rpakrd			; extended header - read the hcheck
	bcs	90$			; field, exiting on read errors
	bic	#^c177	,r1		; ensure parity is cleared out
	cmpb	r1	,recsop		; exit if we find the senders
	beq	80$			; start_of_header please
	movb	r1	,(r3)+		; save into checksum buffer
	unchar	r1	,r1		; convert to actual checksum now
	cmpb	r1	,r2		; do the checksums match?
	bne	85$			; no, exit with such set please
	clr	r0			; it worked, exit normally
	br	100$

80$:	mov	#1	,r0		; resync time
	br	100$

85$:	mov	#badchk	,r0		; header checksum error
	br	95$			; stuff the error
90$:	mov	#timout	,r0		; return time_out error
	clr	.len(r4)		; /62/ don't log bogus data on timout
95$:	mov	2(sp)	,r5		; /BBS/ restore r5 to as entering
	mov	2(r5)	,r1		; get address of result block
	clr	o$len(r1)		; clear packet length
	mov	r0	,o$typ(r1)	; return the error
	mov	r0	,.typ(r4)	; here also please
	mov	#-1	,r0		; fatal error
100$:	mov	(sp)+	,r5
	mov	(sp)+	,r2
	return


	.sbttl	RPACK$ get and convert the checksum

rpakck:	save	<r3>			; use r3 for accumulating check
	clr	r3			; assume zero for now
	call	rpakrd			; read(input,ch)
	bcs	110$			; exit if timed out
	bisb	r1	,recbit		; recbit |= ch
	bic	#^c177	,r1		; ch := ch and 177b
	unchar	r1	,r3		; received_check := ch
	cmpb	chktyp	,#defchk	; if len(checksum) > 8 bits
	blos	10$			;  then begin
	 ash	#6	,r3		;   check := check * 64
	 call	rpakrd			;   read(input,ch)
	 bcs	110$			;   exit if timed out
	 bic	#^c177	,r1		;   ch := ch and 177b
	 unchar	r1	,r1		;   ch := unchar(ch)
	 bisb	r1	,r3		;   rcheck := rcheck + ch
	 cmpb	chktyp	,#'3		;   if checktype = crc16
	 bne	10$			;    then
	 ash	#6	,r3		;     begin
	 call	rpakrd			;      check := check * 64
	 bcs	110$			;      check := check + ch
	 bic	#^c177	,r1		;      ch := ch and 177b
	 unchar	r1	,r1
	 bisb	r1	,r3		;      end
10$:	clc
110$:	mov	r3	,.rcheck(r4)	; return the checksum
	unsave	<r3>
	return


	.sbttl	RPACK$ end of packet housekeeping

rpakfi:	mov	r3	,-(sp)		; compute correct checksum type
	call	checks			; simple
	mov	(sp)+	,.ccheck(r4)	; and stuff it in please
	cmpb	.ccheck(r4),.rcheck(r4)	; compare computed, actual checksums
	beq	10$			; they are the same
	mov	#badchk	,.typ(r4)	; they're different, flag the error
10$:	mov	2(r5)	,r1		; where to return some things
	mov	.len(r4),(r1)+		; /62/ O$LEN packet length
	mov	.seq(r4),(r1)+		; /62/ O$SEQ packet number
	mov	.typ(r4),(r1)		; /62/ O$TYP packet type
	call	rpakst			; do stats and logging now
	jmp	rpaklo			; /62/ possibly log checksum errors?


	.sbttl	RPACK$ statistics, logging, resonating packets fix

rpakst:	cmpb	.typ(r4),#'A&137	; count the packet types for stats
	blo	110$			; bad packet type
	cmpb	.typ(r4),#'Z&137	; must in the range A..Z
	bhi	110$			; definitely a bad packet

	; /BBS/ check for resonating packets or hung driver
	asr	nakrec			; shift prior tests down the line
	cmpb	.typ(r4),#'N&137	; a NAK?
	bne	55$			; nope..
	bis	#4	,nakrec		; ya, mark shift reg at 1st position
55$:	cmp	nakrec	,#4+1		; looking for NAK xxx NAK series as
	bge	67$			; when resonating, go clear it
	cmpb	.typ(r4),#timout	; timed out?
	bne	77$			; nope..
67$:	call	hose			; ya, try harder to make it go
	clr	nakrec			; start over after hose
	bit	#log$rp	,trace		; /BBS/ RPACK to TT?
	beq	77$			; /BBS/ no
	wrtall	#R22$			; /62/ ya, display time out

77$:	 movb	.typ(r4),r1		; packet is ok, add it to the stats
	 sub	#100	,r1		; convert to 1..26
	 asl	r1			; to word offsets
	 asl	r1			; /43/ double word offsets
	 add	#1	,pcnt.r+2(r1)	; /43/ 32-bit addition today
	 adc	pcnt.r+0(r1)		; /43/ the high order part of it
	 add	#1	,pcnt.r+2	; /43/ add it in here also
	 adc	pcnt.r+0		; /43/ high order part

110$:	bit	#log$rp	,trace		; /BBS/ RPACK to TT?
	beq	117$			; /BBS/ no
	.newline			; /BBS/ ya, format display
117$:	bit	#log$pa	,trace		; tracing today?
	bne	121$			; /BBS/ ya
	bit	#log$de	,trace		; /62/ TT debugging?
	beq	130$			; /BBS/ no
121$:	calls	dskdmp	,<#R20$,.seq(r4),.typ(r4),.len(r4),@r5> ; /62/
130$:	return


	.sbttl	RPACK$ packet logging

rpaklo:	cmp	.rcheck(r4),.ccheck(r4)	; checksums match?
	beq	110$			; /62/ yes, do nothing then
	save	<r0,r1>			; /62/
	mov	trace	,r0		; /62/ copy of debug status word
	bic	#^c<log$pa!log$de>,r0	; /62/ need to do this?
	beq	100$			; /62/ nope
	sub	#100	,sp		; /62/ ya, make buffer for err message
	mov	sp	,r1		; point to the buffer
	strcpy	r1	,#RP2$		; /62/ a header
	strlen	r1			; length so far
	add	r0	,r1		; point to the end of it
	deccvt	.rcheck(r4),r1		; convert to decimal
	add	#6	,r1		; move along please
	movb	#comma	,(r1)+		; /62/ insert delimiter
	deccvt	.ccheck(r4),r1		; the calculated checksum
	add	#6	,r1		; make it .asciz
	clrb	@r1			; simple
	mov	sp	,r1		; point back to the buffer
	bit	#log$pa	,trace		; /62/ is packet debugging on?
	beq	30$			; /62/ no
	strlen	r1			; ya, get the length
	calls	putrec	,<r1,r0,#lun.lo> ; dump buffer to disk
	tst	r0			; /62/ did it work?
	beq	30$			; /62/ ya
	call	logerr			; /62/ no, handle the error
30$:	tst	remote			; /62/ running locally?
	bne	40$			; /62/ no
	bit	#log$de	,trace		; /62/ ya, is terminal debugging on?
	beq	40$			; /62/ no
	wrtall	r1			; /62/ ya, print it
	.newline			; /62/
40$:	add	#100	,sp		; /62/ pop buffer
100$:	unsave	<r1,r0>			; /62/
110$:	return


	.sbttl	RPACK$ raw I/O logging, chars to RPACK debug display

rawio:	save	<r0,r1>
	bit	#log$io	,trace		; dumping all I/O today?
	beq	10$			; /BBS/ no
	save	<r1>
	clr	r0			; avoid sxt
	bisb	r1	,r0		; and setup call to putcr0
	mov	#lun.lo	,r1		; write to this channel
	call	putcr0			; simple
	tst	r0			; /62/ did it work?
	beq	1$			; /62/ ya
	call	logerr			; /62/ no, handle the error
1$:	unsave	<r1>			; /62/

10$:	bit	#log$rp	,trace		; /BBS/ dump to a local terminal?
	beq	100$			; no
	cmpb	r1	,recsop		; start of a packet?
	beq	20$			; yes
	cmpb	r1	,conpar+p.eol	; /BBS/ is this the end?
	bne	111$			; /BBS/ no
	wrtall	#RW2$			; /62/ no, finish up the display
	br	100$

111$:	tst	tsxsav			; /BBS/ running under TSX?
	beq	17$			; /BBS/ nope
	cmpb	r1	,m.tsxr		; /62/ ya, is this the TSLICH?
	beq	100$			; /BBS/ ya, don't type it to TT
17$:	movb	r1	,r0		; /BBS/ get a byte
	call	writ1char		; /BBS/ send it to TT
	br	100$

20$:	wrtall	#RW1$			; /62/ start of a packet
100$:	unsave	<r1,r0>
	return


	.sbttl	Send a packet

;	S P A C K $
;
;	input:	  (r5)	= type of packet
;		 2(r5)	= packet number
;		 4(r5)	= length of the data to send
;		 6(r5)	= location of the data to send
;	output:	   r0	= error status

spack$::save	<r1,r2,r3,r4>
	call	dcdtst			; /62/ check DCD, report any change..
	tstb	handch			; /62/ any particular handshake today?
	beq	1$			; no
	call	spakwa			; ya, do handshaking
1$:	call	spakin			; logging, padding, packet type stats
	sub	#$allsiz,sp		; /42/ allocate a LONG buffer
	mov	sp	,r4		; point to the buffer
	clr	-(sp)			; count the total length
	tst	prexon			; /53/ prefix all packets with an XON?
	beq	5$			; /53/ no
	movb	#xon	,(r4)+		; /53/ yes, insert one
	inc	@sp			; /53/ write_length++
5$:	setpar	sensop	,(r4)+		; start all packets with the SOH
	mov	r4	,r2		; get address for checksum compute
	inc	@sp			; packetlength := succ(packetlength)
	mov	4(r5)	,r0		; the length of the packet
	mov	#maxpak	,r1		; /BBS/ preset for compare
	cmp	senlng	,r1		; /BBS/ long packets this time?
	blos	7$			; /BBS/ nope..
	sub	chksiz	,r1		; /BBS/ ya, be sure checksum will fit
	sub	#2	,r1		; /BBS/ SEQ + TYP have to fit too..
7$:	cmp	r0	,r1		; /BBS/ packet too large?
	blos	15$			; no
	tst	senlng			; /42/ receiver said it can do long
	beq	10$			; /42/ packets?  if eq, no
					; /42/ otherwise build extended header
	mov	r2	,-(sp)		; /42/ save address of start of packet
	mov	#space	,-(sp)		; /42/ accumulate header checksum
	setpar	#space	,(r4)+		; /42/ length is a space, of course
	tochar	2(r5)	,r1		; /42/ packet sequence please
	add	r1	,(sp)		; /42/ add into header checksum now
	setpar	r1	,(r4)+		; /42/ insert it
	movb	(r5)	,r1		; /42/ the packet type is next
	bicb	#40	,r1		; /42/ ensure always upper case
	add	r1	,(sp)		; /42/ add in the checksum
	setpar	r1	,(r4)+		; /42/ and insert that also
	mov	r0	,r3		; /42/ insert the total packet size
	clr	r2			; /42/ first byte is size/95
	add	chksiz	,r3		; /42/ must include checksum size
	div	#95.	,r2		; /42/ second byte is size mod 95
	tochar	r2	,r2		; /42/ convert to character rep
	tochar	r3	,r3		; /42/ convert to character rep
	setpar	r2	,(r4)+		; /42/ insert high bits into packet
	add	r2	,(sp)		; /42/ add into checksum
	setpar	r3	,(r4)+		; /42/ insert low bits into packet
	add	r3	,(sp)		; /42/ add into checksum
	mov	(sp)+	,r0		; /42/ pop the checksum please
	mov	r0	,r2		; /42/ save it
	bic	#^c300	,r2		; /42/ compute it as in:
	ash	#-6	,r2		; /42/ checksum=
	add	r0	,r2		; /42/ char((s+((s&0300)/0100))&77)
	bic	#^c77	,r2		; /42/ got it now
	tochar	r2	,r2		; /42/ convert checksum to character
	setpar	r2	,(r4)+		; /42/ and insert into packet
	mov	(sp)+	,r2		; /42/ start checksum for rest here
	add	#7	,(sp)		; /BBS/ add, in case of prexon, above
	br	20$			; /42/ add off we go

10$:	mov	#maxpak-3,r0		; yes, reset packet size please
15$:	add	#2	,r0		; + two for number and type
	add	chksiz	,r0		; + the length of the checksum please
	clr	r1			; accumulated checksum
	tochar	r0	,r1		; start the checksum out right
	setpar	r1	,(r4)+		; and stuff length into the packet
	inc	@sp			; packetlength := succ(packetlength)
	tochar	2(r5)	,r0		; convert the packet number now
	setpar	r0	,(r4)+		; and stuff it into the packet
	inc	@sp			; packetlength := succ(packetlength)
	movb	@r5	,r0		; get the packet type now
	bicb	#40	,r0		; ensure UPPER CASE packet type
	setpar	r0	,(r4)+		; insert the packet type into buffer
	inc	@sp			; packetlength := succ(packetlength)

20$:	mov	4(r5)	,r1		; get the data length
	beq	40$			; nothing to do
	mov	6(r5)	,r3		; address of the data to send

30$:	clr	r0			; get the next character
	bisb	(r3)+	,r0		; next char
	setpar	r0	,(r4)+		; now move the data byte into the buff
	inc	@sp			; packetlength := succ(packetlength)
	sob	r1	,30$		; next please

40$:	clrb	@r4			; set .asciz for call to checks
	mov	r2	,-(sp)		; starting address for checksum field
	call	checks			; simple
	mov	(sp)+	,r2		; get the computed checksum now
	call	spakck			; stuff checksum into buffer now
	add	r0	,@sp		; and the length of the checksum
	setpar	conpar+p.eol,(r4)+	; end of line
	inc	@sp			; packetlength := succ(packetlength)
	mov	(sp)+	,r1		; packet length
	mov	sp	,r4		; address(buffer)
	calls	binwri	,<r4,r1>	; and dump the buffer out now
	call	spakfi			; log to disk
	add	#$allsiz,sp		; pop the buffer
	unsave	<r4,r3,r2,r1>
	return


	.sbttl	SPACK$ handshaking
	.enabl	lsb

spakwa:	scan	@r5	,#200$		; if packet type is in this list..
	tst	r0
	bne	100$			; ..then skip the handshaking stuff
	save	<r2>
	mov	4(r5)	,r2		; /62/ limit looping to packet length
	add	#14	,r2		; /62/ plus header, trailer, etc..
	movb	senpar+p.time,r0	; /62/ use "normal" time_out
10$:	calls	binrea	,<r0>		; /62/ wait for handshake char
	tst	r0			; did the read time out?
	bne	20$			; /62/ if so, exit
	bicb	#200	,r1		; ensure no parity is set
	cmpb	r1	,handch		; is this the handshake character?
	beq	20$			; /62/ ya
	sob	r2	,10$		; no, try again but not forever please
20$:	unsave	<r2>
100$:	return

	.save
	.psect	$pdata
200$:	.byte	msg$snd			; these packet types must NOT
	.byte	msg$ser			; be processed with handshaking
	.byte	msg$rcv
	.byte	msg$command
	.byte	msg$generic
	.byte	0
	.even
	.restore

	.dsabl	lsb


	.sbttl	SPACK$ logging, padding, packet type stats

spakin:	bit	#log$pa	,trace		; packet debugging today?
	bne	1$			; /BBS/ ya
	bit	#log$de	,trace		; /62/ no, maybe TT debugging?
	beq	5$			; /BBS/ no
1$:	calls	dskdmp	,<#S2$,2(r5),@r5,4(r5),6(r5)> ; /62/ ya

5$:	tst	pauset			; wait a moment?
	beq	6$			; no
	calls	suspend	,<pauset>	; yes
6$:	clr	r1			; avoid sign extension
	bisb	conpar+p.npad,r1	; send some pad characters?
	beq	20$			; no padding
	mov	#conpar+p.padc,r2	; /62/ address of the pad character
10$:	calls	binwri	,<r2,#1>	; send some padding
	sob	r1	,10$		; next please

20$:	movb	@r5	,r1		; the packet type next
	cmpb	r1	,#'A&137	; a legitimate packet type?
	blo	30$			; no
	cmpb	r1	,#'Z&137	; must be in the range A..Z
	bhi	30$			; no good
	 sub	#100	,r1		; convert into range 1..26
	 asl	r1			; and count the packet type
	 asl	r1			; /43/ 32. bits
	 add	#1	,pcnt.s+2(r1)	; /43/ 32. bits, pakcnt(type)++
	 adc	pcnt.s+0(r1)		; /43/ 32. bits, the high part
	 add	#1	,pcnt.s+2	; /43/ 32. bits now
	 adc	pcnt.s+0		; /43/ the high order part
30$:	return


	.sbttl	SPACK$ compute checksum

spakck:	clr	r0		; checksum.len := 0
	cmpb	chktyp	,#defchk ; if checklength > 6 bits
	blos	20$		;  then begin
	cmpb	chktyp	,#'3	;   if checktype = crc16
	bne	10$		;    then begin
	mov	r2	,r1	;     checkchar1:=tochar(check[12..15])
	 ash	#-14	,r1	;     shift over 12 bits
	 bic	#^c17	,r1	;     mask off the high 12  bits
	 tochar	r1	,@r4
	 setpar	@r4	,(r4)+
	 inc	r0		;     packetlength := succ(packetlength)
				;    end
10$:	 mov	r2	,r1	;   checkchar1 := tochar(check[6..11])
	 ash	#-6	,r1	;   shift over 6 bits
	 bic	#^c77	,r1	;   mask off the higher order bits
	 tochar	r1	,@r4
	 setpar	@r4	,(r4)+
	 inc	r0		;   packetlength := succ(packetlength)
	 bic	#^c77	,r2	;   now drop the high bits from checks

20$:	tochar	r2	,@r4	; convert char
	tst	ranerr		; insert random checksum errors?
	beq	40$		; no, please don't
	mov	r0	,-(sp)	;+ test mode  irand uses r0
	call	irand		;+ test mode  get a random number
	tst	r0		;+ test mode  is it zero?
	bne	30$		;+ test mode  no, leave things alone
	incb	@r4		;+ test mode  ya, create an error
30$:	mov	(sp)+	,r0	;+ test mode  restore r0
40$:	setpar	@r4	,(r4)+	; set parity, if in use..
	inc	r0		; packetlength := succ(packetlength)
	return


	.sbttl	SPACK$ pseudo random number generator for testing

irand:	tst	seed			; has a seed been set?
	bne	10$			; ya, use that value
	mov	#1234.	,seed		; no, use this default seed
10$:	mov	seed	,r0		; make a copy of it
	mov	r1	,-(sp)		; preserve r1
	mov	r0	,r1		; copy of seed number to
	ash	#-4	,r1		; multiply it * 16. and
	bic	#170000	,r1		; clear its bits 15. - 12. then
	xor	r1	,r0		; toggle whatever's left in orig seed
	ash	#13	,r1		; dump bits 11. thru 0.
	bic	#100000	,r1		; ensure what's left is a positive num
	xor	r1	,r0		; again, toggle the orig seed with it
	bic	#100000	,r0		; make sure result remains positive
	mov	r0	,seed		; save it for the next time around..
	ash	#-13	,r0		; shift so only 4 hi bits are output
	mov	(sp)+	,r1		; restore r1
	return


	.sbttl	SPACK$ log to disk

spakfi:	bit	#log$io	,trace		; dumping all I/O out?
	beq	230$			; no
	save	<r0,r1,r2,r4>
	mov	r1	,r2		; anything to do?
	beq	220$			; no
210$:	clr	r0			; yes, avoid sign extension
	bisb	(r4)+	,r0		; get the next ch to dump
	mov	#lun.lo	,r1		; the lun to write to
	call	putcr0			; simple
	tst	r0			; /62/ did it work?
	beq	213$			; /62/ ya
	call	logerr			; /62/ no, handle the error
	br	220$			; /62/ then bail out
213$:	sob	r2	,210$		; next please
220$:	unsave	<r4,r2,r1,r0>
230$:	return


	.sbttl	Compute checksum

;	C H E C K S
;
;	input:	  (sp)	= address of .asciz string to checksum
;	output:	  (sp)	= the computed checksum

checks:	save	<r0,r1,r2,r3>
	mov	10+2(sp),r2		; pointer to the string to check
	cmpb	chktyp	,#'3		; CRC-CCITT type today?
	bne	5$			; no
	strlen	r2			; yes, get the .asciz string length
	calls	crcclc	,<r2,r0>	; compute the crc16
	mov	r0	,r2		; stuff the result into r2 for later
	br	90$			; and exit

5$:	clr	r1			; init the checksum accumulator
10$:	clr	r3			; get the next ch please
	bisb	(r2)+	,r3		; got the next ch now
	beq	20$			; hit the end of the string
	tst	parity			; /BBS/ did the packet contain parity?
	beq	15$			; no, leave bit 7 alone
	bic	#^c177	,r3		; yes, please clear bit seven
15$:	bic	#170000	,r1		; /42/ ensure long packet not overflow
	add	r3	,r1		; check := check + ch
	br	10$

20$:	mov	r1	,r2		; checksum := ((checksum and 300B)/64)
	cmpb	chktyp	,#'2		; 12 bit sum type checksum?
	beq	30$			; yes, just exit
	bic	#^c300	,r2		; ((..+checksum) and 77b)
	ash	#-6	,r2
	add	r1	,r2
	bic	#^c77	,r2
	br	90$

30$:	bic	#170000	,r2		; type 2 checksum
90$:	mov	r2	,10+2(sp)	; return the checksum
	unsave	<r3,r2,r1,r0>
	return


	.sbttl	CRC calculation

;	This routine will calculate the CRC for a string using the
;	CRC-CCIT polynomial.
;
;	The string should be the fields of the packet between  but
;	not including the  <mark>  and  the  block check, which is
;	treated as a string of bits with the low order bit of  the
;	first  character  first and the high order bit of the last
;	character last --  this  is  how  the  bits  arrive on the
;	transmission  line.  The  bit  string  is  divided by  the
;	polynomial
;
;	x^16+x^12+x^5+1
;
;	The initial value of the  CRC  is  0.  The  result  is the
;	remainder  of  this   division,   used   as-is  (i.e.  not
;	complemented).
;
;	From 20KERMIT.MAC, rewritten for  PDP-11  by  Brian Nelson
;	13-Jan-84 08:50:43
;
;	input:	  (r5)	= string address
;		 2(r5)	= string length
;	output:	   r0	= CRC

crcclc:	save	<r1,r2,r3,r4,r5>
	clr	r0			; initialize the CRC to zero
	mov	@r5	,r3		; get the string address now
	mov	2(r5)	,r4		; get the string length
	beq	100$			; oops, nothing to do then

10$:	clr	r1			; get the next character please
	bisb	(r3)+	,r1		; please avoid PDP-11 sign extend
	tst	parity			; /BBS/ did the packet have parity?
	beq	20$			; no, leave bit seven alone
	bic	#^c177	,r1		; yes, clear bit seven please
20$:	ixor	r0	,r1		; add in with the current CRC
	mov	r1	,r2		; get the high four bits
	ash	#-4	,r2		; and move them over to 3..0
	bic	#^c17	,r2		; drop any bits left over
	bic	#^c17	,r1		; and the low four bits
	asl	r1			; times 2 for
	asl	r2			; word addressing
	mov	crctb2(r1),r1		; get low portion of CRC factor
	ixor	crctab(r2),r1		; ixor avoids hardware xor mode limits
	swab	r0			; shift off a byte from previous CRC
	bic	#^c377	,r0		; clear new high byte
	ixor	r1	,r0		; add in the new value
	sob	r4	,10$		; next please

100$:	unsave	<r5,r4,r3,r2,r1>
	return

	.save
	.psect	$pdata
crctab:	.word	     0 ,010201 ,020402 ,030603 ,041004 ,051205 ,061406 ,071607
	.word	102010 ,112211 ,122412 ,132613 ,143014 ,153215 ,163416 ,173617
crctb2:	.word	     0 ,010611 ,021422 ,031233 ,043044 ,053655 ,062466 ,072277
	.word	106110 ,116701 ,127532 ,137323 ,145154 ,155745 ,164576 ,174367
	.restore


	.sbttl	Error message handler

;	E R R O R
;
;	input:	  (r5)	= arg count
;		 2(r5)	= text for message #1
;		 4(r5)	= and so on, total length not to exceed erbfsiz

error::	save	<r1,r2,r3,r4,r5>
	tst	remote			; if not remote then printm(..)
	bne	10$			; we are the remote, send errors
	call	printm			; simple
	br	100$

10$:	mov	(r5)+	,r1		; message count
	beq	100$			; nothing to do

	sub	#erbfsiz+2,sp		; remote, allocate a text buffer
	mov	sp	,r4		; and point to it please
	mov	#erbfsiz,r2		; /BBS/ init erbfsiz byte counter

30$:	mov	(r5)+	,r3		; get the next message please
40$:	movb	(r3)+	,@r4		; now copy it to the buffer until
	beq	50$			; we get a null
	inc	r4			; bump buffer pointer to next pos
	sob	r2	,40$		; or until we run
	br	60$			; out of space to put it
50$:	dec	r2			; ensure sufficient space
	beq	60$			; don't overwrite stack!!
	sob	r1	,30$		; and get the next message
60$:	clrb	@r4			; ensure .asciz

	mov	sp	,r4		; all done, send the error packet
	strlen	r4			; get the length
	spack	#msg$error,paknum,r0,r4	; and send it
	bit	#log$pa	,trace		; /62/ logging packets?
	beq	99$			; /62/ nope
	strlen	r4			; /62/ ya, get length of it all
	calls	putrec	,<r4,r0,#lun.lo> ; /62/ and dump buffer to disk
	tst	r0			; /62/ did it work?
	beq	99$			; /62/ ya
	call	logerr			; /62/ no, go say why not
99$:	add	#erbfsiz+2,sp		; /62/ deallocate the text buffer
100$:	unsave	<r5,r4,r3,r2,r1>
	return


	.sbttl	Print message if not remote, and copy to logfile

;	P R I N T M			; /62/ major revision
;
;	input:	  (r5)	= arg count
;		 2(r5)	= text for message #1
;		 4(r5)	= and so on, total length not to exceed erbfsiz

printm::save				; save r0 - r5, inclusive
	mov	(r5)+	,r1		; get the message count
	beq	999$			; nothing to do

	sub	#erbfsiz+2,sp		; allocate a local text buffer
	mov	sp	,r4		; and a pointer to it
	mov	#erbfsiz,r2		; init byte overflow counter

	cmpb	@(r5)	,#'?		; is this an error message?
	beq	30$			; ya, skip "Kermit:" prefix
	cmpb	@(r5)	,#'%		; /62/ is this an error message?
	beq	30$			; /62/ ya, skip "Kermit:" prefix
	scan	#':	,@r5		; look for a colon indicating a
	tst	r0			; prefix string ala "Xyz: "
	bne	30$			; found one, don't do 2 headers
	mov	#M1$	,r3		; stuff in "Kermit: " prefix
	inc	r1			; by adding it to the arg count
	br	40$			; and jumping in here..

30$:	mov	(r5)+	,r3		; get the next message please
	tst	tsxsav			; TSX?
	beq	40$			; no
	cmpb	(r3)	,m.tsxr		; is it the TSX lead-in char?
	bne	40$			; no
	inc	r3			; ya, skip past it and
	br	45$			; don't type this to TT
40$:	movb	(r3)+	,@r4		; now copy it to the buffer until
	beq	50$			; we get an ascii null
45$:	inc	r4			; bump buffer pointer to next position
	sob	r2	,40$		; or until we run
	br	60$			; out of space to put it
50$:	dec	r2			; ensure sufficient space
	beq	60$			; don't overwrite stack!!
	sob	r1	,30$		; and get the next message

60$:	clrb	(r4)			; ensure .asciz
	mov	sp	,r4		; all done, restore pointer

	tst	inserv			; skip TT stuff if a server
	bne	20$			; go check for disk logging
	tst	remote			; skip if we are the remote
	bne	20$			; go check for disk logging
	tst	xmode			; if amidst an extended reply
	bne	6$			; do a newline for sure..
	tst	logini			; need a .newline if this is set
	beq	7$			; no, this line is clean
6$:	.newline
7$:	wrtall	r4			; dump local buffer to terminal
	.newline
	clr	logini			; may need a logging header

20$:	bit	#log$pa	,trace		; logging packets?
	beq	100$			; nope
	strlen	r4			; ya, get length of it all
	calls	putrec	,<r4,r0,#lun.lo> ; and dump buffer to disk
	tst	r0			; did it work?
	beq	100$			; ya
	call	logerr			; no, go say why not
100$:	add	#erbfsiz+2,sp		; pop local buffer
999$:	unsave
	return


	.sbttl	Logfile error handler	; /62/ all new

logerr::calls	syserr	,<r0,#errtxt>	; enter with r0=whatever_the_error_was
	.close	#lun.lo			; save what did make it to logfile..
	bic	#<log$op!log$al!log$io>,trace ; kill all disk_based debugging
	mov	#er$lwe	,r0		; this is some logfile write error..
	calls	syserr	,<r0,#spare1>	; generate an error message saying so
	strcat	#spare1	,#RX2$		; /62/ now insert a <cr><lf> after it
	strcat	#spare1	,#errtxt	; then include the reported error too
	tst	inserv			; skip TT stuff
	bne	30$			; if a server
	tst	remote			; skip if we
	bne	30$			; are the remote
23$:	tst	logini			; need a .newline if this is set
	beq	27$			; no, this line is clean
	.newline
27$:	wrtall	#spare1			; dump local buffer to terminal
	.newline
	clr	logini			; may need a packet cnt logging header
	return

30$:	tst	linksts			; got a path for an error packet?
	beq	23$			; nope, dump it to TT regardless then
	strlen	#spare1			; ya, get the length of and
	spack	#msg$error,paknum,r0,#spare1 ; then send the error message
	movb	#sta.abo,state		; /62/ and force the trasnfer to abort
	return


	.sbttl	Process retry and sync errors

m$retr::save	<r0>			; retry abort
	bitb	#200	,recbit		; /44/ perhaps parity was going?
	beq	10$			; /44/ no
	tst	parity			; /BBS/ do we know about parity?
	bne	10$			; /44/ yes we do, normal abort
	calls	error	,<#2,#e$retr,#e$par> ; /62/ no, mention it now!
	br	100$			; /44/ exit
10$:	calls	error	,<#1,#e$retr>	; send or print the error message
100$:	unsave	<r0>
	return

m$sync::save	<r0>			; out of sync
	calls	error	,<#1,#e$sync>	; send/print the error message
	unsave	<r0>
	return


	.sbttl	Compute parity for an outgoing 8-bit link

;	This is software parity generation as it allows Kermit to control
;	it even on interfaces which don't support it (by setting them for
;	8 data bits and no parity).  It was derived from the Pascal RT-11
;	Kermit by Phil Murton, and does a table lookup to compute parity.
;	For the sake of speed and because some RT-11 systems lack certain
;	instructions this method is used at a slight cost in space.

dopari::save	<r0,r1>			; /BBS/	somewhat cleaned up..
	mov	parity	,r0		; get the current parity setting
	beq	10$			; nothing to do
	asl	r0			; word addressing
	mov	6(sp)	,r1		; get the character to do it to
	jsr	pc	,@pardsp(r0)	; and dispatch as desired
	mov	r1	,6(sp)		; return the character please
10$:	unsave	<r1,r0>
	return

mark.p:	bisb	#200	,r1		; mark means we are always HIGH
	return				; on bit seven

spac.p:	bicb	#200	,r1		; space means we are always LOW
	return				; on bit seven

odd.p:	bic	#^c177	,r1		; hose any previous parity
	tstb	partab(r1)		; if char's entry in table is <>
	bne	100$			; leave parity bit clear
	bisb	#200	,r1		; else set parity bit
100$:	return

even.p:	bic	#^c177	,r1		; hose any previous parity
	tstb	partab(r1)		; if char's entry in table is 0
	beq	100$			; leave parity bit clear
	bisb	#200	,r1		; else set parity bit
100$:	return

	.save
	.psect	$pdata
pardsp:	.word	0  ,odd.p  ,even.p  ,mark.p  ,spac.p
partab:	.byte	0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0  ; first 16 ascii characters
	.byte	1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
	.byte	1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
	.byte	0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
	.byte	1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1
	.byte	0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
	.byte	1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1  ; last 16 characters (to 177)
	.restore

	.end