	.title	k11pak	packet driver for kermit-11
	.ident	/8.0.01/
	.dsabl	gbl

;	Brian Nelson  30-Nov-83  10:20:09
;
;	Change Software, Toledo, Ohio
;	University of Toledo, Toledo, Ohio
;
;	last edit:	04-Jan-84  08:35:48

	.enabl	lc




;	define macros and things we want for KERMIT-11

	.include	/IN:K11MAC.MAC/
	.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed


	maxpak	==	94.		; maximum packet size-maxsize(checksum)

	mx$try	==	10		; number of times to retry packet
	myquote	==	'#		; quoting
	mypad	==	0		; no padding
	mypchar	==	0		; thus no pad character
	myeol	==	cr		; end-of-line
	mytime	==	12		; time me out after this
	myqbin	==	'N		; no 8 bit quoting
	defchk	==	'1
	mychkt	==	defchk		; normal checksumming
	myrept	==	40		; no repeat counts
	mycapa	==	capa.a		; i can receive attributes
	maxtim	==	60		; maximum timeout
	mintim	==	2		; minimum timeout
	badchk	==	377		; psuedo packet type for checksum
	timout	==	'T&137		; psuedo packet type for timeout
	defdly	==	6		; delay for SENDING to start up

	STA.ABO	=	'A&137		; state is 'abort'
	STA.ATR	=	'H&137		; state is 'send attributes'
	STA.BRK	=	'B&137		; state is 'break link'
	STA.COM	=	'C&137		; state is 'transaction complete'
	STA.DAT	=	'D&137		; state is 'data'
	STA.EOF	=	'Z&137		; state is 'end of file/reply'
	STA.FIL	=	'F&137		; state is 'filename header'
	STA.INI	=	'I&137		; state is 'init'
	STA.RIN	=	'R&137		; state is 'receive init'
	STA.SIN	=	'S&137		; state is 'send    init'
	STA.TYP	=	'X&137		; state is 'extended reply'



	.sbttl	notes on RMS-11

;	RSTS and RSX note:
;
;	 Note that we really  don't need distinct luns for input, output
;	and  directory lookup as we would normally  never have more than
;	one of them active at any given time.  The space used to do this
;	only adds  about 1 KW of  size to the task  so I am not going to
;	worry about it.  There could  always come a time  when the above
;	assumption will not hold.  Most of KERMIT-11 is  sharable anyway
;	due to the linking to RMSRES. The code, all being in PSECT $CODE
;	can always be task built with the /MU switch to  make more of it
;	sharable (RSTS and RSX11M Plus only).
;	 The one thing to note is that LUN.LO must ALWAYS be reserved as
;	logging  and debugging to disk can  be running concurrently with
;	anything else. Also, when the TAKE command is put in another lun
;	will be required for it.


	lun.kb	==	0		; assume if channel 0 --> terminal
	lun.in	==	1		; channel for input files
	lun.ou	==	2		; channel for output files
	lun.lo	==	3		; channel for packet and file logging
	lun.tr	==	3		; same as lun.log
	lun.ta	==	4		; for the TAKE command
	lun.tt	==	5		; for RSX, the normal TI: channel
	lun.sr	==	6		; channel for $search for RMSv2.0
	lun.ti	==	7		; channel number for connected terminal
	lun.co	==	10		; used as is lin.ti for remote connect
	lun.as	==	11		; used to attach to remote link device
					; to fake a device assignment

	.psect	$pdata

null:	.byte	0,0			; a null packet to send

	.psect	$code

	.sbttl	KERMIT packet format

;				 PACKET FORMAT
;
;The  KERMIT  protocol is built around exchange of packets of the following for-
;mat:
;
;    +------+-----------+-----------+------+------------+-------+
;    ] MARK ] char(LEN) ] char(SEQ) ] TYPE ]    DATA    ] CHECK ]
;    +------+-----------+-----------+------+------------+-------+
;
;where all fields consist of ASCII characters.  The fields are:
;
;MARK   The synchronization character that marks the beginning of  the  packet.
;	This should normally be CTRL-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 (decimal) are permitted, and  96  (decimal)
;	is  the  maximum total packet length.  The length does not 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:
;
;	 D   Data packet
;	 Y   Acknowledge (ACK)
;	 N   Negative acknowledge (NAK)
;	 S   Send initiate (exchange parameters)
;	 B   Break transmission (EOT)
;	 F   File header
;	 Z   End of file (EOF)
;	 E   Error
;
;
;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
;	CRLFs,  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 described later.
;
;
;CHECK   A block check on the characters in the packet between, but not includ-
;	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 AND 192)/64)) AND 63)
;
;	This  is  the  default  block check, and all Kermits must be capable of
;	performing it.  Other optional block check types are described later.
;	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.


	.sbttl	send processing

	.enabl	lsb


sen.sw::
sendsw::movb	@r5	,state		; do a SINIT first thing please
	movb	#defchk	,chktyp		; setup the default checksum type
	mov	#1	,chksiz		; the dize of the checksum
	mov	$image	,image		; insure correct default for mode
	clr	paknum			; packetnumber := 0
	clr	numtry			; retry_count := 0
	clr	oldtry			; oldretry_count := 0
	add	pcnt.s+0,sencnt		; save sent packet count
	call	clrsta			; clear the stats out now
	cmpb	conpar+p.chkt,#'1	; did the other system want crc checks?
	bne	1$			; yep
	cmpb	senpar+p.chkt,#'1	; simple block checks today
	beq	5$			; yes, assume caller's state is ok
1$:	movb	#STA.SIN,state		; no, must force a SINIT exchange.
5$:

10$:	call	sendeb
	scan	state,#200$		; now dispatch based on current
	asl	r0			; state
	jsr	pc	,@210$(r0)	; and do it again
	movb	r1	,state		; set a new state
	bcc	10$			; ok

	movb	#defchk	,chktyp		; reset the checksum type
	mov	#1	,chksiz		; the size of the checksum
	save	<r0>			; insure files are closed
	tst	inopn			; file open from a failure ?
	beq	110$			; no
	calls	close	,<#lun.in>	; insure that it's closed
110$:	unsave	<r0>			; pop exit status code please
	return				; bye


200$:	.byte	STA.ABO	,STA.BRK,STA.COM,STA.DAT,STA.FIL,STA.SIN,STA.EOF
	.byte	STA.ATR
	.byte	0
	.even
210$:	.word	send.$
	.word	send.a	,send.b	,send.c	,send.d	,send.f	,send.s	,send.z
	.word	send.h
	.dsabl	lsb

	global	<chksiz	,chktyp	,inopn	,lun.in	,state	,sencnt>
	global	<image	,$image>



	.sbttl	STATE routines for SENDSW

send.a:
send.$:	mov	#-1	,r0
	movb	#STA.ABO,r1		; return ("ABORT")
	sec				; unknown state, abort
	return

send.b:	call	sbreak			; send a break to the other system
	clc				; and continue
	return

send.c:	clr	r0			; Complete
	sec				; exit
	return

send.d:	call	sdata			; send data now
	clc				; assume all is well
	return				; bye

send.f:	call	sfile			; send a file header
	clc				; assume it went well
	return

send.h:	call	sattr
	clc
	return

send.s:	call	sinit			; initialize
	clc
	return

send.z:	call	seof			; end of file
	clc
	return


sendeb:	bit	#log$st	,trace		; debugging for SENDSW
	beq	30$			; if trace is on then dump the
	sub	#50	,sp		; current state to the disk file
	mov	sp	,r1		; allocate a small buffer
	mov	#200$	,r2		; point to a header
10$:	movb	(r2)+	,(r1)+		; copy a header please
	bne	10$			; until we find a null
	dec	r1			; all done
	movb	state	,(r1)+		; copy the current state over
	movb	#40	,(r1)+		;
	sub	sp	,r1		; get the record length
	mov	sp	,r0		; and point back to the record
	calls	putrec	,<r0,r1,#lun.lo>; dump it
	add	#50	,sp		; and deallocate the buffer
30$:	tst	debug			; terminal debugging on ?
	beq	100$			; no
	.print	#200$			; yes, dump current state to ti:
	.print	#state	,#1		;
	.newli				; and a crlf
100$:	return

200$:	.asciz	/Sendsw - state is /
	.even

	global	<image	,state	,trace>
	.sbttl	sattr	send attribute data for the current file


sattr:	inc	numtry			; abort if we have been trying too much
	cmp	numtry	,maxtry		; well ?
	blos	10$			; no, keep it up
	 movb	#STA.ABO,r1		; yes, return("ABORT")
	 br	100$			; exit


10$:	tst	sendat			; really do this ?
	beq	90$			; no
	calls	w$attr	,<#filnam,#lun.in,#packet> ; get the next attr packet
	tst	r0			; any errors along the way ?
	bne	90$			; yes
	tst	r1			; anything to send over ?
	beq	90$			; no
	spack	#'A,paknum,r1,#packet	; send the next record out please
	rpack	r2,r3,#recpkt		; get the reply please
	scan	r1,#200$		; and take action on the reply
	asl	r0			; dispatch based on the packet type
	jsr	pc	,@210$(r0)	; simple
	br	100$			; bye
90$:	calls	buffil	,<#packet>	; get the first buffer of data please
	mov	r1	,size		; and save it
	movb	#STA.DAT,r1		; switch to data state if no more attr
100$:	return				; bye

200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	satr.$
	.word	satr.e	,satr.n	,satr.y	,satr$$	,satr$$



	.sbttl	handle the response to the packet sent by SATTR

satr.$:	movb	#STA.ABO,r1		; unrecognized packet type
	return


satr$$:	movb	state	,r1		; timeout, stay in current state
	return				; and exit


satr.e:	calls	prerrp	,<#recpkt>	; print out received error packet
	movb	#STA.ABO,r1		; abort
	return				; and exit


satr.n:	dec	r3			; a NAK, see if it's for the last
	bge	10$			; packet
	mov	#63.	,r3		; --paknum<0 ? 63:paknum
10$:	cmp	r3	,paknum		; same one ?
	beq	20$			; yes
	 movb	state	,r1		; no, continue on as before then
	 return				; bye
20$:	call	satr.y			; same packet, goto ACK code
	return


satr.y:	cmp	r3	,paknum		; insure ACK is for correct packet
	beq	10$			; yes
	 movb	state	,r1		; no, continue in current state
	 return

10$:	clr	numtry			; retrycount := 0
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#STA.ATR,r1		; not eof, stay in ATTRIBUTE state
	return				; return("ATTRIBUTE")

	global	<numtry	,paknum	,packet	,sendat	,size	,state>






	.sbttl	sbreak	send a break


sbreak:	inc	numtry			; ABORT if retry count is too high
	cmp	numtry	,maxtry		; well ?
	blos	10$			; ok
	 movb	#STA.ABO,r1		; no, abort the sending of this
	 br	100$

10$:	spack	#'B,paknum,#0,#packet	; send a break packet
	rpack	r2,r3,#recpkt		; read the response
	scan	r1,#200$		; and dispatch based on it
	asl	r0			; offset times two
	jsr	pc	,@210$(r0)	; simple

100$:	clc
	return



200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	sbrk.$
	.word	sbrk.e	,sbrk.n	,sbrk.y	,sbrk$$	,sbrk$$

	global	<maxtry	,state>


	.sbttl	sbreak routines

sbrk.$:	movb	#STA.ABO,r1		; default or timeout error
	return				; bye


sbrk$$:	movb	state	,r1		; receive failure (timeout)
	return				; remain in current state


sbrk.e:	calls	prerrp	,<#recpkt>
	movb	#STA.ABO,r1
	return


sbrk.n:	dec	r3			; for a NAK see if it was for
	bge	10$			; the last one mod 64
	mov	#63.	,r3		; underflowed, reset to 63
10$:	cmpb	r3	,paknum		; is it the last one ?
	beq	20$			; yes
	movb	state	,r1		; no, simply stay in current mode
	return

20$:	call	sbrk.y
	return


sbrk.y:	cmp	r3	,paknum		; ACK, insure ack is for the
	beq	10$			; current packet
	movb	state	,r1		; wrong packet, ignore it
	return
10$:	clr	numtry			; ack for this packet.
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#'C&137	,r1		; return ("COMPLETE")
	return


	global	<numtry	,paknum	,packet	,recpkt	,state>

	.sbttl	sendinit


sinfo::	save				; save ALL registers please
	clr	numtry			; send info packets before any 
	clr	paknum			; extended server response please
	movb	#'I&137	,-(sp)		; packet type 'i'
	call	.sinit			; do it
	unsave				; restore ALL registers now
	return				; bye

sinit::	movb	#'S&137	,-(sp)		; normal sinit operation for sending
	call	.sinit			; files
	return				; bye



.sinit:
	mov	chktyp	,-(sp)		; save checksum type (not needed)
	mov	chksiz	,-(sp)		; save checksum type (not needed)
	movb	#defchk	,chktyp		; force type one please
	mov	#1	,chksiz		; length of it
	inc	numtry			; abort if we have been trying too much
	cmp	numtry	,maxtry		; well ?
	blos	10$			; no, keep it up
	 movb	#STA.ABO,r1		; yes, return("ABORT")
	 br	100$

10$:	calls	spar	,<#packet>	; get our send parameters
	calls	cantyp	,<#ttname,#lun.ti>; flush pending input please
	movb	6(sp)	,r5		; packet type to do today
	spack	r5,paknum,sparsz,#packet ; sent our init info now
	rpack	r2,r3,#recpkt		; and get the other's response
	scan	r1,#200$		; and dispatch to the correct
	asl	r0			; routine now
	jsr	pc	,@210$(r0)	; simple
100$:	mov	(sp)+	,chksiz		; restore cehcksum stuff
	mov	(sp)+	,chktyp		; restore cehcksum stuff
	mov	(sp)+	,@sp		; pop passed packet type now
	return


200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	sini.$
	.word	sini.e	,sini.n	,sini.y	,sini$$	,sini$$

	global	<lun.ti	,packet	,paknum	,recpkt	,sparsz	,ttname>
	global	<maxtry	,numtry>





	.sbttl	routines for SINIT


sini.$:	movb	#STA.ABO,r1		; default case, unrecognized TYPE
	return


sini$$:	movb	state	,r1		; error on the packet, try again
	return


sini.e:	cmpb	r5	,#'I&137	; if called from sinfo, ignore errors
	beq	100$			;
	calls	prerrp	,<#recpkt>	; error state, print it and abort
	movb	#STA.ABO,r1		; return ("ABORT")
100$:	return


sini.n:	cmpb	r5	,#'I&137	; server NAK for I (sinfo) packet?
	bne	10$			; no
	cmp	numtry	,#2		; gotten at least one NAK for 'I'?
	blo	10$			; no, try again please
	incm64	paknum			; yes, simply ignore it and move
	clr	numtry			; to file state
	movb	#STA.FIL,r1		; not all servers may know about it
	return
10$:	movb	state	,r1		; NAK, continue as before
	return


sini.y:	cmp	r3	,paknum		; got an ACK for SINIT
	beq	10$			; and the ack is for correct packet
	 movb	state	,r1		; wrong ACK, ignore it please
	 return

10$:	calls	rpar	,<#recpkt,r2>	; load the other's parameters now
	tstb	conpar+p.eol		; insure legitimate EOL character
	bne	20$			; yes
	movb	#cr	,conpar+p.eol	; no, stuff a carriage return in
20$:	tstb	conpar+p.qctl		; vaild quoting character present?
	bne	30$			; yes
	movb	#myquot	,conpar+p.qctl	; no, stuff the default in please
30$:	clr	numtry			; number_of_trys := 0
	incm64	paknum			; packetnumber := packetnumber+1 mod 64
	movb	#STA.FIL,r1		; return("FILE")
	return

	global	<conpar	,numtry	,paknum	,recpkt>
	
	.sbttl	sfile
	.enabl	lsb

sfile:	movb	conpar+p.chkt,chktyp	; switch to new checksum type
	movb	chktyp	,chksiz		; compute the checksum size also
	sub	#'0	,chksiz		; simple
	mov	$image	,image		; insure correct default for mode
	mov	#filnam	,r3		; and point to it please
	clr	skipfl			; the user skip the rest of a file
	call	clratr			; insure attribute stuff is cleared
	sub	#100	,sp		; and a converted filename buffer
	mov	sp	,r4		; and point to it please
	inc	numtry			; abort if we have been trying too much
	cmp	numtry	,maxtry		; well ?
	blos	10$			; no, keep it up
	 movb	#STA.ABO,r1		; yes, return("ABORT")
	 jmp	100$			; exit

10$:	tst	inopn			; open files hanging around ?
	beq	20$			; no	
	calls	close	,<#lun.in>	; yes, clean up please
	clr	inopn			; it's closed now
20$:	calls	binfil	,<#filnam,#lun.in>; should we force binary mode ?
	tst	r0			; if gt, then yes
	ble	25$			; no
	mov	#binary	,image		; yes, force binary file operations
25$:	calls	open	,<#filnam,#lun.in,image>; open the file for input
	tst	r0			; did it work ?
	beq	30$			; yes
	calls	syserr	,<r0,#errtxt>	; no
	calls	error	,<#2,#errtxt,#filnam>; say so please
	movb	#STA.ABO,r1		; return("ABORT")
	br	100$			; exit

30$:	mov	sp	,inopn		; file is open
	tst	xmode			; is this a server X-tended reply?
	bne	45$			; yes, send a simple X packet
	calls	fillog	,<#1,#filnam>	; log this to disk
	calls	namcvt	,<#filnam,r4>	; convert name to simple name
	tst	remote			; are we local here ?
	bne	40$			; no, don't print this out

	message	<Sending file >		; an informative message
	print	#filnam
	message	< as file >		; and the new name
	print	r4			; simple
	message

40$:	strlen	r4			; and get the filename length
	spack	#'F,paknum,r0,r4	; set the filename packet over
	br	50$			; ok

45$:	spack	#'X,paknum		; server extended reply here, send X

50$:	rpack	r2,r3,#recpkt		; get the response to the filename
	scan	r1,#200$		; and dispatch on the response
	asl	r0			; times 2
	jsr	pc	,@210$(r0)	; and call the appropiate response

100$:	add	#100	,sp
	return

200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	sfil.$
	.word	sfil.e	,sfil.n	,sfil.y	,sfil$$	,sfil$$

	.dsabl	lsb

	global	<errtxt	,filnam	,index	,inopn	,paknum	,recpkt>
	global	<skipfl	,clratr>


	.sbttl	routines for SFILE


sfil.$:	movb	#STA.ABO,r1		; unknown response, return("ABORT")
	return


sfil$$:	movb	state	,r1		; timeout or checksum error
	return				; remain in current F state


sfil.e:	calls	prerrp	,<#recpkt>	; error, abort aftering getting
	movb	#STA.ABO,r1		; the error packet printed.
	return


sfil.n:	dec	r3			; a NAK, see if it's for the last
	bge	10$			; packet
	mov	#63.	,r3		; --paknum<0 ? 63:paknum
10$:	cmp	r3	,paknum		; same one ?
	beq	20$			; yes
	 movb	state	,r1		; no, continue on as before then
	 return				; bye
20$:	call	sfil.y			; same packet, goto ACK code
	return


sfil.y:	cmp	r3	,paknum		; same packet number being ACKED?
	beq	10$			; yes
	 movb	state	,r1		; no, continue in current state
	 return

10$:	clr	numtry			; number_of_tries := 0
	incm64	paknum			; packnumber := packnumber+1 mod 64
	movb	#STA.ATR,r1		; return("ATTRIBUTE")
	return

	global	<size>

	.sbttl	sdata	send file data to other system


sdata:	inc	numtry			; abort if we have been trying too much
	cmp	numtry	,maxtry		; well ?
	blos	10$			; no, keep it up
	 movb	#STA.ABO,r1		; yes, return("ABORT")
	 br	100$			; exit

10$:	spack	#'D,paknum,size,#packet	; send the next record out please
	rpack	r2,r3,#recpkt		; get the reply please
	scan	r1,#200$		; and take action on the reply
	asl	r0			; dispatch based on the packet type
	jsr	pc	,@210$(r0)	; simple
100$:	return				; bye

200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	sdat.$
	.word	sdat.e	,sdat.n	,sdat.y	,sdat$$	,sdat$$


	.sbttl	handle the response to the packet sent by SDATA

sdat.$:	movb	#STA.ABO,r1		; unrecognized packet type
	return


sdat$$:	movb	state	,r1		; timeout, stay in current state
	return				; and exit


sdat.e:	calls	prerrp	,<#recpkt>	; print out received error packet
	return


sdat.n:	dec	r3			; a NAK, see if it's for the last
	bge	10$			; packet
	mov	#63.	,r3		; --paknum<0 ? 63:paknum
10$:	cmp	r3	,paknum		; same one ?
	beq	20$			; yes
	 movb	state	,r1		; no, continue on as before then
	 return				; bye
20$:	call	sdat.y			; same packet, goto ACK code
	return


sdat.y:	cmp	r3	,paknum		; insure ACK is for correct packet
	beq	10$			; yes
	 movb	state	,r1		; no, continue in current state
	 return


10$:	clr	numtry			; retrycount := 0
	incm64	paknum			; paknum := (paknum+1) mod 64
	cmpb	recpkt	,#'X&137	; did the ack contain a X for skipfile
	beq	20$			; yes, fake EOF then
	cmpb	recpkt	,#'Z&137	; did the ack contain a Z for skip all
	bne	30$			; files ? no
	 mov	#-1	,index		; flag a fake no more files
20$:	 movb	#STA.EOF,r1		; and fake EOF for either X or Z ack
	 return

30$:	calls	buffil	,<#packet>	; get the next buffer of data to send
	mov	r1	,size		; and save the size please
	bne	40$			; something was there
	 movb	#STA.EOF,r1		; EOF, set state to EOF state
	 return				; return("EOF")
40$:	movb	#'D&137	,r1		; not eof, stay in DATA state
	return				; return("DATA")

	global	<numtry	,paknum	,packet	,size	,state>

seof:	inc	numtry			; abort if we have been trying too much
	cmp	numtry	,maxtry		; well ?
	blos	10$			; no, keep it up
	 movb	#STA.ABO,r1		; yes, return("ABORT")
	 br	100$			; exit

10$:	tst	skipfl			; skipping the rest of a file ?
	beq	20$			; no
	spack	#'Z,paknum,#1,#220$	; yes, send D in data field
	br	30$
20$:	spack	#'Z,paknum,#0,#null	; send an EOF packet out now
30$:	rpack	r2,r3,#recpkt		; get the reply please
	scan	r1,#200$		; and take action on the reply
	asl	r0			; dispatch based on the packet type
	jsr	pc	,@210$(r0)	; simple
100$:	return				; bye

200$:	.byte	'E&137	,'N&137	,'Y&137	,timout	,badchk	,0
	.even
210$:	.word	seof.$
	.word	seof.e	,seof.n	,seof.y	,seof$$	,seof$$

220$:	.byte	'D&137	,0


	.sbttl	handle the response to the packet sent by seof

seof.$:	movb	#STA.ABO,r1		; unrecognized packet type
	return


seof$$:	movb	state	,r1		; timeout, stay in current state
	return				; and exit


seof.e:	calls	prerrp	,<#recpkt>	; print out received error packet
	return


seof.n:	dec	r3			; a NAK, see if it's for the last
	bge	10$			; packet
	mov	#63.	,r3		; --paknum<0 ? 63:paknum
10$:	cmp	r3	,paknum		; same one ?
	beq	20$			; yes
	 movb	state	,r1		; no, continue on as before then
	 return				; bye
20$:	call	seof.y			; last packet, handle the kac
	return


seof.y:	cmp	r3	,paknum		; correct packet number
	beq	10$			; yes
	 movb	state	,r1		; no, return the last state
	 return

10$:	clr	numtry			; clear the retry count
	incm64	paknum			; paknum := (paknum+1) mod 64
	calls	close	,<#lun.in>	; close the input file
	clr	inopn			; input file is now closed
	cmp	index	,#-1		; force a break here from user
	beq	20$			; yes
	call	getnxt			; get the next input file ?
	tst	r0			; did it work ?
	bne	20$			; no
	tst	xmode
	bne	20$
	movb	#STA.FIL,r1		; yes, set new state to "FILE"
	return
20$:	movb	#STA.BRK,r1		; return("BREAK")
	return





	.sbttl	recsw	state table controller for receiving files

recsw::	clr	paknum			; packet_number := 0
rec.sw::movb	@r5	,state		; assume RECEIVE-INIT for starters
	clr	cccnt			; control_c_count := 0
	mov	$image	,image		; insure correct default for mode
	movb	#defchk	,chktyp		; reset checksum type to default
	mov	#1	,chksiz		; the size of the checksum
	clr	numtry			; number_trys   := 0
	clr	oldtry			; 
	add	pcnt.r+0,reccnt		; save rec packet count
	call	clrsta			; clear the stats out now
	clr	outopn			; say nothing is open now
	tst	remote			; local or remote
	bne	5$			; remote
	call	ttrini			; perhaps special init for local tt:
5$:

10$:	call	recdeb			; perhaps debugging should be done
	scan	state	,#200$		; case state of
	asl	r0			; dispatch to correct routine
	jsr	pc	,@210$(r0)
	bcc	10$

100$:	movb	#defchk	,chktyp		; reset type of checksum to 1
	mov	#1	,chksiz		; the size of the checksum
	save	<r0>			; insure files are closed
	tst	remote			; remote or local
	bne	105$			; remote
	call	ttrfin			; local, perhaps clean up console
105$:	tst	outopn			; file open from a failure ?
	beq	110$			; no
	calls	close	,<#lun.ou>	; insure that it's closed
	clr	outopn
110$:	unsave	<r0>			; pop exit status code please
	return

200$:	.byte	'R&137	,'F&137	,'D&137	,'C&137	,'A&137	,0
	.even
210$:	.word	recs.$
	.word	recs.r	,recs.f	,recs.d	,recs.c	,recs.a



recs.$:	clc				; Unknown state
	return				; back to caller

recs.r:	call	rinit			; receive-init
	movb	r1	,state		; set state and exit
	clc				; saying there is more to come
	return				; bye

recs.f:	call	rfile			; receive-file
	movb	r1	,state
	clc
	return

recs.d:	call	rdata			; receive-data
	movb	r1	,state
	clc
	return

recs.c:	clr	r0			; complete
	sec
	return

recs.a:	mov	sp	,r0		; abort
	sec
	return

	global	<cccnt	,chktyp	,outopn	,remote	,state	,ttrfin	,ttrini>

	.sbttl	debugging and logging for receive



recdeb:	save	<r1,r2>
	sub	#50	,sp
	mov	sp	,r1		; allocate a small buffer
	mov	#200$	,r2		; point to a header
10$:	movb	(r2)+	,(r1)+		; copy a header please
	bne	10$			; until we find a null
	dec	r1			; all done
	movb	state	,(r1)+		; copy the current state over
	movb	#40	,(r1)+		;
	sub	sp	,r1		; get the record length
	mov	sp	,r0		; and point back to the record
	bit	#log$st	,trace		; debugging for RECSW
	beq	30$			; if trace is on then dump the
	calls	putrec	,<r0,r1,#lun.lo>; dump it
30$:	tst	debug			; terminal debugging on ?
	beq	40$			; no
	print	r0	,r1
	.newli				; and a crlf

40$:	tst	remote			; running locally ?
	bne	100$			; no
	tst	xmode			; simply printing text to ti: ?
	bne	100$			; yes, skip the packet stats then
	mov	sp	,r1		; yes, print out the packet count
	deccvt	pcnt.r	,r1		; convert the received packet count
	add	#6	,r1		; point to the end of it
	movb	#'/	,(r1)+		; format is total/naks
	mov	pcnt.s+<2*<<'N&137>-100>>,r0 ; get the sent NAK count
	deccvt	r0	,r1		; convert it please
	mov	sp	,r1		; point back to the buffer
	calls	cvt$$	,<r1,#13.,#377>	; remove all spaces and such
	print	r1	,r0		; print the count out
	print	#210$
	
100$:	add	#50	,sp
	unsave	<r2,r1>
	return

200$:	.asciz	/Recsw - state is /
210$:	.byte	cr,0
	.even

	global	<reccnt	,pcnt.r	,pcnt.s	,state	,trace	,xmode>

	.sbttl	rinit	receive initialization


;	R I N I T
;
;	input:	nothing

	.enabl	lsb


rinit:	save	<r2,r3,r4>		; get registers we use saved
	inc	numtry			; check for retry count
	cmp	numtry	,maxtry		; been here too often ?
	blos	10$			; no
	 movb	#STA.ABO,r1		; yes, return ABORT state
	 br	100$


10$:	rpack	r2,r3,#packet		; get the next packet please
	scan	r1,#200$		; look for the packet type
	asl	r0			; and dispatch to it
	jsr	pc	,@210$(r0)	; simple
100$:	unsave	<r4,r3,r2>
	return

200$:	.byte	'S&137	,'E&137	,timout	,badchk	,0
	.even
210$:	.word	rini.$
	.word	rini.S	,rini.E	,rini$$	,rini$$

	.dsabl	lsb

rini.$:	movb	#STA.ABO,r1
	return

rini$$:	spack	#'N,paknum,#0,#null	; error, send a NAK
	movb	state	,r1		; and exit
	return

rini.e:	calls	prerrp	,<#packet>
	movb	#STA.ABO,r1
	return

rini.s:	calls	rpar	,<#packet,r2>	; SEND-INIT
	calls	spar	,<#packet>	; get other sides init and fill with
	spack	#'Y,paknum,sparsz,#packet; ours
	mov	numtry	,oldtry
	clr	numtry
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#STA.FIL,r1		; state  := FILE-RECEIVE
	return
	.sbttl	rfile	receive file header

rfile:	save	<r2,r3,r4>		; get registers we use saved
	call	clratr			; insure attribute stuff is cleared
	movb	conpar+p.chkt,chktyp	; time to use new checksum ?
	movb	chktyp	,chksiz		; compute the checksum size also
	sub	#'0	,chksiz		; simple
	mov	$image	,image		; insure correct default for mode
	inc	numtry			; check for retry count
	cmp	numtry	,maxtry		; been here too often ?
	blos	5$			; no
	 movb	#STA.ABO,r1		; yes, return ABORT state
	 br	100$
5$:	tst	xgottn			; already get the x packet ?
	beq	10$			; no
	movb	#'X&137	,r1		; yes, fake that we already got it
	br	20$


10$:	rpack	r2,r3,#packet		; get the next packet please
20$:	scan	r1,#200$		; look for the packet type
	asl	r0			; and dispatch to it
	jsr	pc	,@210$(r0)	; simple
100$:	unsave	<r4,r3,r2>
	return


200$:	.byte	'S&137	,'Z&137	,'F&137	,'B&137	,'E&137	,'X&137
	.byte	timout	,badchk	,0
	.even

210$:	.word	rfil.$
	.word	rfil.s	,rfil.z	,rfil.f	,rfil.b	,rfil.e	,rfil.x
	.word	rfil$$	,rfil$$



	.sbttl	more rfile

rfil.$:	movb	#STA.ABO,r1		; default, unknown packet type
	return				; bye

rfil$$:	spack	#'N,paknum,#0,#null	; timeout or checksum error, send
	movb	state	,r1		; NAK and continue in current state
	return

rfil.b:	cmp	r3	,paknum		; Break XMIT (EOT)
	beq	10$			; insure BREAK is for current packet
	 movb	#STA.ABO,r1		; no, return 'ABORT"
	 return

10$:	spack	#'Y,paknum,#0,#null	; ACK the BREAK
	movb	#'C&137	,r1		; and return state as 'COMPLETE'
	return

rfil.e:	calls	prerrp	,<#packet>	; error packet, print it out
	movb	#STA.ABO,r1		; return 'ABORT'
	return

rfil.s:	inc	oldtry			; SEND-INIT, must have lost ours
	cmp	oldtry	,maxtry		; tried this too many times ?
	blos	10$			; no
	 movb	#STA.ABO,r1		; yes, return 'ABORT'
	 return

10$:	mov	paknum	,r1		; see if thispacket=(paknum+63) mod 64
	add	#77	,r1		; ie, check if this data packet was the
	clr	r0			; one sent the last time. if so, we
	div	#100	,r0		; must reack that packet and remain
	clr	r0			; in the current state.
	cmp	r3	,r1		; 
	bne	20$			; no
	 calls	spar	,<#packet>	; resend our SEND-INIT stuff
	 spack	#'Y,r3,sparsz,#packet	; reack this then
	 clr	numtry			; clear out retry counter
	 movb	state	,r1		; and return current state
	 return

20$:	 movb	#STA.ABO,r1		; otherwise return ABORT since we must
	 return				; be way out of synch then.

rfil.z:	inc	oldtry			; END-OF-FILE ?
	cmp	oldtry	,maxtry		; tried this too many times ?
	blos	10$			; no
	 movb	#STA.ABO,r1		; yes, return 'ABORT'
	 return

10$:	mov	paknum	,r1		; see if thispacket=(paknum+63) mod 64
	add	#77	,r1		; ie, check if this data packet was the
	clr	r0			; one sent the last time. if so, we
	div	#100	,r0		; must reack that packet and remain
	clr	r0			; in the current state.
	cmp	r3	,r1		; 
	bne	20$			; not the last one after all
	 spack	#'Y,r3,#0,#null		; reack this then
	 clr	numtry			; clear out retry counter
	 movb	state	,r1		; and return current state
	 return

20$:	 movb	#STA.ABO,r1		; otherwise return ABORT since we must
	 return				; be way out of synch then.

	.sbttl	more rfile subroutines

;	Move the actual file create to RDATA so we can create
;	the output file after all attribute packets have come.
;	Thus, when we get the first DATA packet is when we go
;	and create the file.
;
;	18-Apr-84  10:24:45  Brian Nelson


rfil.f:	cmp	r3	,paknum		; FILE name
	beq	10$			; insure correct packet numer
	 movb	#STA.ABO,r1		; no, return 'ABORT'
	 return				; bye

10$:	calls	fparse	,<#packet,#filnam>; parse and fill in defaults
	tst	outopn			; output already open as if from
	beq	20$			; a NAK or something
	calls	close	,<#lun.ou>	; yes, close it please
	clr	outopn			; it's closed
20$:	spack	#'Y,paknum		; please ack the fileheader packet
	mov	numtry	,oldtry		; update number of retrys
	clr	numtry			; and init the current retry count
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#'D&137	,r1		; return 'DATA'
	return




rfil.x:	cmp	r3	,paknum		; X header name
	beq	10$			; insure correct packet numer
	 movb	#STA.ABO,r1		; no, return 'ABORT'
	 return				; bye
10$:	spack	#'Y,paknum,#0,#null	; ACK the filename
	clr	outlun			; not a real file to output to
	clr	outopn			; nothing is open for output
	mov	sp	,xmode		; flag this also please
	mov	numtry	,oldtry		; update number of retrys
	clr	numtry			; and init the current retry count
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#'D&137	,r1		; return 'DATA'
	return


	global	<filnam	,errtxt	,numtry	,oldtry	,packet	,paknum>
	global	<outlun>


	.sbttl	rdata	receive data from pc


;	R D A T A
;
;	input:	nothing
;	output:	global	paknum	packet number
;			oldtry	retry count
;			packet	packet just received
;			numtry
;		r1	returned state




rdata:	save	<r2,r3,r4>
	clr	r0			; error := 0
	inc	numtry			; abort of retry count is too large
	cmp	numtry	,maxtry		; been here too many times ?
	blos	10$			; no
	movb	#STA.ABO,r1		; yes, return state(abort)
	br	100$			; bye

10$:	rpack	r2,r3,#packet		; get the next imcoming packet
	scan	r1	,#200$		; look for the packet type and dispatch
	asl	r0			; to the correct routine. ie, a crude
	jsr	pc	,@210$(r0)	; case statement
100$:	unsave	<r4,r3,r2>
	return


200$:	.byte	'A&137	,'D&137	,'E&137	,'F&137	,'Z&137	,'X&137
	.byte	timout	,badchk	,0
	.even
210$:	.word	rdat.$
	.word	rdat.a	,rdat.d	,rdat.e	,rdat.f	,rdat.z	,rdat.x
	.word	rdat$$	,rdat$$

	global	<numtry	,oldtry	,packet	,paknum	,state	>
	.sbttl	rdata packet handlers


rdat.$:	movb	#STA.ABO,r1		; case default: return ABORT
	return


rdat.d:	tst	xmode			; do we need to create the file
	bne	10$			; no
	tst	outopn			; did we already open the file up?
	bne	10$			; yes, please don't try again then.
	calls	create	,<#filnam,#lun.ou,image>; now create it
	tst	r0			; did the file create work ?
	beq	5$			; yes
	mov	#lun.ou	,outlun		; set a real LUN for output
	calls	syserr	,<r0,#errtxt>	; no, get the system error text
	calls	error	,<#3,#230$,#errtxt,#filnam>
	movb	#STA.ABO,r1		; return 'ABORT'
	return

5$:	calls	fillog	,<#0,#filnam>	; log to disk perhaps ?
	calls	printm	,<#2,#240$,#filnam>
	mov	sp	,outopn		; flag output as being open
	mov	#lun.ou	,outlun		; set a real LUN for output

10$:	cmp	r3	,paknum		; case "D"
	beq	40$			; Correct packet number ?
	inc	oldtry			; no, see if retry limit expired
	cmp	oldtry	,maxtry		; if so, return ABORT
	blos	20$			; no
	 movb	#STA.ABO,r1		; yes, return 'ABORT'
	 return				; bye

20$:	mov	paknum	,r1		; see if thispacket=(paknum+63) mod 64
	add	#77	,r1		; ie, check if this data packet was the
	clr	r0			; one sent the last time. if so, we
	div	#100	,r0		; must reack that packet and remain
	clr	r0			; in the current state.
	cmp	r3	,r1		; insure r0 is not affected
	bne	30$			; not the last packet
	 spack	#'Y,r3,#6,#packet	; reack this then
	 clr	numtry			; clear out retry counter
	 movb	state	,r1		; and return current state
	 return

30$:	 movb	#STA.ABO,r1		; otherwise return ABORT since we must
	 return				; be way out of synch then.


40$:	calls	bufemp	,<#packet,r2>	; correct packet, get the data out
	mov	r0	,-(sp)		; save error code from BUFEMP

	tst	remote			; are we a local kermit today ?
	bne	50$			; no, just ack normally
	tst	cccnt			; we are local. check for control
	bne	45$			; c abort for this file please
	call	chkabo			; check for abort via ^X and ^Z
	cmpb	r0	,#'Z&37		; did the user type a control Z?
	beq	45$			; yes
	cmpb	r0	,#'X&37		; no, what about a control X then?
	bne	50$			; no
	spack	#'Y,paknum,#1,#220$	; ^X typed, send an X in the data
	br	60$
45$:	spack	#'Y,paknum,#1,#210$	; yes, send an ACK with "Z" data
	br	60$			;

50$:	spack	#'Y,paknum,#0,#null	; ack it
60$:	mov	numtry	,oldtry		; oldtry_count:= numtry
	clr	numtry			; numtry := 0
	incm64	paknum			; increment packet number mod 64

	mov	(sp)+	,r0		; check error from BUFEMP
	beq	70$			; ok
	calls	syserr	,<r0,#errtxt>	; it failed, send error packet
	calls	error	,<#2,#200$,#errtxt>
	movb	#STA.ABO,r1		; and return ABORT
	return

70$:	movb	#'D&137	,r1		; switch to data state
	return				; bye

	global	<chkabo	,errtxt	,numtry	,oldtry	,packet	,paknum	,state	>


200$:	.asciz	/Remote KERMIT error: /
210$:	.byte	'Z&137,0
220$:	.byte	'X&137,0
230$:	.asciz	/Create failed - /
240$:	.asciz	/Created file - /
	.even



	.sbttl	rdata subroutines, continued

					; 'F', got a FILE HEADER
rdat.x:					; 'X', also handle EXTENED REPLY
rdat.f:	inc	oldtry			; no, see if retry limit expired
	cmp	oldtry	,maxtry		; if so, return ABORT
	blos	10$			; no
	 movb	#STA.ABO,r1		; yes, return 'ABORT'
	 return				; bye

10$:	mov	paknum	,r1		; see if thispacket=(paknum+63) mod 64
	add	#77	,r1		; ie, check if this data packet was the
	clr	r0			; one sent the last time. if so, we
	div	#100	,r0		; must reack that packet and remain
	clr	r0			; in the current state.
	cmp	r3	,r1		; 
	bne	20$			; not the last packet
	 spack	#'Y,r3,#0,#null		; reack this then
	 clr	numtry			; clear out retry counter
	 movb	state	,r1		; and return current state
	 return

20$:	movb	#STA.ABO,r1		; else return ABORT
	return


rdat.e:	calls	prerrp	,<#packet>	; flag error, print it
	movb	#STA.ABO,r1		; return ABORT
	return

rdat.z:	cmp	paknum	,r3		; END OF FILE. If not correct packet
	beq	10$			; the return 'ABORT'
	 movb	#STA.ABO,r1
	 return

10$:	mov	#lun.ou	,r2		; assume that we close a disk file
	tst	outopn			; real output or to the terminal
	bne	20$			; it's a for real disk file today
	clr	r2			; no, it's the console terminal
20$:	calls	close	,<r2>		; do the close now
	call	clratr			; attributes no longer valid
	clr	outopn			; flag it
	spack	#'Y,r3,#0,#null		; acknowledge the eof packet
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#STA.FIL,r1		; back to receive file state
	clr	xgottn			; don't have an X packet anymore
	return

rdat$$:	spack	#'N,paknum,#0,#null	; timed out or checksum error
	movb	state	,r1		; NAK it and return current state
	return

	global	<outopn	,paknum	,state	,xgottn	,clratr>



	.sbttl	receive data attribute packets



rdat.a:	cmp	r3	,paknum		; case "A"
	beq	40$			; Correct packet number ?
	inc	oldtry			; no, see if retry limit expired
	cmp	oldtry	,maxtry		; if so, return ABORT
	blos	20$			; no
	 movb	#STA.ABO,r1		; yes, return 'ABORT'
	 return				; bye

20$:	mov	paknum	,r1		; see if thispacket=(paknum+63) mod 64
	add	#77	,r1		; ie, check if this data packet was the
	clr	r0			; one sent the last time. if so, we
	div	#100	,r0		; must reack that packet and remain
	clr	r0			; in the current state.
	cmp	r3	,r1		; insure r0 is not affected
	bne	30$			; not the last packet
	 spack	#'Y,r3			; reack this then
	 clr	numtry			; clear out retry counter
	 movb	state	,r1		; and return current state
	 return

30$:	 movb	#STA.ABO,r1		; otherwise return ABORT since we must
	 return				; be way out of synch then.

40$:	calls	r$attr	,<#packet>	; simple
	tst	r0			; was this successful ?
	bne	50$			; no
	spack	#'Y,paknum
	mov	numtry	,oldtry		; oldtry_count:= numtry
	clr	numtry			; numtry := 0
	incm64	paknum			; increment packet number mod 64
	movb	state	,r1		; retain current state
	br	100$			; all done

50$:	movb	#STA.ABO,r1		; new state
	br	100$			; bye

100$:	return				; exti


200$:	.asciz	/Attribute packet error - /
	.even



	.sbttl	spack	send packet


;	S P A C K $
;
;	spack$(%val type,%val num,%val len, %loc data)
;
;	input:	@r5	type of packet
;		2(r5)	packet number
;		4(r5)	length of the packet
;		6(r5)	location of the data to send
;	output:	r0	error status


spack$:	save	<r1,r2,r3,r4>		; save registers that we may use
	call	spakin
	sub	#200	,sp		; allocate a buffer
	mov	sp	,r4		; point to the buffer
	clr	-(sp)			; count the total length
	setpar	#SOH	,(r4)+		; start all packets with control A 
;-	movb	#SOH	,(r4)+
	mov	r4	,r2		; get address for checksum compute
	inc	@sp			; packetlength := succ(packetlength)
	mov	4(r5)	,r0		; the length of the packet
	cmp	r0	,#maxpak	; packet too large ?
	blos	25$			; no
	mov	#maxpak	,r0		; yes, reset packet size please
25$:	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
;-	movb	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
;-	movb	r0	,(r4)+		; and stuff it into the packet
	inc	@sp			; packetlength := succ(packetlength)
	movb	@r5	,r0		; get the packet type now
	bicb	#40	,r0		; insure UPPER CASE packet type
	setpar	r0	,(r4)+		; insert the packet type into buffer
;-	movb	r0	,(r4)+		; insert the packet type into buffer
	inc	@sp			; packetlength := succ(packetlength)

	mov	4(r5)	,r1		; get the data length
	beq	40$			; nothing to do
	mov	6(r5)	,r3		; address of the data to send
	cmp	r1	,#maxpak	; too much data ?
	blos	30$			; no
	mov	#maxpak	,r1		; yes, fix it please

30$:	clr	r0			; get the next character
	bisb	(r3)+	,r0		; next char
	setpar	r0	,(r4)+		; now move the data byte into the buffer
;-	movb	r0	,(r4)+		; now move the data byte into the buffer
	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
	movb	conpar+p.eol,(r4)+	; end of line needed ?
	inc	@sp			; packetlength := succ(packetlength)
	mov	(sp)+	,r1		; packet length
	mov	sp	,r4		; address(buffer)
	calls	binwri	,<r4,r1,#lun.ti>; and dump the buffer out now
	call	spakfi			; handle ibm stuff if possible


100$:	add	#200	,sp		; pop the buffer
	unsave	<r4,r3,r2,r1>		; pop registers that we used
	return
	
	global	<conpar	,debug>


	.sbttl	spack routines


spakin::bit	#log$pa	,trace		; tracing today ?
	beq	5$			; no
	calls	dskdmp	,<#200$,4(r5),@r5,2(r5),6(r5)>

5$:	tst	pauset			; wait a moment ?
	beq	6$			; no
	calls	suspend	,<pauset>	; yes
6$:	mov	#conpar+p.padc,r2	; address of the pad character ?
	clr	r1
	bisb	conpar+p.npad,r1	; send some pad characters ?
	tst	r1
	beq	20$			; no padding
10$:	calls	binwri	,<r2,#1,#lun.ti>; 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
	 inc	pcnt.s(r1)		; pakcount(type):=pakcount(type)+1
	 inc	pcnt.s+0
30$:	return


200$:	.asciz	/SPACK - /
	.even




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
	tst	ranerr			; insert random checksum errors?
	beq	40$			; no, please don't
	mov	r0	,-(sp)		;+ test mode
	call	irand			;+ test mode
	tst	r0			;+ test mode
	bne	30$			;+ test mode
	incb	@r4			;+ test mode
30$:	mov	(sp)+	,r0		;+ test mode
40$:	setpar	@r4	,(r4)+
	inc	r0			; packetlength := succ(packetlength)
	return

	global	<chktyp	,pauset	,pcnt.s	,ranerr>


	.sbttl	try to handle half duplex handshake garbage ala IBM (barf)


spakfi:	save	<r2>			; don't do this forever please
	tstb	handch			; any paritcular handshake char today?
	beq	100$			; no, just exit please
	cmpb	state	,#'S&137	; sinit time ?
	beq	100$			; yes, don't wait then
	cmpb	handch	,#cr		; waiting for a carriage return?
	bne	5$			; no
	calls	ttxon	,<#ttname,#lun.ti>; get the line turned on again please
5$:	mov	#200	,r2		; a limit on looping please
10$:	calls	binrea	,<#lun.ti,#4>	; wait for XON, max 4 seconds please
	tst	r0			; did the read timeout. if so, exit.
	bne	90$			; exit and try to xon the link
	cmpb	r1	,handch		; is this the handshake character
	beq	100$			; no, try again please
	sob	r2	,10$		; not forever, please
	br	100$			; bye

90$:	save	<r0>			; save error flags
	calls	ttxon	,<#ttname,#lun.ti>; get the line turned on again please
	unsave	<r0>			; pop error

100$:	unsave	<r2>			; pop loop index

	bit	#log$io	,trace		; dumping all i/o out ?
	beq	120$			; no
	save	<r0,r1,r2,r4>		; save these please
	mov	r1	,r2		; anything to do ?
	beq	110$			; no
105$:	clr	r0			; yes, dump ch by ch please
	bisb	(r4)+	,r0		; get the next ch to dump
	mov	#lun.lo	,r1		; the lun to write to
	call	putcr0			; simple
	sob	r2	,105$		; next please
110$:	unsave	<r4,r2,r1,r0>		; pop and exit

120$:	return				; bye

	global	<handch>





	.sbttl	rpack$	read incoming packet


;	R P A C K $
;
;	rpack$(%loc data)
;
;	input:	@r5	buffer address
;		2(r5)	data structure of 3 words to contain the
;			returned length, number and type
;
;	output:	r0	error code if < 0, packet type if > 0
;			255 for checksum error
;
	o$len	=	0		; offset for retruned packet length
	o$num	=	2		; offset for returned packet number
	o$type	=	4		; offset for returned packet type
;
;				word	2	packet type
;				word	1	packet number
;	as in:	2(r5)	------>	word	0	packet length
;
;
;
;	local data offsets from r4 (allocated on the stack
;
	.done	=	0		; if <> 0 then we have the packet
	.type	=	2		; current type of packet
	.ccheck	=	4		; computed checksum
	.rcheck	=	6		; received checksum
	.len	=	10		; received pakcet length
	.timeo	=	12		; current timeout
	.num	=	14		; packet number, received
	.size	=	16		; current size of data portion
	.paksi	=	20		; for loop control for data portion
	.lsize	=	22		; total size of local data


;	internal register usage:
;
;	r0	error return
;	r1	current character just read from remote
;	r3	pointer to temp buffer containing the packet less the SOH
;		and the checksum,  used for computing checksum after  the
;		packet has been read.
;	r4	pointer to local r/w data
;	r5	pointer to argument list

	


	.sbttl	rpack continued


rpack$:	save	<r1,r2,r3,r4>
	sub	#.lsize	,sp		; allocate space for local data
	mov	sp	,r4		; and point to it please
	sub	#200	,sp		; allocate temp buffer for storing
	mov	sp	,r3		; the packet less SOH and checksum
	call	rpakin

	call	waitsoh			; wait for a packet to start
	tst	r0			; did it work or did we timeout
	beq	10$			; yes
	jmp	95$			; we must have timed out then

10$:	tst	.done(r4)		; while not done do
	bne	90$			;  begin

	call	rpakrd			;   read(input,ch);
	bcs	95$			;   exit if error;
	clrpar	r1			;   ch := ch and chr(177B);
	cmpb	r1	,#SOH		;   if ch = SOH then resynch
	beq	80$			;
	movb	r1	,(r3)+		;   checkpacket++ := ch
	unchar	r1	,r0		;   len := unchar(ch)-2-checksum_size
	sub	#2	,r0		;
	sub	chksiz	,r0		;
	bge	15$			;   if datalength < 0
	 add	chksiz	,r0		;    then
	 dec	r0			;	len := len + checksum_size - 1
	 movb	#defchk	,chktyp		;       checksum_type := default_type
	 mov	#1	,chksiz		;       checksum_len  := 1
15$:	mov	r0	,.len(r4)	;

	call	rpakrd			;   read(input,ch)
	bcs	95$			;   exit if error
	clrpar	r1			;   ch := ch and chr(177B)
	cmpb	r1	,#SOH		;   if ch = SOH then resynch
	beq	80$			;
	movb	r1	,(r3)+		;   checkpacket++ := ch
	unchar	r1	,.num(r4)

	call	rpakrd			;   read(input,ch)
	bcs	95$			;   exit if error
	clrpar	r1			;   ch := ch and chr(177B)
	cmpb	r1	,#SOH		;   if ch = SOH then resynch
	beq	80$			;
	movb	r1	,(r3)+		;   checkpacket++ := ch
	mov	r1	,.type(r4)	;   packet_type := ch

	mov	.len(r4),.paksi(r4)	;   loop for the data, if any
	mov	@r5	,r2		;   point to the buffer now

20$:	tst	.paksi(r4)		;   for i := 1 to len do
	beq	30$			;    begin
	call	rpakrd			;     read(input,ch)
	bcs	95$			;     exit if error
	clrpar	r1			;     ch := ch and chr(177B)
	cmpb	r1	,#SOH		;     if ch = SOH then resynch
	beq	80$			;
	cmp	.size(r4),#maxpak	;     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	.paksi(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 line error (like timeout)

	mov	sp	,.done(r4)
80$:	br	10$


90$:	call	rpakfi			; finish checksum and return the
	br	100$

95$:	mov	2(r5)	,r1		; timeout error, flag no packet
	clr	r0			; nonfatal error for timout
	mov	#timout	,o$type(r1)	; return as psuedo packet type
	mov	#timout	,.type(r4)	; return as psuedo packet type
	call	rpakst			; do stats and disk dumping now

100$:	add	#.lsize+200,sp		; pop local data + local buffer
	unsave	<r4,r3,r2,r1>
	return

	global	<chktyp>



	.sbttl	subroutines for RPACK only

rpakrd:	calls	binrea	,<#lun.ti,.timeo(r4)>; read(input,ch)
	tst	r0			; did it work
	bne	110$			; no
	call	rawio			; perhaps raw i/o logging
	bit	#log$rp	,trace		; dump to a local terminal ?
	beq	20$			; no
	cmpb	r1	,#SOH		; start of a packet ?
	beq	10$			; yes
	movb	r1	,-(sp)		; yes, stuff the ch onto the stack
	mov	sp	,r1		; point to it
	print	r1	,#1		; dump it
	clr	r1			; restore what we read and exit
	bisb	(sp)+	,r1		; restore it and exit
	br	20$			; bye
10$:	print	#200$			; start of a packet
20$:	clr	r0			; no errors
	clc				; it worked
	return				; bye

110$:	save	<r0>			; save the error code
	calls	ttxon	,<#ttname,#lun.ti>; get the line turned on again please
	unsave	<r0>			; restore the error code
	sec				; flag the error
	return				; bye

200$:	.asciz	<cr><lf>/<SOH>/
	.even



rpakin:	clr	.done(r4)		; done := false
	clr	.type(r4)		; packettype := 0
	clr	.ccheck(r4)		; checksum := 0
	clr	.rcheck(r4)		; received_checksum := 0
	clr	.len(r4)		; current length := 0
	clr	.num(r4)		; packet_number  := 0
	clr	.timeo(r4)		; timeout := 0
	clr	.size(r4)		; current size of data part of packet
	clr	.paksi(r4)		; loop control for data of packet
	mov	@r5	,r0		; initialize the buffer to null
	mov	#40	,r1
10$:	clrb	(r0)+			; simple
	clrb	(r0)+			; simple
	sob	r1	,10$
	mov	2(r5)	,r0		; return parameters
	clr	(r0)+			; packet.length := 0
	clr	(r0)+			; packet.number := 0
	clr	(r0)+			; packet.type   := 0
	call	settmo
	mov	r0	,.timeo(r4)
	return


settmo:	mov	sertim	,r0		; if waiting for server command
	bne	20$			;  then use that timeout
	clr	r0			;
	bisb	conpar+p.time,r0	; get the remotes timeout
	bne	10$			; ok
	mov	#mytime	,r0		; no good, setup a timeout
10$:	cmpb	r0,setrec+p.time	; use SET TIMEOUT value if >
	bhis	20$			; no, use the timeout as in
	clr	r0			; ok, use the value the user said
	bisb	setrec+p.time,r0	; in the SET TIMEOUT command
	bne	20$			; must be > 0 by now
	mov	#mytime	,r0		; no ??
20$:	return

	global	<conpar	,setrec	,sertim>

	.sbttl	finish up rpack



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 checksum with the
	beq	100$			; actual checksum
	mov	#badchk	,.type(r4)	; flag checksum error

100$:	mov	2(r5)	,r1		; where to return some things
	mov	.len(r4),o$len(r1)	; return the packet length
	mov	.type(r4),o$type(r1)	; and the packet type
	mov	.num(r4),o$num(r1)	; and at last, the packet number
	call	rpakst			; do stats and logging now
	call	rpaklo			; possibly log checksum errors?
	return


rpakst:	cmpb	.type(r4),#'A&137	; count the packet types for stats
	blo	110$			; bad packet type
	cmpb	.type(r4),#'Z&137	; must in the range A..Z
	bhi	110$			; definiately a bad packet
	 movb	.type(r4),r1		; packet is ok, add it to the stats
	 sub	#100	,r1		; convert to 1..26
	 asl	r1			; to word offsets
	 inc	pcnt.r(r1)		; simple
	 inc	pcnt.r+0

110$:	bit	#log$pa	,trace		; tracing today ?
	beq	120$			; no
	calls	dskdmp	,<#200$,.len(r4),.type(r4),.num(r4),@r5>

120$:	return

200$:	.asciz	/RPACK - /
	.even


rpaklo:	save	<r0>
	cmp	.rcheck(r4),.ccheck(r4)	; checksums match ?
	beq	100$			; yes, do nothing then
	bit	#log$io	,trace		; not if in raw i/o mode
	bne	100$			; forget it
	sub	#60	,sp		; dump bad checksums out to disk
	mov	sp	,r1		; point to the buffer
	copyz	#200$	,r1		; 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
	deccvt	.ccheck(r4),r1		; the calculated checksum
	add	#6	,r1		; make it .asciz
	clrb	@r1			; simple
	mov	sp	,r1		; point back to the buffer
	strlen	r1			; get the length
	calls	putrec	,<r1,r0,#lun.lo>; dump buffer to disk
	add	#60	,sp		; pop buffer and exit
100$:	unsave	<r0>			; pop r0 and exit
	return

200$:	.asciz	/?Bad Checksum: rcv,calc are /
	.even
	
	global	<pcnt.r	,sertim	,trace>



	.sbttl	read and convert the checksum for RPACK


rpakck:	save	<r3>			;   use r3 for accumulating check
	clr	r3			;   assume zero for now
	call	rpakrd			;   read(input,ch)
	bcs	110$			;   exit if error
	bic	#^c177	,r1		;   ch := ch and 177B
	unchar	r1	,r3		;   received_check := ch
	cmpb	chktyp	,#defchk	;   if len(checksum) > 8bits
	blos	10$			;    then begin
	 ash	#6	,r3		;     check := check * 64
	 call	rpakrd			;     read(input,ch)
	 bcs	110$			;     exit if error
	 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
	br	120$

110$:	sec
120$:	mov	r3	,.rcheck(r4)	;    return the checksum
	unsave	<r3>
	return
	


	.sbttl	parity routines

;	C L R P A R
;
;	input:	2(sp)	the character to clear parity for
;	output:	2(sp)	the result
;
;	caller by CLRPAR macro
;
;	If parity is set to anything but NONE then always
;	clear the parity out else clear it if and only if
;	filetype is not image mode.


clrpar::tstb	parity			; handle nothing please (no parity)
	beq	10$			; yes
	cmpb	parity	,#par$no	; set parity none used ?
	bne	20$			; no, must be some other type
10$:	tst	image			; no parity, image mode today ?
	bne	100$			; yes, leave things alone please
20$:	bic	#^C177	,2(sp)		; no, clear bits 7-15 please
100$:	return				; bye


	global	<parity>
	


	.sbttl	compute proper checksum please

;	C H E C K S
;
;	input:	2(sp)	address of .asciz string to compute checksum for
;	output:	@sp	the computed checksum



checks::save	<r0,r1,r2,r3>		; save registers we may use
	mov	12(sp)	,r2		; point to the string to do it for
	clr	12(sp)			; assume a zero checksum ?

	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-CCITT
	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
	cmpb	parity	,#par$no	; did the packet contain parity?
	beq	15$			; no, leave bit 7 alone
	bic	#^C177	,r3		; yes, please clear bit seven
15$:	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	,12(sp)		; return the checksum
	

100$:	unsave	<r3,r2,r1,r0>		; exit
	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  PDP11  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>	; save registers please
	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 pdp11 sign extend
	cmpb	parity	,#par$no	; 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 word addressing
	asl	r2			; times 2 for word addressing
	mov	crctb2(r1),r1		; get low portion of CRC factor
	ixor	crctab(r2),r1		; simple (limited modes for XOR)
	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>	; pop saved r1-r5
	return


; Data tables for CRC-CCITT generation

crctab:	.word	0
	.word	10201
	.word	20402
	.word	30603
	.word	41004
	.word	51205
	.word	61406
	.word	71607
	.word	102010
	.word	112211
	.word	122412
	.word	132613
	.word	143014
	.word	153215
	.word	163416
	.word	173617

crctb2:	.word	0
	.word	10611
	.word	21422
	.word	31233
	.word	43044
	.word	53655
	.word	62466
	.word	72277
	.word	106110
	.word	116701
	.word	127532
	.word	137323
	.word	145154
	.word	155745
	.word	164576
	.word	174367






	.sbttl	clear stats out

;	C L R S T A
;
;	clear out the packet counts by packet type from the last
;	transaction and add them into the total running count by
;	packet type.

clrsta:	save	<r0,r1,r2>		; save the registers we use
	mov	#pcnt.r	,r1		; packets received
	mov	#totp.r	,r2		; running count so far
	mov	#34	,r0		; number of works to add/clear
10$:	add	@r1	,(r2)+		; add in the current totals
	clr	(r1)+			; and clear out the totals
	sob	r0	,10$		; next please
	mov	#pcnt.s	,r1		; now for the packets sent
	mov	#totp.s	,r2		; where to add them in
	mov	#34	,r0		; number of words to do
20$:	add	@r1	,(r2)+		; sum in the total sent count
	clr	(r1)+			; and clear them out
	sob	r0	,20$		; next please
	unsave	<r2,r1,r0>		; pop the registers we used
	return				; and exit

	global	<pcnt.r	,pcnt.s	,totp.r	,totp.s>


	.sbttl	waitsoh	wait for a packet start (ascii 1, SOH)


;	W A I T S O H
;
;	input:	nothing
;	output:	r0	error code
;		r1	the SOH or NULL if we timed out

waitsoh:clr	r1			; 
10$:	cmpb	r1	,#soh		; wait for a packet header please
	beq	100$			; ok, exit
	call	settmo			; get proper timeout set up
	calls	binrea	,<#lun.ti,r0>	; read with timeout
	clrpar	r1
	tst	r0			; did the read work ?
	bne	20$			; oops, just exit then
	call	rawio
	br	10$
20$:	clr	r1
100$:	return


	global	<conpar	,sertim>

rawio:	bit	#log$io	,trace		; dumping all i/o today?
	beq	100$			; no
	save	<r0,r1>			; yes, save these please
	clr	r0
	bisb	r1	,r0		; and setup call to putcr0
	mov	#lun.lo	,r1		; the unit to write to
	call	putcr0			; simple
	unsave	<r1,r0>			; pop these now
100$:	return


	.sbttl	BUFFIL	buffer from the file that is being sent


;	B U F F I L
;
;	input:	@r5	buffer address
;	output:	r0	rms sts error code
;		r1	length of the string

buffil:	save	<r2,r3,r4>		; save all registers we may use
	mov	@r5	,r4		; point to the destination address
	clr	r3			; use as a length counter

10$:	mov	#lun.in	,r0		; while error = 0 do
	call	getcr0			;  begin
	tst	r0			;   ch := infile@;
	bne	90$			;   get(infile);
	clr	r2			;
	bisb	r1	,r2		;   ch0_7 := ch '
	bic	#^C177	,r2		;   ch0_7 := ch0_7 and 177B
	cmpb	r2	,#space		;   if ch0_7 < space
	blo	20$			;    or
	cmpb	r2	,#del		;      ch0_7 = del
	beq	20$			;    or
	cmpb	r2	,conpar+p.qctl	;      ch0_7 = quote
	bne	40$			;     then
					;      begin
20$:	movb	conpar+p.qctl,(r4)+	;	buffer[i] := quote
	inc	r3			;	length := succ(length)
	cmpb	r2	,conpar+p.qctl	;	if ch0_7 <> quote
	beq	30$			;	 then begin
	ctl	r1	,r1		;	  ch := ctl(ch)
	ctl	r2	,r2		;	  ch0_7 := ctl(ch0_7) end
30$:					;      end
40$:	tst	image			;   if image_mode
	beq	50$			;    then
	movb	r1	,(r4)+		;     buffer[i] := ch
	br	60$			;    else
50$:	movb	r2	,(r4)+		;     buffer[i] := ch0_7
60$:	inc	r3			;   length := succ( length )

70$:	clr	-(sp)
	bisb	conpar+p.spsiz,@sp	;  exit if length > spsize-8
	sub	#10	,@sp		;
	cmp	r3	,(sp)+		;
	blo	10$			; end

90$:	mov	r3	,r1		; return the length please
	beq	100$			; nothing there
	clr	r0			; say read was successful
100$:	unsave	<r4,r3,r2>		; and exit
	return


	global	<getcr0	,image	,conpar>



	.sbttl	bufpak	buffil but get data from a buffer


;	input:	@r5	source buffer, .asciz
;	output:	2(r5)	destination buffer
;		r0	zero (ie, no errors are possible)
;		r1	string length
;
;	No 8 bit prefixing  and no repeat counts will be done.
;	This routine is used for encoding string to be sent as
;	generic commands to a server.


bufpak::save	<r2,r3,r4,r5>		; save all registers we may use
	mov	2(r5)	,r4		; point to the destination address
	mov	@r5	,r5		; the source string
	clr	r3			; use as a length counter

10$:	clr	r1			; ch := buffer[i]
	bisb	(r5)+	,r1		; avoid PDP-11 sign extension
	beq	90$			;   
	clr	r2			;
	bisb	r1	,r2		;   ch0_7 := ch '
	bic	#^C177	,r2		;   ch0_7 := ch0_7 and 177B
	cmpb	r2	,#space		;   if ch0_7 < space
	blo	20$			;    or
	cmpb	r2	,#del		;      ch0_7 = del
	beq	20$			;    or
	cmpb	r2	,conpar+p.qctl	;      ch0_7 = quote
	bne	40$			;     then
					;      begin
20$:	movb	conpar+p.qctl,(r4)+	;	buffer[i] := quote
	inc	r3			;	length := succ(length)
	cmpb	r2	,conpar+p.qctl	;	if ch0_7 <> quote
	beq	30$			;	 then begin
	ctl	r1	,r1		;	  ch := ctl(ch)
	ctl	r2	,r2		;	  ch0_7 := ctl(ch0_7) end
30$:					;      end
40$:	tst	image			;   if image_mode
	beq	50$			;    then
	movb	r1	,(r4)+		;     buffer[i] := ch
	br	60$			;    else
50$:	movb	r2	,(r4)+		;     buffer[i] := ch0_7
60$:	inc	r3			;   length := succ( length )

70$:	clr	-(sp)
	bisb	conpar+p.spsiz,@sp	;  exit if length > spsize-8
	bne	80$			;  if spsiz = 0
	 mov	#maxpak	,@sp		;   then maxsize := #maxpak
80$:	sub	#10	,@sp		;
	cmp	r3	,(sp)+		;
	blo	10$			; end


90$:	mov	r3	,r1		; return the length please
	clr	r0			; say read was successful
	unsave	<r5,r4,r3,r2>		; and exit
	return




	.sbttl	bufemp	dump a buffer out to disk

;	B U F E M P
;
;	bufemp(%loc buffer,%val len)
;
;	input:	@r5	buffer address
;		2(r5)	length
;	output:	r0	error


bufemp:	save	<r1,r2,r3>		; save temps as usual
	mov	@r5	,r2		; input record address
	mov	2(r5)	,r3		; string length
	clr	r0			; insure no error for a null packet

10$:	tst	r3			; anything left in the record?
	beq	100$			; no
20$:	clr	r0			; get the next character
	bisb	(r2)+	,r0		; into a convienient place
	dec	r3			; chcount := pred(chcount)
	cmpb	r0	,senpar+p.qctl	; is this a quoted character?
	bne	30$			; no
	clr	r0			; yes, get the next character
	bisb	(r2)+	,r0		; must be one you know
	dec	r3			; chcount := pred(chcount)
	clr	r1			; must avoid sign extension here
	bisb	r0	,r1		; check low 7 bits against quote
	bic	#^C177	,r1		; drop 7..15
	cmpb	r1	,senpar+p.qctl	; if ch <> myquote
	beq	30$			;  then
	cmpb	r1	,#77		;   and ch ge '?'
	blo	30$			;    then
	ctl	r0	,r0		;     ch := ctl(ch);

30$:	mov	#lun.ou	,r1		; channel_number := lun.out
	tst	outopn			; is there really something open?
	bne	40$			; yes, put the data to it
	clr	r1			; no, direct the output to a terminal
40$:	call	putcr0			; and do it
	br	10$			; next character please

100$:	unsave	<r3,r2,r1>
	return

	global	<putcr0	,outopn	,senpar>
	.sbttl	bufunpack	like bufemp, but return data to a buffer


;	input:	@r5	source buffer, .asciz
;	output:	2(r5)	destination buffer
;		r0	zero (ie, no errors are possible)
;		r1	string length
;
;	No 8 bit prefixing  and no repeat counts will be done.
;	This routine is used for decoding strings received for
;	generic commands to the server.



bufunp::save	<r2,r3,r4>		; save temps as usual
	mov	@r5	,r2		; input record address
	clr	r3			; length := 0
	mov	2(r5)	,r4		; resultant string

10$:	clr	r0			; get the next character
	bisb	(r2)+	,r0		; into a convienient place
	beq	100$
	cmpb	r0	,senpar+p.qctl	; is this a quoted character?
	bne	30$			; no
	clr	r0			; yes, get the next character
	bisb	(r2)+	,r0		; must be one you know
	clr	r1			; must avoid sign extension here
	bisb	r0	,r1		; check low 7 bits against quote
	bic	#^C177	,r1		; drop 7..15
	cmpb	r1	,senpar+p.qctl	; if ch <> myquote
	beq	30$			;  then
	ctl	r0	,r0		;   ch := ctl(ch);

30$:	movb	r0	,(r4)+		; copy the byte over now
	inc	r3			; length := succ(length)
	br	10$			; next character please

100$:	clrb	@r4			; make the string .asciz
	mov	r3	,r1		; return the length
	clr	r0			; fake no errors please
	unsave	<r4,r3,r2>		; pop registers and exit
	return





	.sbttl	spar	fill will my send-init parameters

	.if ne	,0
	.ift

;	S P A R
;
;	spar( %loc data )
;
;	input:	@r5	address of array [0..9] of char

spar:	save	<r0,r1,r2>		; save registers we may use
	mov	#.sparsz,sparsz		; copy the send init packet size
	tst	sendat			; attribute support disabled today?
	bne	10$			; no
	mov	#11	,sparsz		; yes, shorten the packet up
10$:	mov	@r5	,r2		; point to the destiniation
	mov	#senpar	,r1		; and our local parameters
	tochar	(r1)+	,(r2)+		; senpar.spsiz
	tochar	(r1)+	,(r2)+		; senpar.time
	tochar	(r1)+	,(r2)+		; senpar.npad
	ctl	(r1)+	,(r2)+		; senpar.padc
	tochar	(r1)+	,(r2)+		; senpar.eol
	movb	(r1)+	,(r2)+		; senpar.qctl
	movb	(r1)+	,(r2)+		; senpar.qbin
	movb	(r1)+	,(r2)+		; senpar.chkt
	movb	(r1)+	,(r2)+		; senpar.rept
	tochar	(r1)+	,(r2)+		; senpar.capas
	tochar	(r1)+	,(r2)+		; senpar.capas+1
	clrb	(r2)+			; end
	unsave	<r2,r1,r0>
	return


fixchk::tstb	setsen+p.chkt		; did the user ever set block-check?
	beq	100$			; no
	cmpb	setsen+p.chkt,#'1	; insure that it's legit
	blo	100$
	cmpb	setsen+p.chkt,#'3	; insure that it's legit
	bhi	100$
	movb	setsen+p.chkt,senpar+p.chkt
100$:	return

	.sparsz	==	13		; 10 parameters to send over

sparin::save	<r1>			; save registers we may use
	mov	#.sparsz,sparsz		; copy the send init packet size
	tst	sendat			; attribute support disabled today?
	bne	10$			; no
	mov	#11	,sparsz		; yes, shorten the packet up
10$:	mov	#senpar	,r1		; where to put them
	movb	#maxpak	,(r1)+		; maximum packet size
	movb	#mytime	,(r1)+		; my desired timeout
	movb	#mypad	,(r1)+		; how much padding
	movb	#mypchar,(r1)+		; whatever i use for padding
	movb	#myeol	,(r1)+		; line terminators (don't need it)
	movb	#myquote,(r1)+		; quoting ?
	movb	#myqbin	,(r1)+		; do quoting ?
	movb	#mychkt	,(r1)+		; checksum type
	movb	#myrept	,(r1)+		; default on the rest of it
	movb	#mycapa	,(r1)+		; we can read attributes
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	unsave	<r1>
	return

	global	<setrec	,senpar	,setsen	,sparsz>
	.sbttl	rpar	read senders initialization parameters

;	R P A R
;
;	rpar( %loc msgpacket, %val size )
;
;	input:	@r5	message packet to get data from
;		2(r5)	packet length
;	output:	REMPAR[0..20] of parameters

rpar:	save	<r0,r1,r2>		; save registers we may use
	clr	do8bit			; no 8 bit stuff for now
	mov	@r5	,r1		; incoming packet address
	mov	2(r5)	,r0		; size
	mov	#conpar	,r2		; address of remotes parameters
	unchar	(r1)+	,(r2)+		; conpar.spsiz
	dec	r0			; exit if no more data
	beq	1$			; all done
	unchar	(r1)+	,(r2)+		; conpar.time
	dec	r0			; exit if no more data
	beq	1$			; all done
	unchar	(r1)+	,(r2)+		; conpar.npad
	dec	r0			; exit if no more data
	beq	1$			; all done
	ctl	(r1)+	,(r2)+		; conpar.padc
	dec	r0			; exit if no more data
	beq	1$			; all done
	unchar	(r1)+	,(r2)+		; conpar.eol
	dec	r0			; exit if no more data
	beq	1$			; all done
	movb	(r1)+	,(r2)+		; conpar.qctl
	dec	r0			; exit if no more data
	beq	1$			; all done
	movb	(r1)+	,(r2)+		; conpar.qbin
	dec	r0			; exit if no more data
	beq	1$			; all done
	movb	(r1)+	,(r2)+		; conpar.chkt
	dec	r0			; exit if no more data
	beq	1$			; all done
	movb	(r1)+	,(r2)+		; conpar.rept
	dec	r0			; exit if no more data
	beq	1$			; all done
	unchar	(r1)+	,(r2)+		; conpar.capas
1$:	clrb	(r2)+
	mov	#conpar	,r2		; now clear parity off please in
	mov	#12	,r0		; case an IBM system set it.
5$:	bicb	#200	,(r2)+		; simple
	sob	r0	,5$		; next please
	mov	#setrec	,r0		; check to see if we need to
	mov	#conpar	,r1		; override any of the sinit stuff
	movb	p.spsiz(r0),r2		; if user set packetsize
	beq	10$			;  then
	movb	r2	,p.spsiz(r1)	;   conpar.size := setrec.size
10$:	movb	p.eol(r0),r2		; if user set endofline
	beq	20$			;  then
	movb	r2	,p.eol(r1)	;   conpar.eol := setrec.eol
20$:	movb	p.time(r0),r2		; if user set timeout
	beq	30$			;  then
	movb	r2	,p.time(r1)	;   conpar.time := setrec.time
30$:	tstb	p.chkt(r1)		; if checksum_type = null
	bne	40$			;  then
	movb	#defchk	,p.chkt(r1)	;   checksum_type := default
40$:	movb	p.chkt(r1),senpar+p.chkt; setup for type of checksum used
	unsave	<r2,r1,r0>
	return

rparin::save	<r1>			; save registers we may use
	mov	#conpar	,r1		; where to put them
	movb	#maxpak	,(r1)+		; maximum packet size
	movb	#mytime	,(r1)+		; my desired timeout
	movb	#mypad	,(r1)+		; how much padding
	movb	#mypchar,(r1)+		; whatever i use for padding
	movb	#myeol	,(r1)+		; line terminators (don't need it)
	movb	#myquote,(r1)+		; quoting ?
	movb	#myqbin	,(r1)+		; do quoting ?
	movb	#mychkt	,(r1)+		; checksum type
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	unsave	<r1>
	return

	global	<conpar	,do8bit	,setrec>


	.endc

	global	<spar	,rpar	,fixchk>

	.sbttl	printm	print message if not remote

;	P R I N T M
;
;	input:	@r5	arg count
;		2(r5)	text for message #1
;		4(r5)	and so on

	.enabl	lsb


printm:	save	<r0,r1,r5>		; save registers we will use
	mov	(r5)+	,r1		; get the message count
	beq	100$			; nothing to do
	tst	remote			; skip if we are the remote
	bne	100$			; yep
	message	<Kermit: >		; a header
10$:	mov	(r5)+	,r0
	.print	r0			; now loop thru printing the stuff
	sob	r1	,10$		; next please
	message				; a <cr><lf>
100$:	unsave	<r5,r1,r0>		; pop temps
	return				; and exit

	global	<remote>

	.dsabl	lsb
	.sbttl	error message printing

;	E R R O R
;
;	error(%val msgcount,%loc msg1, %loc msg2,....)
;
;	Error sends the message text if we are remote else
;	it prints it out as in the baseline KERMIT.C

	erbfsiz	=	100.

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$			; bye

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		; length so far

30$:	mov	(r5)+	,r3		; get the next message please
40$:	movb	(r3)+	,@r4		; now copy it to the buffer until
	beq	50$			; we get an ascii null (chr(0))
	cmpb	@r4	,#'$		; apparently CPM systems don't like
	bne	45$			; dollar symbols ?
	movb	#'_	,@r4		; so stuff a '_' in instead
45$:	inc	r4
	sob	r2	,40$		; no, go until we get one or run
	br	60$			; out of space to put it
50$:	movb	#40	,(r4)+		; insert a space in there
	dec	r2			; insure sufficient space
	beq	60$			; no
	sob	r1	,30$		; and get the next message

60$:	clrb	@r4			; inaure .asciz
	mov	sp	,r4		; all done, send the ERROR packet
	strlen	r4			; get the length
	spack	#'E,paknum,r0,r4	; and send it
	add	#erbfsiz+2,sp		; deallocate the text buffer

100$:	unsave	<r5,r4,r3,r2,r1>	; and exit
	return

	global	<paknum	,remote>
	.sbttl	print received error packet out

;	P R E R R P
;
;	prerrp(%loc msg)
;
;	input:	@r5	address of .asciz string to print


prerrp::.print	#200$
	.print	@r5
	.newli
	return

	.enabl	lc
200$:	.asciz	/Kermit aborting with error from remote /
	.even
	.sbttl	get next file to send


;	G E T N X T
;
;	input:	srcnam	possibly wildcarded filename
;		index	flag if eq 0 then this is the first time thru
;	output:	filnam	next file to do
;		r0	<> 0 then abort
;	
;	RSTS and RSX11M/M+
;
;	 Lookup uses the RMS version 2 $SEARCH macro to do the directory
;	operation.  For RT11 we will simply  NOP  the $SEARCH since RT11
;	does  not support directory lookup operations in the EXEC.  Thus
;	the error codes ER$NMF (no more files) and ER$FNF are referenced
;	directly here.
	


getnxt::save	<r1>
	calls	lookup	,<#3,#srcnam,#index,#filnam>
	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			; sent any files yet ?
	bne	100$			; yes, that's ok then
	mov	#ER$FNF	,r0		; no, convert ER$NMF to ER$FNF

30$:	mov	r0	,-(sp)		; save r0 please
	calls	syserr	,<r0,#errtxt>	; not so good. Get the error text
	mov	#filnam	,r1		; assume the filename parse worked
	calls	fparse	,<#srcnam,#filnam>; quite possibly it may not have
	tst	r0			; so decide whether to send the
	beq	40$			; origonal name or the expanded
	mov	#srcnam	,r1		; filename in the error packet.
40$:	calls	error	,<#2,#errtxt,r1>; and send/print it out
	mov	(sp)+	,r0		; pop saved error code from lookup

100$:	unsave	<r1>
	return

	global	<er$fnf	,er$nmf	,errtxt	,filnam	,index	,srcnam>

	.sbttl	xor and scanch


l$xor::	save	<r0>
	mov	4(sp)	,r0
	ixor	#100	,r0
	mov	r0	,4(sp)
	unsave	<r0>
	return
	


;	S C A N C H 
;
;	input:	4(sp)	the string address
;		2(sp)	the character to look for
;	output:	r0	position of ch in string


scanch::save	<r2>			; save temps
	mov	6(sp)	,r2		; get address of the string
	clr	r0			; initial found position
10$:	tstb	@r2			; end of the string yet ?
	beq	90$			; yes
	inc	r0			; no, pos := succ(pos)
	cmpb	4(sp)	,(r2)+		; does the ch match the next one?
	bne	10$			; no, try again
	br	100$			; yes, exit loop
90$:	clr	r0			; failure, return postion = 0
100$:	unsave	<r2>			; pop r2
	mov	@sp	,4(sp)		; move return address up
	cmp	(sp)+	,(sp)+		; pop stack
	return				; and exit


;	random things for testing


irand::	tst	testc
	bne	10$
	mov	#1234.	,testc
10$:	mov	testc	,r0
	mov	r1	,-(sp)
	mov	r0	,r1
	ash	#-4	,r1
	bic	#170000	,r1
	xor	r1	,r0
	ash	#13	,r1
	bic	#100000	,r1
	xor	r1	,r0
	bic	#100000	,r0
	mov	r0	,testc
	ash	#-13	,r0
	mov	(sp)+	,r1
	return

	global	<testc>




	.sbttl	compute parity for an outgoing 8 bit link


;	This  is  software  parity generation as some DEC interfaces
;	and some DEC executives don't know how  to  compute  parity.
;	There  are  two  methods given here for ODD and EVEN genera-
;	tion. One is from Frank da Cruz's 20KERMIT.MAC and  does  it
;	by  computing  it.  The other method is from the pascal RT11
;	Kermit (by Phil Murton) and does a table lookup  to  compute
;	the  parity. For the sake of speed and the fact that some RT
;	systems lack certain instructions  we  will  use  the  later
;	method at a slight cost in space. 

	parlok	=	1		; use table lookup method



	.assume	par$od	eq 1		; set parity odd
	.assume	par$ev	eq 2		; set parity even
	.assume	par$ma	eq 3		; set parity mark
	.assume	par$sp	eq 4		; set parity space
	.assume	par$no	eq 5		; set parity none


	.psect	$pdata
pardsp:	.word	none.p,	odd.p,	even.p	,mark.p	,spac.p	,none.p
	.psect	$code



dopari::save	<r0,r1,r2,r3>		; save things we will use
	mov	parity	,r3		; get the current parity setting
	asl	r3			; times 2
	mov	12(sp)	,r1		; get the character to do it to
	jsr	pc	,@pardsp(r3)	; and dispatch as desired
	mov	r1	,12(sp)		; return the character please
	unsave	<r3,r2,r1,r0>		; pop and exit
	return


none.p:	return				; do nothing

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



	.sbttl	odd/even parity generation

	.if eq	,parlok			; what kind of parity generation
	.ift				; to use


even.p:	bic	#^c177	,r1		; insure no high bits are set
	mov	r1	,r2		; copy
	call	par			; and do it
	return

odd.p:	bic	#^c177	,r1		; insure only bits 0..6
	mov	r1	,r2		; copy it
	bisb	#200	,r2		; and set bit seven
	call	par			; do it
	return				; bye

par:	mov	#200	,r3		; xor instruction is strange
	ash	#-4	,r2		; move the high four bits down
	bic	#^C17	,r2		; clear bit 7's right propagation
	ixor	r1	,r2		; fold source character into one
	bic	#^C17	,r2		; insure we have only 4 bits today
	mov	r2	,r3		; now check if bits 2 and 3 are
	asr	r3			; /2
	asr	r3			; /2
	cmpb	r3	,#3		; both high or both low
	beq	10$			; both high
	tstb	r3			; both low ?
	bne	20$			; no, don't set any parity then
10$:	ixor	#200	,r1		; yes, toggle parity now
20$:	bic	#^C3	,r2		; ok, now see if the low 2 bits are
	cmpb	r2	,#3		; both either on or off
	beq	30$			; both are on, set parity
	tstb	r2			; perhaps only one bit is on?
	bne	40$			; yep
30$:	ixor	#200	,r1		; toggle the bit then
40$:
	return				; bye

	.endc				; if eq, parlok




	.sbttl	odd/even parity generation via lookup

	.if ne	,parlok			; use this method ?
	.ift				; yes


odd.p:	bic	#^c177	,r1
	tstb	partab(r1)
	bne	100$
	bisb	#200	,r1
100$:	return

even.p:	bic	#^c177	,r1
	tstb	partab(r1)
	beq	100$
	bisb	#200	,r1
100$:	return


;	Table of parity setting for ascii 0-177
;	From Phil Murton's RTLINE.PAS

partab:	.byte	0,1,1,0,1,0,0,1		; first 8 ascii characters
	.byte	1,0,0,1,0,1,1,0
	.byte	1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1
	.byte	1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1
	.byte	0,1,1,0,1,0,0,1
	.byte	1,0,0,1,0,1,1,0
	.byte	1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1
	.byte	0,1,1,0,1,0,0,1
	.byte	1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1
	.byte	1,0,0,1,0,1,1,0
	.byte	1,0,0,1,0,1,1,0
	.byte	0,1,1,0,1,0,0,1		; last eight ascii characters (to 177)

	.endc				; if ne, parlok






	.end
