k11ini.mac

	.title	k11ini	initialization and rarely used routines
	.ident	/3.42/


;	03-Jul-84  09:34:32  Brian Nelson
;
;	Copyright (C) 1984 Change Software, Inc.
;
;
;	Remove Kermit init code and routines like SPAR and RPAR that
;	are only called once per file transfer. Placed into  overlay
;	with K11ATR.  This was  done to reduce the  task size a bit.
;	Really, the only system the size is a problem is on RT11.





	.if ndf, K11INC
	.ift
	.include	/IN:K11MAC.MAC/
	.endc

	.iif ndf, k11inc, .error	; missing .INCLUDE for K11MAC.MAC
	.enabl	gbl
	.psect	$code

	.macro	$chkb	val	,reg	,?a
	tstb	@reg
	bne	a
	movb	val	,@reg
a:	inc	reg
	.endm	$chkb





	.sbttl	initialize ourselves

	.iif ndf, SOH, SOH = 1

kerini::call	init0
	call	init1
	return


init0:	mov	#rwdata	,r0		; first of all, clear all read/write
	mov	#rwsize/2,r1		; data out please
10$:	clr	(r0)+			; for i := 1 to rwdata_size
	sob	r1	,10$		;  do data[i] := 0 ;
	mov	sp	,remote		; /42/ (Moved) assume remote
	mov	#1	,blip		; assume logging all packets to tty
	clrb	defdir			; /51/ Moved it
	call	xinit			; /42/ Moved call forward
	mov	#15	,recdlm		; /56/ Assume CR
	mov	#-1	,setrpt		; assume we will do repeat counts
	mov	sp	,doattr		; default to sending attr packets
	mov	do$lng	,dolong		; /42/ We want long packets if doable
	mov	sp	,doauto		; default to cecking file attributes
	mov	do$exi	,exieof		; /45/ Exit on end of mcr command line
	call	rparini			; default remotes sinit parameters
	call	sparini			; initialize my sinit parameters
	mov	#60.	,serwait	; /41/ Support SET SERVER [NO]WAIT
	mov	argbuf	,argpnt		;
	mov	#SOH	,recsop		; assume control A please
	mov	#SOH	,sensop		; assume control A please
	mov	#mx$try	,maxtry		; initialize retry limit
	mov	#defchk	,chktyp		; set the default checksum type
	movb	#defchk	,setsen+p.chkt	; here also please
	movb	#defchk	,setrec+p.chkt	; here also please
	mov	#defdly	,sendly		; init the delay for send command
	mov	#1	,chksiz		; and the default checksum size
	mov	#par$no	,parity		; default the parity type please
	copyz	#defprm	,#prompt	; set the prompt up
	mov	sp	,con8bit	; assume 8 bits are ok for console
	tst	vttype			; did xinit set this up?
	bne	20$			; yes
	mov	#tty	,vttype		; default to hardcopy console
20$:	tst	proflg			; if pro/350 then vt100
	beq	30$			; not
	mov	#vt100	,vttype		; yes
	clr	con8bit			; also say we want 7 bit data at connect
30$:	return				; end

	.enabl	lc
	.save
	.psect	$PDATA	,D
defprm:	.asciz	/Kermit-11>/
	.even
	.restore


	.enabl	lsb

init1::	nop				; can always patch this with a 207
	mov	#200$	,r3		; try to open an INIT file somewhere
10$:	tst	@r3			; any more to open up ?
	beq	100$			; no
	calls	open	,<(r3)+,#lun.ta,#text>
	tst	r0			; did the open work ?
	bne	10$			; no, just ignore it
20$:	mov	#lun.ta	,cmdlun		; yes, setup for reading from INIT
	mov	sp	,sy.ini		; a flag to use later
100$:	return

	.save
	.psect	$pdata
	.even
200$:	.word	210$,220$,230$,240$,0
210$:	.asciz	/SY:KERMIT.INI/
220$:	.asciz	/LB:[1,2]KERMIT.INI/
230$:	.asciz	/SY:[1,2]KERMIT.INI/
240$:	.asciz	/KERMIT:KERMIT.INI/
	.even
	.restore
	.dsabl	lsb

	global	<xinit	,cmdlun	,lun.ta	,defchk	,defdly	,chktyp	,sendly>
	global	<chksiz	,sy.ini	,parity	,setrec	,setsen	,sendat	,vttype>
	global	<setrpt	,con8bit,proflg	,blip	,sensop	,recsop>
	global	<argbuf,argpnt>


	.sbttl	spar	fill will my send-init parameters


;	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	doattr			; attribute support disabled today?
	bne	10$			; no
	tst	dolong			; /42/ What about long packets
	bne	10$			; /42/ Yep
	mov	#11	,sparsz		; No, shorten the packet up
10$:	mov	@r5	,r2		; point to the destiniation
	mov	#senpar	,r1		; and our local parameters
	clr	snd8bit			; assume we don't need 8bit prefixing
	movb	#'Y&137	,p.qbin(r1)	; assume 'if we must do it, ok' for 8bit
	movb	conpar+p.qbin,r0	; get senders 8bit quote character
	cmpb	r0	,#'N&137	; can the other kermit ever do 8bit ?
	bne	15$			; no, don't bother setting the mode
	clr	do8bit			; don't ever try to do it
	br	30$			;
15$:	cmpb	r0	,#'Y&137	; has the other one required this mode?
	bne	20$			; yes, set the mode up then
	cmpb	parity	,#par$no	; no, but do we need to do it?
	beq	30$			; no, don't waste the overhead
	movb	#myqbin	,r0		; yes, force this to the other side
	movb	r0	,p.qbin(r1)	; tell the other kermit we HAVE to do it
20$:	mov	sp	,snd8bit	; flag we need it for sending a file
	mov	sp	,do8bit		; force 8bit prefixing then
	movb	r0	,ebquot		; and set ours to the same please
	movb	r0	,p.qbin(r1)	; /29/ fix this please
30$:	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
	bicb	#CAPA.L	,@r1		; /42/ Assume NO long packet support
	tst	dolong			; /42/ Do long packet crap?
	beq	35$			; /42/ No
	bisb	#CAPA.L	,@r1		; /42/ Yes, insert it NOW
35$:	bisb	#CAPA.A	,@r1		; /42/ Assume attribute support
	tst	doattr			; /42/ Really do it ?
	bne	40$			; /42/ Yes
	bicb	#CAPA.A	,@r1		; /42/ No, disable it now
40$:	tochar	(r1)+	,(r2)+		; senpar.capas
	tochar	(r1)+	,(r2)+		; /42/ senpar.capas+1 (window size)
	tochar	(r1)+	,(r2)+		; /42/ senpar.capas+2 (maxlen2)
	tochar	(r1)+	,(r2)+		; /42/ senpar.capas+3 (maxlen1)	
	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	==	15		; /42/ 13 parameters to send over

sparin::save	<r1,r2,r3>		; save registers we may use
	mov	#.sparsz,sparsz		; copy the send init packet size
	tst	doattr			; attribute support disabled today?
	bne	10$			; no
	tst	dolong			; /42/ Doing long packets ?
	bne	10$			; /42/ Yes
	mov	#11	,sparsz		; No, 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	#'Y&137	,(r1)+		; do quoting ?
	movb	#mychkt	,@r1		; /42/ checksum type
;-	tst	dolong			; /42/ Want to do long packet?
15$:	inc	r1
	movb	#40	,@r1		; assume no repeat processing
	tst	setrpt			; really say we do repeat crap?
	beq	20$			; no
	movb	#myrept	,@r1		; default on the rest of it
20$:	inc	r1			; fix the pointer please
	movb	#mycapa	,@r1		; we can read attributes
	tst	doattr			; /42/ No attrs but do long packets?
	bne	30$			; /42/ Leave attribute support in
	bicb	#CAPA.A	,@r1		; /42/ Remove attribute support
30$:	tst	dolong			; /42/ Long packet support desired?
	bne	40$			; /42/ Yes, leave the bit alone
	bicb	#CAPA.L	,@r1		; /42/ No, remove support bit
40$:	bicb	#1	,@r1		; /42/ Insure no more capas bytes
	inc	r1			; /42/ Next please
	clrb	(r1)+			; /42/ No window size to send over
	mov	#maxpak	,r3		; /42/ Setup to break the size into
	clr	r2			; /42/ two bytes
	div	#95.	,r2		; /42/ Done
	movb	r2	,(r1)+		; /42/ maxl1 = buffersize / 95
	movb	r3	,(r1)+		; /42/ maxl2 = buffersize mod 95
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	movb	#'&	,ebquot
	unsave	<r3,r2,r1>
	return

	global	<setrec	,senpar	,setsen	,sparsz>
	global	<reclng	,senlng	,dolong	,doattr	,doslid> ; /42/
	global	<senwin	,recwin	,inqbuf>			 ; /42/



	.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,r3,r4>	; save registers we may use
	clr	r3			; /42/ Sending long packet buffersize
	mov	@r5	,r1		; incoming packet address
	mov	2(r5)	,r0		; size
	mov	#conpar	,r2		; address of remotes parameters
	movb	#'N	,p.qbin(r2)	; /58/ Worst case on 8bit quoting
	unchar	(r1)+	,(r2)+		; conpar.spsiz
	dec	r0			; exit if no more data
	beq	4$			; all done
	unchar	(r1)+	,(r2)+		; conpar.time
	dec	r0			; exit if no more data
	beq	4$			; all done
	unchar	(r1)+	,(r2)+		; conpar.npad
	dec	r0			; exit if no more data
	beq	4$			; all done
	ctl	(r1)+	,(r2)+		; conpar.padc
	dec	r0			; exit if no more data
	beq	4$			; all done
	unchar	(r1)+	,(r2)+		; conpar.eol
	dec	r0			; exit if no more data
	beq	4$			; all done
	movb	(r1)+	,(r2)+		; conpar.qctl
	dec	r0			; exit if no more data
	beq	4$			; all done
	movb	(r1)+	,(r2)+		; conpar.qbin
	dec	r0			; exit if no more data
	beq	4$			; all done
	movb	(r1)+	,(r2)+		; conpar.chkt
	dec	r0			; exit if no more data
	beq	4$			; all done
	movb	(r1)+	,(r2)+		; conpar.rept
1$:	dec	r0			; exit if no more data
	beq	4$			; all done
	unchar	(r1)+	,@r2		; conpar.capas
	bitb	#1	,(r2)+		; /42/ More CAPAS to go ?
	bne	1$			; /42/ Yes, keep getting them
	dec	r0			; /42/ Look for the Window size
	beq	4$			; /42/ Not present
	unchar	(r1)+	,senwin		; /42/ Present, save it away please
	dec	r0			; /42/ Look for long packet size
	beq	4$			; /42/ Anything ?
	unchar	(r1)+	,r3		; /42/ Yes, get it please
	bicb	#200	,r3		; /42/ Insure high bit off
	mul	#95.	,r3		; /42/ and save it
	dec	r0			; /42/ Get the next part please
	beq	4$			; /42/ Nothing is left
	unchar	(r1)+	,r4		; /42/ Last entry, low order of size
	bicb	#200	,r4		; /42/ Insure high bit off
	add	r4	,r3		; /42/ Add into senders buffersize

4$:	clrb	(r2)+
	mov	#conpar	,r2		; now clear parity off please in
	mov	#15	,r0		; case an IBM system set it.
5$:	bicb	#200	,(r2)+		; simple
	sob	r0	,5$		; next please
	call	rparck			; /37/ insure parameters are OK
	mov	#setsen	,r0		; /43/ check to see if we need to
	mov	#conpar	,r1		; override any of the sinit stuff
	movb	p.padc(r0),r2		; /57/ Check for SET SEND PADC
	beq	6$			; /57/ Never set
	movb	r2	,p.padc(r1)	; /57/ Set, use it
6$:	movb	p.npad(r0),r2		; /57/ Check for SET SEND PADC
	beq	7$			; /57/ Never set
	movb	r2	,p.npad(r1)	; /57/ Set, use it
7$:	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

	mov	snd8bit	,do8bit		; in case SPAR decided WE need 8bit
	clr	snd8bit			; prefixing to send a file over.
	cmpb	p.qbin(r1),#'Y&137	; was this a simple 'YES' ?
	bne	50$			; no
	movb	#myqbin	,ebquot		; yes, change it to the default '&'
	br	70$			; and exit
50$:	cmpb	p.qbin(r1),#'N&137	; eight bit quoting support present
	bne	60$			; yes
	clr	do8bit			; no
	br	70$
60$:	mov	sp	,do8bit		; flag for doing 8 bit prefixing then
	movb	p.qbin(r1),ebquot	; and set the quote character please
70$:	clr	senlng			; /42/ Clear the write long buffer size
	tst	dolong			; /42/ Really want long packets today?
	bne	75$			; /42/ Yes
	bicb	#CAPA.L	,p.capas(r1)	; /42/ No, so turn it off please
75$:	bitb	#CAPA.L	,p.capas(r1)	; /42/ Can the sender do long packets?
	beq	90$			; /42/ No
	mov	r3	,senlng		; /42/ Yes, stuff the max buffersize
	bne	80$			; /42/ Something is there
..DEFL	==	. + 2			; /52/ Default
	mov	#90.	,senlng		; /42/ Nothing, assume 90 (10) chars
80$:	cmp	senlng	,#MAXLNG	; /42/ Is this size bigger than buffer?
	ble	100$			; /42/ No
	mov	#MAXLNG	,senlng		; /42/ Yes, please fix it then
	br	100$			; /43/ And exit
90$:	tst	reclng			; /43/ Ever do a SET REC PAC > 94 ?
	beq	100$			; /43/ No
	tst	infomsg			; /43/ Really dump this message?
	beq	100$			; /43/ No
	tst	msgtim			; /43/ Please, NOT for EVERY file
	bne	100$			; /43/ Not again
	mov	sp	,msgtim		; /43/ Flag we printed a warning
	calls	printm	,<#1,#lmsg>	; /43/ Yes, print a warning message
100$:	unsave	<r4,r3,r2,r1,r0>
	return


	.save
	.psect	$PDATA	,D
lmsg:	.ascii	/%Warning - You have requested LONG packet support/<CR><LF>
	.asciz	/but the other Kermit does not support this feature./<CR><LF>
	.even
	.restore



	.sbttl	setup defaults for senders parameters and also check them

rparin::save	<r1,r2>			; 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	#'Y&137	,(r1)+		; do quoting ?
	movb	#mychkt	,(r1)+		; checksum type
	movb	#40	,(r1)+		; assume no repeat count processing
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	clrb	(r1)+			; default on the rest of it
	mov	#setsen	,r0		; /57/ check to see if we need to
	mov	#conpar	,r1		; /57/ override any of the sinit stuff
	movb	p.padc(r0),r2		; /57/ Check for SET SEND PADC
	beq	10$			; /57/ Never set
	movb	r2	,p.padc(r1)	; /57/ Set, use it
10$:	movb	p.npad(r0),r2		; /57/ Check for SET SEND PADC
	beq	20$			; /57/ Never set
	movb	r2	,p.npad(r1)	; /57/ Set, use it
20$:	movb	p.eol(r0),r2		; /57/ if user set endofline
	beq	30$			; /57/  then
	movb	r2	,p.eol(r1)	; /57/   conpar.eol := setrec.eol
30$:	unsave	<r2,r1>
	return

rparck:	mov	#conpar	,r0		; /37/ address of senders parameters
	$chkb	#maxpak	,r0		; /37/ Be defensive about the senders
	$chkb	#mytime	,r0		; /37/ parameters please
	$chkb	#mypad	,r0
	$chkb	#mypchar,r0
	$chkb	#myeol	,r0
	$chkb	#myquote,r0
	$chkb	#'Y	,r0
	$chkb	#mychkt	,r0
	$chkb	#40	,r0
	return				; /37/ exit to RPAR


	global	<conpar	,do8bit	,setrec	,ebquot>




	.sbttl	fillog	log file opens/close to disk

;	F I L L O G
;
;	input:	@r5	0	for open for read
;			1	for open for write
;		2(r5)	filename

	.enabl	lsb

fillog::save	<r0,r1>
	bit	#log$fi	,trace		; logging file activity to disk ?
	beq	100$			; no
	calls	putc	,<#cr,#lun.lo>	; insure buffers are flushed
	mov	#200$	,r1		; assume a header of 'writing'
	tst	@r5			; perhaps writing ?
	beq	10$			; no
	mov	#210$	,r1		; yes
10$:	movb	(r1)+	,r0		; copy the byte over
	beq	20$			; all done
	calls	putc	,<r0,#lun.lo>	; next byte pleae
	br	10$			; next
20$:	mov	2(r5)	,r1		; now for the filename
30$:	movb	(r1)+	,r0		; copy the byte over
	beq	40$			; all done
	calls	putc	,<r0,#lun.lo>	; next byte pleae
	br	30$			; next
40$:	calls	putc	,<#cr,#lun.lo>	; dump the record
100$:	unsave	<r1,r0>			; and exit
	return


	.save
	.psect	$PDATA	,D
200$:	.asciz	/Receiving file /
210$:	.asciz	/Sending   file /
	.even
	.restore
	.dsabl	lsb




	.sbttl	debug dump to disk

;	D S K D M P
;
;	input:	@r5	name ('rpack' or 'spack')
;		2(r5)	packet length
;		4(r5)	packet type
;		6(r5)	packet number
;		10(r5)	packet address

	.enabl	lsb

dskdmp::save				; /42/ Save R0-R5
	sub	#120	,sp		; allocate a formatting buffer
	mov	sp	,r1		; point to it
	mov	#120	,r0		; and clear it out
10$:	movb	#40	,(r1)+		; simple
	sob	r0	,10$
	mov	sp	,r1		; point back to the buffer
	mov	(r5)+	,r0		; point to the routine name
	call	200$			; and copy it
	mov	#110$	,r0		; and a label ('LEN')
	call	200$			; copy it
	mov	(r5)+	,r2		; get the length saved
	deccvt	r2,r1,#3		; convert the length to decimal
	add	#6	,r1		; and skip over it
	mov	#120$	,r0		; another label ('TYP')
	call	200$			; simple
	movb	(r5)+	,(r1)+		; get the packet type
	movb	#40	,(r1)+		; and some spaces
	cmpb	@r1	,#badchk	; checksum error ?
	bne	20$			; no
	movb	#'*	,-1(r1)		; yes, flag it please
20$:	inc	r5			; point to the next arguement
	movb	#40	,(r1)+		; and some spaces
	movb	#40	,(r1)+		; and some spaces
	movb	#40	,(r1)+		; and some spaces
	mov	#130$	,r0		; and a label ('PAK')
	call	200$			; copy it
	mov	(r5)+	,r0
	deccvt	r0,r1,#3		; and convert to decimal
	add	#4	,r1		; now point to the end
	clrb	@r1			; make it .asciz
	mov	sp	,r1		; point back to the start
	calls	putrec	,<r1,#70.,#lun.lo> ; and put out to disk now
	mov	@r5	,r3		; /42/ May have very large packets
	mov	r2	,r4		; /42/ Save the length please
30$:	mov	r4	,r0		; /42/ Assume a reasonable size
	bmi	50$			; /42/ Anything left over to do?
	cmp	r0	,#72.		; /42/ Will the leftovers fit?
	ble	40$			; /42/ Yes
	mov	#72.	,r0		; /42/ No
40$:	calls	putrec	,<r3,r0,#LUN.LO>; /42/ Dump a (partial) bufferfull
	add	#72.	,r3		; /42/ Move up to next partial
	sub	#72.	,r4		; /42/ And try again
	br	30$			; /42/ Next please
50$:	tst	debug			; should we also dump to ti:?
	beq	100$			; no
	.print	r1			; yes, dump the length and type
	.newli				; and a carrriage return
	tst	r2			; anything in the packet?
	beq	100$			; no
	.print	@r5	,r2		; yes, dump it
	.newlin				; and do a <cr><lf>
100$:	add	#120	,sp		; pop the local buffer and exit
	unsave				; /42/ Unsave R5-R0
	return				; bye


	.save
	.psect	$PDATA	,D
110$:	.asciz	/Length/
120$:	.asciz	/Type/
130$:	.asciz	/Paknum/
	.even
	.restore


200$:	movb	(r0)+	,(r1)+		; copy .asciz string to buffer
	bne	200$			; done yet ?
	dec	r1			; yes, back up and overwrite the
	movb	#40	,(r1)+		; null with a space
	movb	#40	,(r1)+		; one more space for formatting
	return				; bye

	.dsabl	lsb


	.sbttl	do some logging to TI: ?


senhdr::save	<r1>			; /43/
	mov	#-1	,pcnt.n+2
	clr	pcnt.n+0		; /43/ Clear high order bits
	mov	#-1	,pcnt.t+2	; /44/ Clear timeout stuff
	clr	pcnt.t+0		; /44/ Clear timeout stuff
	call	dovt
	bcs	100$
	print	#$sendh
	mov	sp	,logini
100$:	unsave	<r1>			; /43/
	return

rechdr::save	<r1>			; /43/
	mov	#-1	,pcnt.n+2
	clr	pcnt.n+0		; /43/ Clear high order bits
	mov	#-1	,pcnt.t+2	; /44/ Clear timeout stuff
	clr	pcnt.t+0		; /44/ Clear timeout stuff
	call	dovt			; vt100 vttype type?
	bcs	100$			; no, forget it
	print	#$rech			; initial header please
	mov	sp	,logini		; save we did it already
100$:	unsave	<r1>			; /43/
	return				; bye


reclog::save	<r1>
	call	dolog
	bcs	100$
	mov	pcnt.r+2,r1		; check for modulo on screen updates
	clr	r0			; setup for the divide
	div	blip	,r0		; do it
	tst	r1			; any remainder left over
	bne	100$			; yes, simply exit
	mov	vttype	,r0		; no, dispatch to the correct routine
	asl	r0
	jsr	pc	,@recdsp(r0)
100$:	unsave	<r1>
	return


rectty:	mov	#pcnt.r	,r1		; /43/ Pass address in r1
	call	numout
	print	#$delim
	mov	#pcnt.s+<4*<<'N&137>-100>>,r1 ; /43/ 32 bits this time
	cmp	2(r1)	,pcnt.n+2	; /43/ unlikely that the nak
	beq	100$			; /43/ count would ever be > 32767
	mov	2(r1)	,pcnt.n+2	; /43/ Use low order 16 bites
	call	numout
100$:	print	#$leftm
	return

recvt1:	call	dovt			; vt100 type?
	bcs	100$			; no
	tst	logini			; need the header?
	bne	10$			; no
	call	rechdr			; yes
10$:	print	#$pos1			; position the cursor	
	mov	#pcnt.r	,r1		; received packet count /43/
	call	numout			; dump it
	mov	#pcnt.s+<4*<<'N&137>-100>>,r1 ; get the sent NAK count /43/
	cmp	2(r1)	,pcnt.n+2	; /43/ Really need to update naks?
	beq	90$			; no
	mov	2(r1)	,pcnt.n+2	; /43/ Stuff low order 16 bits
	call	nakpos
	call	numout			; print the NAK count
90$:	call	dotmo			; /44/ DO timeouts
	print	#$leftm
100$:	return
	



;	for sending files, log transactions here

senlog::save	<r1>
	call	dolog
	bcs	100$
	mov	pcnt.s+2,r1		; check for modulo on screen updates
	clr	r0			; setup for the divide
	div	blip	,r0		; do it
	tst	r1			; any remainder left over
	bne	100$			; yes, simply exit
	mov	vttype	,r0
	asl	r0
	jsr	pc	,@sendsp(r0)
100$:	unsave	<r1>
	return


sentty:	mov	#pcnt.s	,r1		; /43/ 32 bits now
	call	numout
	print	#$delim
	mov	#pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
	cmp	2(r1)	,pcnt.n+2
	beq	100$
	mov	2(r1)	,pcnt.n+2
	call	numout
100$:	print	#$leftm
	return

senvt1:	tst	logini			; need the header?
	bne	10$			; no
	call	senhdr			; yes
10$:	print	#$pos1			; position the cursor
	mov	#pcnt.s	,r1		; /43/ 32 bits now
	call	numout
	mov	#pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
	cmp	2(r1)	,pcnt.n+2
	beq	90$
	mov	2(r1)	,pcnt.n+2
	call	nakpos
	call	numout
90$:	call	dotmo			; /44/ Timeouts
	print	#$leftm
100$:	return


	.sbttl	data for packet transfer logging


	.save
	.psect	$vtdat	,ro,d,lcl,rel,con
$sendh:	.byte	33,'<
	.ascii	<cr><33>/[2KPackets sent     :            Naks: /
	.asciz	/            Timeouts: /
$rech:	.byte	33,'<
	.ascii	<cr><33>/[2KPackets received :            Naks: /
	.asciz	/            Timeouts: /
$pos1:	.asciz	<cr><33>/[20C/		; goto column 20
$pos2:	.asciz	<33>/[14C/		; move over 14 please
$leftm:	.byte	cr,0			; goto left margin please
$delim:	.asciz	#/#
	.even

sendsp:	.word	sentty	,senvt1	,senvt1	,senvt1	,senvt1	,senvt1	,senvt1
recdsp:	.word	rectty	,recvt1	,senvt1	,senvt1	,senvt1	,senvt1	,senvt1
	.assume	tty	eq	0
	.assume	vt100	eq	1
	.restore
	
numout:	save	<r0,r1,r2>		; /43/ Use $CDDMG from SYSLIB
	sub	#20	,sp		; /43/ Allocate a buffer please
	mov	sp	,r0		; /43/ Point to buffer for $CDDMG
	clr	r2			; /43/ We want leading zero and spaces
	call	$cddmg			; /43/ out please
	clrb	@r0			; /43/ Make into .asciz
	mov	sp	,r0		; /43/ Reset pointer
	print	r0			; /43/ Dump the string and exit
	add	#20	,sp		; /43/ Pop buffer
	unsave	<r2,r1,r0>		; /43/ Pop registers and exit
	return				; /43/ Exit

	global	<$cddmg>		; /43/ From syslib.olb



	.sbttl	decide what to do about logging
	.enabl	lsb


dovt:	cmpb	vttype,#vt100		; a vt100 today?
	blo	90$			; /39/ no, but allow vt220 type
dolog:	tst	blip			;
	beq	90$			; do not do this at all
	tst	infomsg			; /51/ Don't do if SET QUIET
	beq	90$			; /51/ 
	tst	remote			; a server?
	bne	90$			; could be
	tst	xmode			; text reply?
	bne	90$			; yes
	br	100$			; debug is ok then
90$:	sec
	return
100$:	clc
	return

	global	<blip>

	.dsabl	lsb


nakpos:	print	#npos
	return

	.save
	.psect	$PDATA	,D
npos:	.asciz	<cr><33>/[38C/		; goto column 38
dpos:	.asciz	<cr><33>/[59C/		; /44/ For timeout count
	.even
	.restore


dotmo:	mov	#pcnt.r+<4*<<'T&137>-100>>,r1 ; /44/ Get timeout count
	cmp	2(r1)	,pcnt.t+2	; /44/ Timeout count has changed?
	beq	100$			; /44/ No, just exit
	mov	2(r1)	,pcnt.t+2	; /44/ Yes, update counter
	print	#dpos			; /44/ Position cursor
	call	numout			; /44/ Dump please
100$:	return



	global	<pcnt.n	,pcnt.r	,pcnt.s	,remote	,xmode	,vttype>
	global	<pcnt.t>



	.sbttl	Control A packet stats 09-Dec-86  07:46:02
	.enabl	lsb


;	 This is simliar to the vms kermit's Control A status  line,
;	which  is  just like that used in FTP. The useful way to use
;	this is to, in the KERMIT.INI file, add  a  line  to  modify
;	the  packet  count  interval:  to turn it off, SET UPDATE 0,
;	otherwise its MOD value. Typing control  A  will  print  the
;	char count stat. 

cs$in::	mov	#210$	,r0		; /56/ Save please
	mov	#filein	,r1		; /56/ Address of data to print
	br	10$			; /56/ Common code now
					; /56/
cs$out::mov	#200$	,r0		; /56/ Save please
	mov	#fileout,r1		; /56/ Address of data to print
10$:	Message	<[>			; /56/ Header for line
	call	numout			; /56/ Dump the character count
	Print	r0			; /56/ Formatting
	Print	#filnam			; /56/ The name of the file
	Message	<]>,CR			; /56/ All done
	clr	logini			; /56/ Needed if packet counting
	return				; /56/ Exit

	.Save				; /56/ Save current Psect
	.Psect	$Pdata	,d		; /56/ Switch to data psect
200$:	.asciz	<33>/[K Characters sent for /	
210$:	.asciz	<33>/[K Characters received for /
	.even				; /56/ Insure word alignment
	.Restore			; /56/ Pop old psect
	.Dsabl	lsb			; /56/ All done

	Global	<filein,fileout,filnam>	; /56/



	.sbttl	32 bit conversion from rsx syslib


	.GLOBL	$CBTA		;Global reference
	.GLOBL	$SAVRG		;Global reference
	.GLOBL	$CDDMG
$CDDMG:	JSR	R5,$SAVRG
	MOV	R0,R3
	MOV	#23420,R4
	MOV	#12,R5
	TST	R2
	BEQ	C00024
C00022:	BIS	#1000,R5
C00024=	C00022+2
	CMP	(R1),R4
	BCC	C00104
	MOV	(R1)+,R0
	MOV	(R1),R1
	DIV	R4,R0
	MOV	R1,-(SP)
	MOV	R0,R1
	BEQ	C00064
	MOV	#24000,R2
	CALL	C00072
	BIS	#1000,R5
	MOV	R0,R3
C00064:	MOV	(SP)+,R1
	MOV	#20000,R2
C00072:	MOV	R3,R0
	BIS	R5,R2
	CALL	$CBTA
	BR	C00116
C00104:	MOV	#5,R2
C00110:	MOVB	#52,(R0)+
	SOB	R2,C00110
C00116:	RETURN
	.end