	.title	k11e80	kermit i/o for RSTS verison 8

	.ident	/8.0.01/

	.psect	$code	,ro,i,lcl,rel,con



;	define macros and things we want for KERMIT-11

	.include	/SY:[1,2]COMMON.MAC/
	.iif ndf, xrb	, .error ; INCULDE for [1,2]COMMON.MAC failed

	.include	/IN:K11MAC.MAC/
	.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed

	.title	k11e80		; common.mac destroys our name



;	Copyright (C) 1983,1984,1985 Change Software, Inc.
;	
;	
;	This software is furnished under a license and may
;	be  used  and  copied  only in accordance with the
;	terms of such license and with  the  inclusion  of
;	the  above copyright notice.  This software or any
;	other copies thereof may not be provided or other-
;	wise made available to any other person.  No title
;	to and ownership of the software is hereby  trans-
;	ferred.
;	
;	The information in this  software  is  subject  to
;	change  without notice and should not be construed
;	as a commitment by the author.
;
;

	.sbttl	the entry points

;	In all cases, R0 will have the returned error code (zero for success)
;	For KBREAD and READ, R1 will have the size of the read
;	For BINREAD,  R1 will have the character just read
;
;	The use of %LOC and %VAL are from VMS Pascal and Fortran.
;	%LOC means ADDRESS, whereas %VAL means literal. All call
;	formats assume the first argument is at 0(r5), the next
;	at 2(r5) and so on, as in:
;
;	clr	-(sp)			; today's date by default
;	mov	#datebf	,-(sp)		; where to put the converted string
;	mov	sp	,r5		; call ASCDAT
;	call	ascdat			; simple
;	cmp	(sp)+	,(sp)+		; all done
;
;	or by using the CALLS macro (defined in K11MAC.MAC)
;
;	calls	ascdat	,<#datebf,#0>
;
;
;	Any version of Kermit-11 which can not, due to the lack of
;	executive  support,  implement a function should return an
;	error of -1 in r0.  For instance,  RT11 does not have  any
;	executive primitives to do wildcarding directory lookup.
;
;
;
;
;	ASCDAT	( %loc buffer, %val datevalue )
;	ASCTIM	( %loc buffer, %val timevalue )
;	ASSDEV	( %loc device_name )
;	BINREA	( %val lun, %val timeout )
;	BINWRI	( %loc buffer, %val byte_count, %val lun )
;	CANTYP	( %loc device_name, %val lun )
;	CHKABO	( )
;	DODIR	( %loc directory_string, %val lun )
;	DRPPRV	( )
;	DSKUSE	( %loc returned_string )
;	ECHO	( %loc terminal_name )
;	EXIT	( )
;	GETPRV	( )
;	GETUIC	( )
;	GTTNAM	( %loc returned_ttname )
;	KBREAD	( %loc buffer )
;	L$PCRL	( )
;	L$TTYO	( %loc buffer, %val bytecount )
;	LOGOUT	( )
;	NAMCVT	( %loc source_filename, %loc returned_normal_name )
;	NOECHO	( %loc device_name, %val lun )
;	QUOCHK	( )
;	READ	( %loc buffer, %val buffer_length, %val lun, %val block_number )
;	SETCC	( %loc control_c_ast_handler )
;	SETSPD	( %loc device_name, %val speed )
;	SUSPEN	( %val seconds, %val ticks )
;	SYSERR	( %val error_number, %loc error_text_buffer )
;	TTRFIN	( )
;	TTRINI	( )
;	TTSPEE	( %loc terminal_name )
;	TTYDTR	( %loc terminal_name )
;	TTYFIN	( %loc terminal_name, %val lun )
;	TTYHAN	( %loc terminal_name )
;	TTYINI	( %loc terminal_name, %val lun, %val open_flags )
;	TTYPAR	( %loc terminal_name, %val parity_code )
;	TTYRST	( %loc terminal_name )
;	TTYSAV	( %loc terminal_name )
;	TTYSET	( %loc terminal_name )
;	WRITE	( %loc buffer, %val buffer_length, %val lun, %val block_number )
;	XINIT	( )

	.psect	buffer	,rw,d,lcl,rel,con
lunsize	=	17
linit:	.blkw	20
lpoint:	.blkw	20
lsize:	.blkw	20
lbuffer:.blkb	200
ttsave:	.blkb	40*15



	.sbttl	edits


;	05-Jan-84  14:34:01 BDN	Added  TT8BIT mode to line if no parity
;				since the terminal driver always strips
;				bit 7 even if the character is a delim.




	.sbttl	macros

	.macro	clrfqb
	call	$clrfq
	.endm	clrfqb

	.macro	clrxrb
	call	$clrxr
	.endm	clrxrb

	nodata	==	13.		; no data for terminal read
	detkey	==	27.		; i/o to detached tt line

	.psect	$code


xinit::	save	<r1>
	clr	df$rat			; stream ascii please for RSTS?
	movb	#fb$stm	,df$rfm		; say so and exit
	mov	#ttsave	,r1		; initialize the terminal char
	mov	#15	,r0		; save area now.
10$:	movb	#377	,(r1)+		; the ttysave area is set up for
	add	#40	,r1		; saving up to 15 (8) settings.
	sob	r0	,10$		; makes it easy to save via LUN
	calls	l$fss	,<#200$>	; open terminal on LUN.AS
	movb	#opnfq	,firqb+fqfun	; to fix things up if using
	movb	#lun.tt	,firqb+fqfil	; it's global please
	aslb	firqb+fqfil		; times 2 please
	calfip				; simple
	movb	firqb	,r0		; it can't fail !!
	beq	90$			; ok
	direrr	r0			; oops
90$:	call	getuic			; get the ppn please
	swab	r0			; check for user being priv
	cmpb	r0	,#1		; well ?
	bne	100$			; no	
	mov	#jfspri	,xrb+0		; yes, set special run priority
	.set				; simple to do
pr$set	==	. - 2			; patchable out to a NOP
100$:	clr	r0
	unsave	<r1>
	return

200$:	.asciz	/_KB:/
	.even

	global	<df$rat,df$rfm,fb$stm,getuic,lun.tt>




	.sbttl	terminal initialization
	.psect	$code


;	T T Y I N I
;
;	ttyini( %loc device_name ,%val channel_number ,%val ccflag )
;
;
;	input:	@r5	.asciz string of device name
;		2(r5)	channel number
;		4(r5)	bitfield for ter$cc and ter$bi
;
;			 if 4(r5) and ter$bi then use binary open
;					     else use multiple delimiters
;			 if 4(r5) and ter$cc then set control c as delimiter
;			 if 4(r5) and ter$xo then allow binary mode with XON
;
;	output:	r0	error codes
;
;
;	 Ttyini sets the  appropiate terminal characteristics  for
;	the  device name  passsed and returns the  device open (or
;	attached) on the passed logical unit.  Errors are returned
;	in r0. For RSTS these could be the usual device not avail-
;	able or missing monitor feature.
;
;	useful things to add: device check for terminal


ttyini::save	<r2>
	call	getprv			; will need for binary open
	mov	2(r5)	,r2		; channel number
	asl	r2			; times two
	clr	lpoint(r2)		; clear offset into local buffer
	clr	linit(r2)		; we have not set fast packet mode
	clr	lsize(r2)		; we have not read anyting yet also
	clrfqb				; insure firqb and xrb are cleared
	clrxrb				; of undesirable defaults
	mov	@r5	,r0		; get address of device string
	tstb	@r0			; anything there ?
	bne	10$			; yes
	calls	l$fss	,<#210$>	; no, use _KB:
	br	20$
10$:	call	l$fss			; do the usual .fss to parse
20$:	tst	r0			; the device name
	bne	100$			; oops
	movb	#opnfq	,firqb+fqfun	; open the device up now
	movb	r2	,firqb+fqfil
	bit	#ter$bi	,4(r5)		; use straight binary mode today ?
	beq	30$			; no
	mov	#100001	,firqb+fqmode	; yes
	mov	#lun.tt	,binmod		; flag for i/o later on please
	bit	#ter$xo	,4(r5)		; want xon/xoff to work normally ?
	beq	30$			; no
	bis	#40	,firqb+fqmode	; yes, add the mode in please

30$:	calfip				; get fip to do it
	movb	firqb	,r0		; fail ?
	bne	90$			; yes
	bit	#ter$bi	,4(r5)		; use straight binary mode today ?
	bne	50$			; yes
	clr	r0			; assume control c's are ok
	bit	#ter$cc	,4(r5)		; did the caller want to allow ^C
	beq	40$			; yes
	dec	r0			; no, make control C a delimiter
	br	45$
40$:	bit	#ter$pa	,4(r5)
	beq	45$
	inc	r0
	mov	sp	,linit(r2)
45$:	calls	setdlm	,<2(r5),r0>	; no, try to set up delimiter
50$:	tst	r0			; did it work also
	bne	80$			; no
	call	initer			; yes, set the tty's characteristics
	br	100$			; and exit (with errors in r0)
80$:	cmpb	r0	,#102		; "missing special feature?"
	bne	100$			; no
	.print	#200$			; yes, make it reasonable
90$:	clr	binmod			; open failed, clear binary flag
100$:	call	drpprv			; no longer want privs please
	unsave	<r2>
	return

	.enabl	lc
200$:	.ascii	/? This copy of RSTS is missing the multiple private/<cr><lf>
	.ascii	/delimiter SYSGEN option. Please include this option/<cr><lf>
	.asciz	/in RSTS for KERMIT to function/<cr><lf>
	.even
210$:	.asciz	/_KB:/
	.even




	.sbttl	close up a terminal line


ttyfin::save	<r1,r2,r3>
	call	ttpars
	mov	r0	,r3
	movb	firqb	,r0
	bne	100$
	calls	clrdlm	,<2(r5)>	; clear private delimiters
	mov	2(r5)	,r0		; channel number
	asl	r0			; times 2
	clr	lsize(r0)		; nothing in packet buffer
	clr	linit(r0)		; not using packet buffering now
	clr	binmod			; nothing is binary anymore
	clrfqb				; close the terminal
	movb	#clsfq	,firqb+fqfun	; fip subfunction for closing lun
	movb	2(r5)	,firqb+fqfil	; channel number
	aslb	firqb+fqfil		; times 2
	calfip				; close it now
	movb	firqb	,r0		; get any errors from close
	bne	100$			; oops, just exit then
	mov	2(r5)	,r1		; get the channel number
	mul	#40	,r1		; offset into the TTSAVE area
	add	#ttsave	,r1		; finally, the address of saved stuff
	cmpb	@r1	,#377		; but is the saved stuff real ?
	beq	100$			; no
	mov	r1	,-(sp)		; yes, try to set terminal chars
	mov	#firqb	,r2		; where to put the parameters
	mov	#40	,r0		; number of bytes to copy
10$:	movb	(r1)+	,(r2)+		; do a byte please
	sob	r0	,10$		; next
	clrb	firqb+4			; Version 9 fix here
	bisb	firqb+36,firqb+20	; UU.TRM returns 8bit setting here
	clr	firqb+36		; insure unused for future rsts/e?
	movb	#uu.trm	,firqb+fqfun	; uuo subfunction for terminals
	movb	r3	,firqb+5	; stuff the unit number in
	.uuo				; try to do it
	movb	firqb	,r0		; save any errors	
	mov	(sp)+	,r1		; get the ttsave address back
	movb	#377	,@r1		; mark as being invalid
100$:	unsave	<r3,r2,r1>		; pop registers and exit
	return


	global	<binmod>




	.sbttl	get terminal name

;	G T T N A M
;
;	input:	@r5	address of 8 character buffer for terminal name
;	output:		.asciz name of terminal

gttnam::save	<r0,r1,r2>		; may as well save it
	mov	@r5	,r2		; now return the name
	movb	#'_	,(r2)+		; return _KBnn:
	movb	#'K	,(r2)+		; return _KBnn:
	movb	#'B	,(r2)+		; return _KBnn:
	clrfqb				; assume defaults
	movb	#uu.sys	,firqb+fqfun	; for a systat part one
	.uuo				; simple
	movb	firqb+5	,r1		; get the name
	bmi	90$			; detached ?
	clr	r0			; now compute the ascii name
	div	#100.	,r0		; /19/ lots of terminals on system?
	tst	r0			; /19/ ge kb100: ?
	beq	10$			; /19/ no
	add	#'0	,r0		; /19/ convert the 100's part of unit
	movb	r0	,(r2)+		; /19/ and copy it please
10$:	clr	r0			; /19/ get the low two digits please
	div	#10.	,r0		; simple
	add	#'0	,r0
	add	#'0	,r1
	movb	r0	,(r2)+
	movb	r1	,(r2)+
90$:	movb	#':	,(r2)+
	clrb	@r2
	unsave	<r2,r1,r0>
	return
	


	.sbttl	set delimiter bitmask up please


;	S E T D L M
;
;!	setdlm( %val channel_number )
;
;	input:	@r5	channel number to use
;
;	output:	r0	error code (would be missing sysgen feature)



	.iif ndf, ttyhnd , ttyhnd = 2

	global	<dlmmsk>

pakmsk:	.byte	^B11110111
	.byte	377
	.byte	377
	.byte	377
	.rept	13
	.byte	0
	.endr
	.rept	21
	.byte	377
	.endr

dlmmsk:	.byte	^B11110111		; all chars except control C
	.byte	^B11111111
	.rept	36
	.byte	377
	.endr
	.even

dlmcc:	.rept	40
	.byte	377
	.endr
	.even

	.iif ndf,.spec	,.spec = emt + 14



snoecho:mov	#xrb	,r0		; pointer to parameter block
	mov	#3	,(r0)+		; function to disable echo
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	movb	2(sp)	,@r0		; channel number
	aslb	(r0)+			; times 2
	movb	#ttyhnd	,(r0)+		; driver index (ttdvr)
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	.spec				; now do it
	movb	firqb	,r0		; return any errors
	mov	(sp)+	,(sp)		; pop arg list and exit
	return				; exit


setdlm::mov	@r5	,-(sp)
	call	snoecho
	mov	#xrb	,r0		; setup to set a private delim
	mov	#11	,(r0)+		; mask now. function code is 11
	mov	#40	,(r0)+		; for .spec, 40 byte to copy
	mov	#dlmmsk	,(r0)+		; address of delimiter mask
	tst	2(r5)			; allow control c's to come in
	beq	10$
	bmi	5$
	mov	#pakmsk	,-2(r0)
	br	10$
5$:	 mov	#dlmcc	,-2(r0)
10$:	movb	@r5	,@r0		; channel number
	aslb	(r0)+			; times 2
	movb	#ttyhnd	,(r0)+		; device driver index
	clr	(r0)+			; default to console device
	clr	(r0)+			; unused
	mov	#1	,(r0)+		; subfunction SET DELIMITER
	.spec				; and do it please
	movb	firqb	,r0		; did it work ?
	return




clrdlm::
	mov	#xrb	,r0		; point to it please
	mov	#11	,(r0)+		; subfunction 
	clr	(r0)+			; must be 0
	clr	(r0)+			; also 0
	movb	@r5	,@r0		; channel number please
	aslb	(r0)+
	movb	#ttyhnd	,(r0)+		; device driver to call
	clr	(r0)+			; use channel number
	clr	(r0)+			; must be zero
	clr	(r0)+			; subfunction 0
	.spec				; and call ttdvr
100$:	return



	.sbttl	special init for receiving files

;	Due to what I would consider a RSTS terminal driver
;	bug ( .ttddt isn't cleared if you do a read without
;	wait and  there was  no data)  we have to call this
;	before we receive any files from a remote kermit.

xzmask:	.byte	^B00100000		; control E
	.byte	0
	.byte	0
	.byte	^B00000101		; control X and control Z please
	.rept	34
	.byte	0
	.endr


ttrini::mov	#xrb	,r0		; setup to set a private delim
	mov	#11	,(r0)+		; mask now. function code is 11
	mov	#40	,(r0)+		; for .spec, 40 byte to copy
	mov	#xzmask	,(r0)+		; address of delimiter mask
	movb	#lun.tt	,@r0		; channel number
	aslb	(r0)+			; times 2
	movb	#ttyhnd	,(r0)+		; device driver index
	clr	(r0)+			; default to console device
	clr	(r0)+			; unused
	mov	#1	,(r0)+		; subfunction SET DELIMITER
	.spec				; and do it please
	return


ttrfin::calls	clrdlm	,<#lun.tt>
	return




	.sbttl	other things like echo off and on


;	N O E C H O
;
;
;	input:	@r5	terminal name or null or 0 for current terminal
;	output:	r0	error code


noecho::save	<r1>			; save a temp register
	clr	r0			; assume our terminal
	mov	@r5	,r1		; passed address of 0 or a null string?
	beq	10$			; no address, assume _KB:
	tstb	@r1			; null string passed ?
	beq	10$			; yes, assume the console terminal
	call	ttpars			; parse the terminal device name
	bcs	90$			; oops
	cmpb	r0	,#377		; own terminal ?
	bne	10$			; no
	call	myterm			; yes, get correct unit number then
10$:	clrxrb				; insure no defaults
	mov	#xrb	,r1		; point to the xrb now
	mov	#3	,(r1)+		; disable function for .SPEC
	mov	r0	,(r1)+		; terminal number or zero for _KB:
	movb	#ttyhnd	,xrb+7		; and the device driver index please
	.spec				; simple

90$:	movb	firqb	,r0		; error, return it please
100$:	unsave	<r1>			; pop the register we saved
	return


;	E C H O
;
;	input:	@r5	terminal name or null or 0 for current terminal
;	output:	r0	error code


echo::	save	<r1>			; save a temp register
	clr	r0			; assume our terminal
	mov	@r5	,r1		; passed address of 0 or a null string?
	beq	10$			; no address, assume _KB:
	tstb	@r1			; null string passed ?
	beq	10$			; yes, assume the console terminal
	call	ttpars			; parse the terminal device name
	bcs	90$			; oops
10$:	clrxrb				; insure no defaults
	mov	#xrb	,r1		; point to the xrb now
	mov	#2	,(r1)+		; enable echo function for .SPEC
	mov	r0	,(r1)+		; terminal number or zero for _KB:
	movb	#ttyhnd	,xrb+7		; and the device driver index please
	.spec				; simple

90$:	movb	firqb	,r0		; error, return it please
100$:	unsave	<r1>			; pop the register we saved
	return




	.sbttl	write and read

;	W R I T E
;
;!	write( %loc buffer, %val buffer_length, %val channel_number,
;!	       %val block_number )
;
;
;	input:	@r5	buffer address
;		2(r5)	buffer length
;		4(r5)	channel number
;		6(r5)	block number
;
;	output:	r0	error code


write::	mov	#xrb	,r0		; address of xrb parameter block
	mov	2(r5)	,(r0)+		; buffer length
	mov	2(r5)	,(r0)+		; byte count for the i/o
	mov	@r5	,(r0)+		; address of the buffer
	movb	4(r5)	,@r0		; channel number
	aslb	(r0)+			; times 2
	clrb	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	mov	6(r5)	,xrb+xrblk	; forgot to stuff this one in
	.write
	movb	firqb	,r0		; return error code and exit
	return



;	R E A D
;
;!	read( %loc buffer, %val buffer_length, %val channel_number,
;!	       %val block_number )
;
;	input:	@r5	buffer address
;		2(r5)	buffer length
;		4(r5)	channel number
;		6(r5)	block number
;
;	output:	r0	error code
;		r1	byte count for read


read::	mov	#xrb	,r0		; address of xrb parameter block
	mov	2(r5)	,(r0)+		; buffer length
	clr	(r0)+			; must be zero
	mov	@r5	,(r0)+		; address of the buffer
	movb	4(r5)	,@r0		; channel number
	aslb	(r0)+			; times 2
	clrb	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	mov	6(r5)	,xrb+xrblk	; forgot to stuff this one in
	.read
	movb	firqb	,r0		; return error code and exit
	mov	xrb+xrbc,r1
	return

kbread::calls	read	,<@r5,#80.,#0,#0> ; do the actual read now
	return




	.sbttl	terminal read/write binary mode


;	B I N R E A
;
;!	binread( %val channel_number, %val timeout )
;
;
;	input:	@r5	channel number
;		2(r5)	timeout	(if -1, then no wait)
;
;	output:	r0	error
;		r1	character read
;
;	assumptions:	the terminal has all characters set up
;			as private delimeters


binrea::save	<r2>			; save temp register
5$:	mov	@r5	,r2		; get the channel number 
	asl	r2			; times 2 for word addressing
	tst	linit(r2)		; has this lun ever been set
	beq	20$			; up for a partial delimiter mask?
	tst	lsize(r2)		; yes, is there any data waiting?
	bgt	10$			; yes, get whats already there
	clr	lpoint(r2)		; no, clear the pointer
	clr	lsize(r2)		; insure buffer size is zero
	call	rget			; and read a record if possible
	tst	r0			; if it fails, revert to 1 char
	bne	100$			; i/o
10$:	dec	lsize(r2)		; one less character in buffer
	bmi	5$			; if < 0, nothig was read. do it again
	mov	lpoint(r2),r0		; get the offset into the buffer
	inc	lpoint(r2)		; and prime this for next time
	clr	r1			; avoid pdp-11 sign extension
	bisb	lbuffer(r0),r1		; get the character from the buffer
	clr	r0			; no errors
	br	100$			; and exit
20$:	call	xbinrea			;
100$:	unsave	<r2>			; pop temp register and exit
	return				;

rget:	mov	#xrb	,r0		; address of xrb parameter block
	mov	#200	,(r0)+		; buffer length
	clr	(r0)+			; must be zero
	mov	#lbuffer,(r0)+
	movb	r2	,(r0)+		; channel number
	clrb	(r0)+			; unused
	clr	(r0)+			; unused
	cmp	2(r5)	,#-1		; no wait ?
	bne	10$			; no
	 clr	(r0)+			; yes
	 mov	#8192.	,(r0)+		; stuff return without wait in
	 br	20$			; and do it
10$:	mov	2(r5)	,(r0)+		; timeout
	clr	(r0)+			; unused
20$:	.read
	movb	firqb	,r0		; return error code and exit
	bne	100$
	mov	xrb+xrbc,lsize(r2)
	clr	lpoint(r2)
100$:	return

xbinre::mov	#xrb	,r0		; address of xrb parameter block
	mov	#1	,(r0)+		; buffer length
	clr	(r0)+			; must be zero
	clr	-(sp)			; allocate buffer on the stack
	mov	sp	,(r0)+		; address of the buffer
	movb	@r5	,@r0		; channel number
	aslb	(r0)+			; times 2
	clrb	(r0)+			; unused
	clr	(r0)+			; unused
	cmp	2(r5)	,#-1		; no wait ?
	bne	10$			; no
	 clr	(r0)+			; yes
	 mov	#8192.	,(r0)+		; stuff return without wait in
	 br	20$			; and do it
10$:	mov	2(r5)	,(r0)+		; timeout
	clr	(r0)+			; unused
20$:	.read
	movb	firqb	,r0		; return error code and exit
	clr	r1
	bisb	(sp)+	,r1
	return


;	Check for pending input on terminal (like ^X and ^Z)
;	Note: .TTDDT should be cleared by TTDVR always. It's
;	not, so for the time being lets forget about it  and
;	instead setup ^X and ^Z as delimiters.  I would have
;	preferred to use odt mode for this routine.


chkabo::calls	binrea	,<#5,#-1>	; simple read on console terminal
	tst	r0			; did it work ok ?
	bne	100$			; no
	mov	r1	,r0		; yes, return ch in r0 please
	return
100$:	cmpb	r0	,#11.		; error EOFEOF?
	bne	110$			; no
	movb	#'Z&37	,r0		; yes, return ^Z as the character
	return
110$:	clr	r0			; it failed
	return




	.sbttl	write everything to the terminal

;	B I N W R I
;
;	write( %loc buffer, %val buffer_length, %val channel_number )
;
;	input:	@r5	buffer address
;		2(r5)	buffer size
;		4(r5)	channel number
;	output:	r0	error code


binwri::mov	#xrb	,r0		; address of xrb parameter block
	mov	2(r5)	,(r0)+		; buffer length
	mov	2(r5)	,(r0)+		; byte count for the i/o
	mov	@r5	,(r0)+		; address of the buffer
	movb	4(r5)	,@r0		; channel number
	aslb	(r0)+			; times 2
	clrb	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	mov	#4096.	,(r0)+		; modifier (ie, io.wal)
	.write
	movb	firqb	,r0		; return error code and exit
	return




	.sbttl	do a filename string scan

;	L $ F S S
;
;	input:	@r5	.asciz string of the device or filename
;	output:	firqb	the usual
;		r0	error code if any


l$fss::	clrfqb
l$fssx::mov	@r5	,r0		; get the filename address
10$:	tstb	(r0)+			; and now get the length
	bne	10$			; no null, keep going
	sub	@r5	,r0		; now get the length
	dec	r0			; which is off by one of course
	mov	r0	,xrb+xrlen	; length of the string
	mov	r0	,xrb+xrbc	; once again
	mov	#xrb+xrloc,r0		; finish clearing out
	mov	@r5	,(r0)+		; starting address of string
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	clr	(r0)+			; unused
	.fss				; now do it please
	movb	firqb	,r0		; return error
	return

	.assume	<xrb+xrlen+2> eq <xrb+xrbc>
	.assume	<xrb+xrbc+2>  eq <xrb+xrloc>


	.sbttl	normal i/o to the terminal

;	S T T Y O U
;
;	input:	2(sp)	buffer address
;		4(sp)	buffer length
;	output:	'c' 	set on error
;		'c'	clear on no error
;
;
;	L $ T T Y O
;
;	l$ttyou( %loc buffer, %val string_length )
;
;	input:	@r5	buffer address
;		2(r5)	buffer length


l$ttyo::save	<r0,r1>			; save temps here please
	mov	2(r5)	,r0		; string length
	bne	20$			; length was passed
	mov	@r5	,r0		; no length, assume .asciz
10$:	tstb	(r0)+			; move along looking for a null
	bne	10$			; none yet so far
	sub	@r5	,r0		; get the length
	dec	r0			; off by one
20$:	mov	#xrb	,r1		; address of xrb parameter block
	mov	r0	,(r1)+		; buffer length
	mov	r0	,(r1)+		; byte count for the i/o
	mov	@r5	,(r1)+		; address of the buffer
	movb	binmod	,@r1		; perhaps we need to preserve
	aslb	(r1)+			; binary i/o modes here
	clrb	(r1)+			; unused	
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	clr	@r1			; unused
	tst	binmod			; in binary mode?
	bne	25$			; yes
	mov	#40000	,@r1		; no, stuff xrmod with transparent mode
25$:	.write
	cmpb	firqb	,#11		; i/o channel not open ?
	bne	30$			; no, exit please

	clr	binmod			; yes, clear the binary i/o lun
	mov	#xrb	,r1		; address of xrb parameter block
	mov	r0	,(r1)+		; buffer length
	mov	r0	,(r1)+		; byte count for the i/o
	mov	@r5	,(r1)+		; address of the buffer
	clr	(r1)+			; unused	
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	mov	#40000	,(r1)+		; xrmod
	.write
	

30$:	unsave	<r1,r0>			; pop registers please
	tstb	firqb			; any errors ?
	bne	90$			; yes
	clc				; no
	return
90$:	sec				; yes, set error flag and exit
	return


sttyou::mov	r5	,-(sp)
	mov	sp	,r5
	add	#4	,r5
	call	l$ttyo
	mov	(sp)+	,r5
	return


l$pcrl::.print	#100$
	return

100$:	.byte	cr,lf,0,0

	.sbttl	other junk

$clrxr::save	<r0>
	mov	#xrb	,r0
10$:	clr	(r0)+
	cmp	r0	,#xrb+14
	blos	10$
	unsave	<r0>
	return



$clrfq::save	<r0>
	mov	#firqb	,r0
10$:	clr	(r0)+
	cmp	r0	,#firqb+36
	blos	10$
	unsave	<r0>
	return



	.sbttl	exit kermit and logout


exit::	clrxrb				; ensure xrb is clear first
	clrfqb				; this must be cleared out
	.rts				; try to go to users KBM
	.exit				; failed, go to the system's DEFKBM


logout::clrfqb				; ensure firqb is cleared out
	movb	#uu.bye	,firqb+fqfun	; log out now
	.uuo				; simple
	cmp	firqb+4	,#-1		; are we logged out ?
	beq	100$			; no
	call	exit			; yes, exit please
100$:	return				; quota must be exceeded


quochk::clrfqb				; try to see if the logout will work
	movb	#uu.rad	,firqb+fqfun	; rad accounting data please
	.uuo				; simple
	clr	r0			; assume success
	tstb	firqb			; did it work ?
	bne	100$			; no
	tst	firqb+34		; unlimited quota here ?
	beq	100$			; yes
	cmp	firqb+6,firqb+34	; is used > allowed ?
	blos	100$			; quota is ok
	.stat				; checks for (1,*)
	cmpb	xrb+11	,#1		; well ?
	beq	100$			; logout is ok then
	mov	#-1	,r0		; quota is not ok, flag it
100$:	return



;	D S K U S E
;
;	input:	@r5	address of string to return the usage


dskuse::save	<r0,r1>
	clrfqb				; clear firqb out
	movb	#uu.rad	,firqb+fqfun	; uuo function, read accounting data
	.uuo				; do it
	mov	@r5	,r1		; point to the output string
	copyz	#120$	,r1		; copy a header over please
	strlen	r1			; get the current length
	add	r0	,r1		; point to the end of the string
	deccvt	<firqb+6>,r1,#6		; and convert used to string
	add	#6	,r1		; point to the end again
	copyz	#130$	,r1		; copy some more stuff
	strlen	r1			; get the count of chars we copied
	add	r0	,r1		; point to the end of the string
	mov	firqb+34,r0		; get the quota
	bne	10$			; not unlimited
	copyz	#140$	,r1		; unlimited, say so
	br	20$
10$:	sub	firqb+6	,r0		; and get the free space
	deccvt	r0	,r1		; copy the free space over now
	clrb	6(r1)			; make the string .asciz
20$:	unsave	<r1,r0>
	return				; bye


120$:	.asciz	/SY: Space used /
130$:	.asciz	/    Space free /
140$:	.asciz	/    Unlimited/
	.even





	.sbttl	cantyp	cancel typeahead


;	C A N T Y P
;
;	cantyp(%val channel_number)
;
;	input:	@r5	the device name to cancel typeahead on
;		2(r5)	lun, for RSX compatibilty
;
;
;	 Cantyp tries to dump all pending input on a given terminal
;	line  by using  the normal  .spec call.   The documentation 
;	states that the KB must not be open which I find a bit odd.
;	It really should not make any difference. At any rate, call
;	the routine before you open it.


cantyp::save	<r1,r2>			; use r0 to point into xrb
	call	ttpars			; parse the passed device name
	bcs	90$			; the parse failed
	mov	r0	,r2		; save the parsed unit number
	sub	#40	,sp		; allocate a buffer for gttnam
	mov	sp	,r1		; and a pointer to it please
	calls	gttnam	,<r1>		; get the local terminal name
	calls	ttpars	,<r1>		; parse the device name now
	add	#40	,sp		; pop the local buffer
	clr	-(sp)			; assume _KB: for now
	cmpb	r0	,r2		; is the unit number the same as
	beq	10$			; the console terminal ? if eq, Y
	mov	r2	,@sp		; no, stuff the correct unit number
10$:	mov	#xrb	,r1		; ok
	mov	#7	,(r1)+		; functioncode := cancel_typeahead
	mov	(sp)+	,(r1)+		; the kb number to use
	clr	(r1)+			; not used
	clrb	(r1)+			; no channel number today
	movb	#2	,(r1)+		; driver index for terminals
	clr	(r1)+			; not used
	clr	(r1)+			; not used
	clr	(r1)+			; not used
	.spec				; do a driver special function now
	mov	2(r5)	,r0
	asl	r0
	clr	lsize(r0)
90$:	movb	firqb	,r0		; return any errors please
100$:	unsave	<r2,r1>			; all done
	return				; bye





	.sbttl	get uic


;	G E T U I C
;
;	input:	nothing
;	output:	r0	current UIC/PPN of the user



getuic::mov	#xrb	,r0		; clear xrb out first
10$:	clrb	(r0)+			; simple
	cmp	r0	,#xrb+15
	blos	10$
	.stat
	mov	xrb+10	,r0		; return uic (ppn) in r0
	return



drpprv::mov	#jfsys	,xrb+0		; drop temp privs
	.clear				; simple
	return


getprv::mov	#jfsys	,xrb+0		; get temp privs back please
	.set
	return



	.sbttl	suspend the job for a while

;	S U S P E N
;
;	suspend(%val sleep_time)
;
;	input:	@r5	time to go away for


suspen::mov	@r5	,xrb+0
	bne	10$
	inc	xrb+0
10$:	.sleep
	return


	.sbttl	error text


fcserr::
fiperr::save	<r0,r1,r2>
	mov	4(r5)	,r2		; r0 := addr( errtxt )
	mov	@2(r5)	,r0
	bgt	5$
	neg	r0
5$:	movb	r0	,@#firqb+fqerno	; movbe the error number .
	movb	#errfq	,@#firqb+fqfun	; set up for sys err call
	calfip
	mov	#28.	,r0		; error text length
	mov	#firqb+fqerno	,r1	; r1 := addr( actual msg )
10$:	movb	(r1)+	,(r2)+		; go and transfer the text
	beq	20$			; did we find the end yet
	sob	r0	,10$		; all thirty bytes  worth.
20$:	clrb	@r2
40$:	unsave	<r2,r1,r0>
	return				; all done




syserp::save	<r0>
	mov	@r5	,r0
	call	rmserp
	.print	#200$
	unsave	<r0>
	return

200$:	.byte	cr,lf,0,0


syserr::save	<r1>			; save a register
	clr	-(sp)			; allocate variable for error #
	mov	sp	,r1		; and point to it
	mov	@r5	,@r1		; if errornumber > 0
	bmi	10$			;  then
	calls	fiperr	,<#2,r1,2(r5)>	;   call fiperr(num,text)
	br	100$			;  else
10$:	calls	rmserr	,<#2,r1,2(r5)>	;   call rmserr(num,text)
100$:	tst	(sp)+
	unsave	<r1>
	return

	global	<fiperr	,rmserp	,rmserr>




	.sbttl	ttypar	set parity stuff for kermit


;	T T Y P A R
;
;	ttypar( %loc terminal name, %val paritycode )
;
;	input:	@r5	address of terminal name
;		2(r5)	parity code
;	output:	r0	error code

	.if ne	,0			; we don't need this anymore
	.ift

ttypar::call	ttpars			; get the terminal unit number
	bcs	100$			; oops
	clrfqb				; clear firqb out for defualts
	inc	firqb+20		; assume no parity
	cmpb	2(r5)	,#par$no	; really no parity ?
	beq	10$			; yes
	inc	firqb+20		; try next for even parity
	cmpb	2(r5)	,#par$ev	; well ?
	beq	10$			; yes
	inc	firqb+20		; not NONE or EVEN --> ODD
	cmpb	2(r5)	,#par$od	; must be
	beq	10$			; yes
	movb	#18.	,firqb		; no, return illegal sys usage
	br	100$
10$:	movb	r0	,firqb+5	; stuff the terminal unit number
	movb	#uu.trm	,firqb+fqfun	; terminal call today
	.uuo				; simple
100$:	movb	firqb	,r0		; get any errors
	return

	.endc				; don't need hardware parity control

chkpar::clr	r0
	return




	.sbttl	hangup a terminal, set dtr on a terminal


;	T T Y H A N
;
;	ttyhan( %loc terminalname )
;
;	input:	@r5	address of the terminal name
;	output:	r0	error code


ttyhan::call	ttpars			; the usual, parse the device name
	bcs	100$			; oops
	clrfqb				; clear the firqb please
	movb	#uu.hng	,firqb+fqfun	; terminal call today
	movb	r0	,firqb+4	; unit number
	movb	#1	,firqb+5	; do it asap
	.uuo				; simple
100$:	movb	firqb	,r0		; return error code and exit
	return				; bye



;	raise DTR on a terminal line
;
;	T T Y D T R
;
;	ttydtr( %loc terminalname )
;
;	input:	@r5	address of the terminal name
;	output:	r0	error code


ttydtr::call	ttpars			; the usual, parse the device name
	bcs	100$			; oops
	clrfqb				; clear the firqb please
	movb	#uu.hng	,firqb+fqfun	; terminal call today
	movb	r0	,firqb+4	; unit number
	movb	#377	,firqb+5	; set dtr function
	.uuo				; simple
100$:	movb	firqb	,r0		; return error code and exit
	return				; bye





	.sbttl	ttspeed	get speed for line


;	T T S P E E D
;
;	input:	@r5	name of terminal or address of null for current
;	output:	r0	current speed
;

	.psect	$pdata

ttdevl:	.asciz	/KLDCDLDEPKDJDHDZVH/
	.even
splst:	.word	dlalst,dclst,dlclst,dlelst,pklst,djlst,dhlst,dzlst,dhvlst
dlalst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
dclst:	.word	-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
dlclst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
dlelst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
pklst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
djlst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
dhlst:	.word	0., 50.,75.,110.,134.,150.,200.,300., 600.
	.word	1200.,1800.,2400.,4800.,9600.,0.,0,-1
dzlst:	.word	0., 50.,75.,110.,134.,150.,300.,600.,1200.
	.word	1800.,2000.,2400.,3600.,4800.,7200.,9600.,-1
dhvlst:	.word	 0,  75.,110.,134.,150.,300.,600.,1200.
	.word	1800.,2000.,2400.,4800.,0    ,9600.,19200.,-1

	.psect	$code

ttspee::save	<r1>
	call	ttpars			; parse the device name
	bcs	90$			; exit
	clrfqb				; insure no changes to tty settings
	movb	#uu.trm	,firqb+fqfun	; uuo code to do it
	movb	r0	,firqb+5	; unit number
	.uuo				; get terminal characteristics
	tstb	firqb			; did it work ?
	bne	90$			; no
	movb	firqb+24,r1		; interface type
	movb	firqb+17,r0		; get the speed of it
	dec	r0
	asl	r0			; times 2
	add	splst(r1),r0		; and the actual speed now
	mov	@r0	,r0		; got it
	br	100$			; exit
90$:	clr	r0
100$:	unsave	<r1>
	return






	.sbttl	set the speed of a terminal line



;	S E T S P D
;
;	setspd(%loc devicename, %val speed)
;
;	input:	@r5	device name
;		2(r5)	speed
;	output:	r0	error code, 255 if invalid speed

setspd::save	<r1,r2>
	call	ttpars			; parse the terminal name
	bcs	90$			; oops
	clrfqb
	movb	#uu.trm	,firqb+fqfun	; uuo code to do it
	movb	r0	,firqb+5	; unit number
	.uuo				; get terminal characteristics
	tstb	firqb			; did it work ?
	bne	90$			; no
	movb	firqb+24,r1		; interface type
	mov	splst(r1),r1		; point to the speed table for it
	clr	r2			; current index
10$:	cmp	@r1	,#-1		; reached the end of the table
	beq	80$			; yes, can't set the speed
	inc	r2			; speednum := succ( speednum )
	cmp	2(r5)	,(r1)+		; speed match ?
	bne	10$			; no
	clrfqb				; clear firqb out please
	movb	#uu.trm	,firqb+fqfun	; uuo function for terminals
	movb	r0	,firqb+5	; unit number
	movb	r2	,firqb+17	; rec speed
	movb	r2	,firqb+21	; xmit speed
	.uuo				; do it
	tstb	firqb			; error ?
	bne	90$			; yes
	clr	r0			; no
	br	100$			; exit

80$:	mov	#377	,r0		; unknown speed or not settable
	br	100$			; exit

90$:	movb	firqb	,r0		; uuo error, return it please
100$:	unsave	<r2,r1>			; bye
	return




	.sbttl	INITER	save and set the terminal characteristics

;	ttysav( %loc ttname)
;	ttyrst()
;
;	output:	r0	error code

ttysav::
ttyrst::
ttyset::clr	r0
	return



;	INITER
;
;	Passed:	0(r5)	Address of terminal name
;		2(r5)	Channel number to be used on
;	Return:	r0	error code
;
;	INITER is called ONLY internally from TTYINI()


initer:	save	<r1,r2,r3>
	call	ttpars			; set terminal up for KERMIT
	bcs	90$			; oops, bad device name
	clrfqb				; insure no unpleasant effects
	movb	#uu.trm	,firqb+fqfun	; uuo code for terminals
	movb	r0	,firqb+5	; unit number or 377
	.uuo				; get the current settings
	tstb	firqb			; did the set list work ?
	bne	90$			; no, die
	mov	2(r5)	,r1		; get the channel number please
	mul	#40	,r1		; get address of ttsave area for it
	add	#ttsave	,r1		; at last
	mov	#firqb	,r2		; get address of current settings
	mov	#40	,r3		; number of bytes to copy now
5$:	movb	(r2)+	,(r1)+		; copy a byte
	sob	r3	,5$		; next please
	clr	r1			; get the parity/8bit setting
	bisb	firqb+20,r1		; and check for parity being set
	bic	#^C3	,r1		; leave only parity bits here
	cmpb	r1	,#1		; parity set ?
	bhi	10$			; yes, can't set 8bit mode then
	movb	#30	,r1		; no parity so please set 8bit mode
10$:	clrfqb				; now actually set it
	movb	#uu.trm	,firqb+fqfun	; uuo code for terminals
	movb	r0	,firqb+5	; unit number or 377
	movb	#377	,firqb+12	; SET XON
	movb	#377	,firqb+35	; SET GAG
	movb	r1	,firqb+20	; SET 8BIT
	movb	#200	,firqb+11	; SET LC OUTPUT
	movb	#377	,firqb+15	; SET LC INPUT
	movb	#200	,firqb+30	; insure no delimiters are set now
	cmpb	handch	,#'Q&37		; This is a pain. We have to use
	beq	15$			; multiple delims cause bin mode
	cmpb	handch	,#'S&37		; perhaps XON also ?
	bne	20$			; no
15$:	movb	#200	,firqb+22	; timeouts don't work and xon's
					; don't get thru unless stall is off
20$:	
	.uuo				; go get RSTS's attention
90$:	movb	firqb	,r0		; return possible errors
	unsave	<r3,r2,r1>
	return

	global	<handch	,ttname>




	.sbttl	ttpars	get unit number from ttname

;	T T P A R S
;
;	ttpars( %loc ttname )
;
;	output:	r0	unit number or 377 for null string


ttpars::save	<r1>
	call	myterm			; get attached console name
	movb	r0	,r1		; get the name
	clrfqb				; no defaults
	clrxrb
	mov	#377	,-(sp)		; assume KB:
	mov	@r5	,r0		; address of terminal name
10$:	tstb	(r0)+			; get the length of the name
	bne	10$			; until we find a NULL
	sub	@r5	,r0		; get the length
	dec	r0			; if zero, then use 377 for unit
	beq	20$			; use zero
	mov	r0	,xrb+xrlen	; length of string for .fss
	mov	r0	,xrb+xrbc	; again
	mov	@r5	,xrb+xrloc	; address of the string to parse
	.fss				; and do it
	tstb	firqb			; did it work ?
	bne	90$			; no
	bit	#20000!40000,xrb+10	; a device name was parsed ?
	beq	80$			; no
	movb	xrb+14,	r0		; get the driver index please
	scan	r0	,#200$		; a reasonable device name?
	tst	r0			; well ?
	beq	80$			; no
	cmpb	firqb+fqdevn,r1		; same device as controlling terminal?
	beq	20$			; yes
	movb	firqb+fqdevn,@sp	; yes, save unit number
	bne	20$
	movb	#377	,@sp		; no unit, return 377 for self
20$:	clc				; flag success
	br	100$			; and exit

80$:	movb	#6	,firqb		; invlaid device name error
90$:	sec				; flag failure
100$:	mov	(sp)+	,r0
	unsave	<r1>
	return


	.iif ndf, ttyhnd, ttyhnd = 2
	.iif ndf, pkbhnd, pkbhnd = 20
	.iif ndf, dmchnd, dmchnd = 30
	.iif ndf, dmphnd, dmphnd = 46

200$:	.byte	ttyhnd	,pkbhnd	,dmchnd	,dmphnd	,0
	.even


myterm:	clrfqb
	movb	#uu.sys	,firqb+fqfun	; for a systat part one
	.uuo				; simple
	movb	firqb+5	,r0		; get the name
	return



	.sbttl	assign device


assdev::call	ttpars
	bcs	100$
	cmpb	r0	,#377
	bne	10$
	clr	r0
	br	110$
10$:	clrfqb
	movb	r0	,-(sp)
	movb	#uu.ass	,firqb+fqfun
	mov	#firqb+fqdev,r0
	movb	#'K	,(r0)+
	movb	#'B	,(r0)+
	movb	(sp)+	,(r0)+
	movb	#377	,@r0
	.uuo
100$:	movb	firqb	,r0
110$:	return


	.sbttl	namcvt	remove everything but the filename.type


;	N A M C V T
;
;	input:	@r5	source filespec
;		2(r5)	address of where to return FILENAME.TYPE

	.if ne	,0			; no longer using this version
	.ift				; See K11CVT.MAC

namcvt::save	<r1,r2>
	call	l$fss			; do a filename string scan
	tst	r0			; did it work ?
	bne	100$			; no
	mov	2(r5)	,r1		; get the destination address
	mov	#firqb+fqnam1,r2	; first three characters of filename
	calls	rdtoa	,<r1,(r2)+>	; convert it
	add	#3	,r1		; and fix the pointer up
	calls	rdtoa	,<r1,(r2)+>	; convert it
	add	#3	,r1		; and fix the pointer up
	movb	#'.	,(r1)+		; stuff a dot in please
	calls	rdtoa	,<r1,(r2)+>	; convert it
	mov	2(r5)	,r1		; get the string address back
	calls	cvt$$	,<r1,#12,#377>	; remove spaces and stuff
	add	r0	,r1		; and point to EOL now
	clrb	@r1			; and make it .asciz
	clr	r0			; no errors returned now
100$:	unsave	<r2,r1>
	return

	.endc				; we now have this in K11CVT.MAC


	.sbttl	ascdat	get the ascii string for the date

;	A S C D A T
;
;	input:	@r5	buffer address
;		2(r5)	date in system internal format


ascdat::save	<r0,r1>
	clrfqb				; clear the firqb out first
	mov	2(r5)	,firqb+4	; where to pass the date
	movb	#uu.cnv	,firqb+fqfun	; simple
	inc	firqb+6			; KERMIT uses ISO date formats
	.uuo				; get RSTS to convert the date
	clrb	firqb+22		; insure .asciz
	mov	#firqb+10,r0		; where RSTS put the date
	mov	@r5	,r1		; where we want to put it
10$:	movb	(r0)+	,(r1)+		; simple
	bne	10$			; copy until a null byte is found
	unsave	<r1,r0>			; pop temps and exit
	return






;	A S C T I M
;
;	input:	@r5	buffer address
;		2(r5)	time in system internal format


asctim::save	<r0,r1>
	clrfqb				; clear the firqb out first
	mov	2(r5)	,firqb+22	; where to pass the time
	movb	#uu.cnv	,firqb+fqfun	; simple
	inc	firqb+24		; KERMIT uses ISO time formats
	.uuo				; get RSTS to convert the time
	clrb	firqb+36		; insure .asciz
	mov	#firqb+26,r0		; where RSTS put the time
	mov	@r5	,r1		; where we want to put it
10$:	movb	(r0)+	,(r1)+		; simple
	bne	10$			; copy until a null byte is found
	unsave	<r1,r0>			; pop temps and exit
	return


	.sbttl	dodir	get a reasonable directory printed



;	D O D I R
;
;	input:	@r5	wildcarded filespec
;		2(r5)	channel to do the i/o on, 0 implies TI:
;
;	output:	r0	error code
;
;	note:	a value of zero will direct output to the terminal

dodir::	save	<r1,r2,r3,r4>
	call	dirhea			; print a header please
	sub	#42	,sp		; save the result of the .fss
	mov	sp	,r4		; and point to it please
	sub	#100	,sp		; allocate a buffer
	clr	r1			; index in directory
	call	dirini			; init things
	bcs	90$			; error in the .fss parse

10$:	mov	r4	,-(sp)		; save the firqb save area pointer
	mov	#firqb	,r3		; and a pointer to the firqb itself
	mov	#40	,r0		; number of bytes to copy
20$:	movb	(r4)+	,(r3)+		; simple
	sob	r0	,20$		; all done loading the firqb
	mov	(sp)+	,r4		; restore the pointer now
	mov	r1	,firqb+4	; store the index for the file
	movb	#lokfq	,firqb+3	; directory lookup please
	calfip				; get fip to do it please
	movb	firqb	,r0		; did it work ?
	bne	90$			; no
	mov	sp	,r3		; point to the string buffer
	call	dirprt			; yes, convert it please
	inc	r1			; 
	br	10$


90$:	tst	r1			; error, did we already find a file?
	beq	100$			; no
	clr	r0			; yes

100$:	add	#100+42	,sp
	unsave	<r4,r3,r2,r1>
	return

	global	<defdir>



	.sbttl	init for the directory


dirini:	mov	@r5	,r2		; string address
	beq	5$			; address of zero ?
	tstb	@r2			; a null string ?
	bne	10$			; no
5$:	mov	#wild	,r2		; yes, supply *.*
10$:	calls	l$fss	,<#defdir>	; stuff firqb with defaults
	calls	l$fssx	,<r2>		; parse the string with defaults
	tst	r0			; did it work ?
	bne	90$			; no
	bit	#1	,xrb+10		; was some kind of filename passed?
	bne	20$			; yes
	mov	#134745	,firqb+fqnam1+0	; no, insert *
	mov	#134745	,firqb+fqnam1+2	; no, insert *

20$:	bit	#20	,xrb+10		; was a non-null extension passed ?
	bne	30$			; yes
	bit	#10	,xrb+10		; no extension, was the extension an
	bne	30$			; explicit null (ie, abcdef.) ?
	mov	#134745	,firqb+fqnam1+4	; no, stuff .* into the filespec

30$:	tst	2(r5)
	bne	40$			; allow remote dir to function
	call	getuic			; check for clearing uic for user's
	swab	r0			; get the group number now
	cmpb	r0	,#1		; default is priv user's only
..dirp	==	. - 2			; patch this via onlpat perhaps
	blos	40$			; ok
	clr	firqb+fqppn		; not ok, clear uic field out then

40$:	mov	r4	,-(sp)		; save the firqb save area pointer
	mov	#firqb	,r3		; and a pointer to the firqb itself
	mov	#40	,r0		; number of bytes to copy
50$:	movb	(r3)+	,(r4)+		; simple
	sob	r0	,50$		; all done saving the firqb
	mov	(sp)+	,r4		; restore the pointer now
	clc				; success
	br	100$			; bye

90$:	sec				; failure
100$:	return				; bye

	global	<getuic>


	.sbttl	more routines for dodir


dirprt:	save	<r1,r2>
	mov	r3	,-(sp)		; save the pointer please
	mov	#firqb+fqnam1,r2	; first three characters of filename
	calls	rdtoa	,<r3,(r2)+>	; convert it
	add	#3	,r3		; and fix the pointer up
	calls	rdtoa	,<r3,(r2)+>	; convert it
	add	#3	,r3		; and fix the pointer up
	movb	#'.	,(r3)+		; stuff a dot in please
	calls	rdtoa	,<r3,(r2)+>	; convert it
	add	#3	,r3		; bump the pointer along please
	movb	#40	,(r3)+		; some spaces
	movb	#40	,(r3)+		; some spaces
	mov	firqb+16,r0		; the file size
	deccvt	r0,r3,#6		; convert it to ascii
	add	#6	,r3		; point past the number now
	movb	#40	,(r3)+		; some spaces
	movb	#40	,(r3)+		; some spaces
	mov	firqb+24,r2		; save the date of creation
	calls	asctim	,<r3,firqb+26>	; convert the time
	mov	(sp)	,r3
	strlen	r3			; get the current length
	add	r0	,r3		; and point to the new end of it
	calls	ascdat	,<r3,r2>	; and get the date
	mov	(sp)+	,r3		; point back to the string
	mov	r3	,r1		; setup for call to i/o routine
	strlen	r1			; get the length into r0 please
	call	dirwri			; do the disk or terminal i/o now
220$:	unsave	<r2,r1>
	return
	

dirhea:	save	<r1,r2,r3>
	sub	#100	,sp		; build an expanded filespec string
	mov	sp	,r3		; now point to it please
	mov	@r5	,r1		; point to parameter list
	tstb	@r1			; anything there ?
	bne	255$			; yes
	mov	#wild	,r1		; no, insert *.*
255$:	calls	fparse	,<r1,r3>	; and get the expanded filename
	tst	r0			; did it work ?
	beq	256$			; yes
	mov	r1	,r3		; no, use the source string then
256$:	sub	#100	,sp		; now allocate a text buffer
	mov	sp	,r1		; allocate and point to a buffer
	copyz	#headtx,r1,#24		; copy a header please
	strlen	r1			; get the length so far
	add	r1	,r0		; and point to the end of it
	copyz	r3,r0,#50		; copy the filespec over
	strlen	r1			; get the total length now
	call	dirwri			; dump this record
	mov	#dcrlf	,r1		; add in an extra cr/lf
	mov	#2	,r0		; and dump that also please
	call	dirwri			; do it
260$:	add	#100*2	,sp		; pop the local buffer
	unsave	<r3,r2,r1>
	return				; and exit



dirwri:	tst	2(r5)			; decide whether or not to do i/o
	beq	280$			; to the terminal or a disk file.
	calls	putrec	,<r1,r0,2(r5)>	; disk, passed a nonzero unit #.
	br	290$			; bye
280$:	print	r1,r0			; the local terminal
	print	#dcrlf,#2		; a crlf
290$:	return				; bye


wild:	.asciz	/*.*/
headtx:	.asciz	<cr><lf>/Directory of /
dcrlf:	.byte	cr,lf
	.even
	



	.sbttl	force a xon to the connect line

;	T T X O N
;
;	input:	@r5	device name, asciz
;		2(r5)	lun (for rsxm/m+ compatibility)
;	output:	r0	error code


ttxon::	save	<r1>			; save a temp register
	mov	@r5	,r1		; passed address of 0 or a null string?
	beq	80$			; no address, assume _KB:
	tstb	@r1			; null string passed ?
	beq	80$			; yes, assume the console terminal
	call	ttpars			; parse the terminal device name
	bcs	90$			; oops
10$:	clrxrb				; insure no defaults
	mov	#xrb	,r1		; point to the xrb now
	mov	#5	,(r1)+		; force to kb: function for .SPEC
	inc	(r1)+			; one byte to force please
	mov	#200$	,(r1)+		; address of the buffer for output
	mov	#ttyhnd*400,(r1)+	; channel zero, device driver index
	mov	r0	,(r1)+		; terminal number
	.spec				; simple
	br	90$

80$:	mov	#6	,r0		; ?invalid device name
	br	100$			; bye
90$:	movb	firqb	,r0		; error, return it please
100$:	unsave	<r1>			; pop the register we saved
	return

200$:	.byte	'Q&37,0			; a control Q today


	.sbttl	printer spooling for RSTS


	.iif ndf, uu.spl, uu.spl = -28.


;	Q S P O O L
;
;	calls QSPOOL	,<address(filename)>
;
;	returns:	r0 := rsts error code (if any)

sp.dev::.word	0
sp.mod::.word	0			; use 4!40 for delete and noheader


qspool::save	<r1>
	call	l$fss			; do the .fss now
	tst	r0			; fail ?
	bne	100$			; yes, exit
	mov	#firqb+16,r1		; stuff the rest of the params
	mov	#"LP	,(r1)+		; LP of course
	movb	sp.dev	,(r1)+		; assume LP0 for a moment
	movb	#377	,(r1)+		; unit is real for sure
	clr	(r1)+			; must be zero
	mov	sp.mod	,(r1)+		; /nodelete/header
	movb	#uu.spl	,firqb+fqfun	; uuo function code to do
	.uuo				; simple to do
	movb	firqb	,r0		; return any error codes
100$:	unsave	<r1>			; pop temps and exit
	return



	.sbttl	detach the server


detach::clrfqb				; insure no defaults
	movb	#uu.sys	,firqb+fqfun	; do a systat and get the kb number
	.uuo				; simple to do
	movb	firqb+5	,r1		; save the kb number
	clrfqb				; insure no defaults
	movb	#clsfq	,firqb+fqfun	; insure KB: is detached
	movb	#5*2	,firqb+fqfun+1	; the lun for it
	calfip				; do it, skip any error codes
	clrfqb
	movb	#uu.det	,firqb+fqfun	; the uuo detach code
	movb	#200	,firqb+fqfun+1	; close all luns for KB:
	.uuo				; simple to do
	movb	firqb	,r0		; return any errors
	bne	100$			; yep
	mov	#1	,xrb+0
	.sleep
	clrfqb				; now spawn a job attached
	mov	#firqb+fqfun,r0		; to our old kb
	movb	#uu.job	,(r0)+		; create a job exec call
	movb	#20!100!200,(r0)+	; into def kbm, no logins is ok
	movb	r1	,@r0		; the kb number to attach to
	bne	10$			; not KB0:
	movb	#200	,@r0		; KB0:, must set flag for it
10$:	.uuo				; simple to do, ignore errors
	clr	r0			; return success
100$:	return



	.sbttl	setcc	setup a control C trap

setcc::	mov	#ttast	,@#24
	.ttrst
	.ttech
	return

ttast:	save	<r0,r1>
	call	cctrap
	mov	#lunsize*2,r1
10$:	tst	linit(r1)
	beq	20$
	mov	r1	,-(sp)
	asr	(sp)
	call	snoecho
20$:	sub	#2	,r1
	bge	10$
	unsave	<r1,r0>
	rti

	global	<cctrap>


;	dummy epts and symbols for rsx11m/m+ compatibility

setsla::clr	r0
	return

wtmask	==	0			; dummy definitions for event flags
ef.co	==	0			; used under RSX
ef.ti	==	0
bit.co	==	0
bit.ti	==	0
sf.gmc	==	2560 
sf.smc	==	2440 
tc.fdx	==	64 
tf.ral	==	10    
tc.tbf	==	71    
tc.slv	==	0
tc.abd	==	0
tc.dlu	==	0

fu$def::.word	177777			; do we need a defdir for RMS11v2

xdorsx::call	dorsx
	return

rstsrv::clr	r0
	return



senbrk::calls	ttspee	,<@r5>		; get the remotes terminal speed
	mov	r0	,r2		; save the old speed
	calls	setspd	,<@r5,#50.,2(r5)>;try to set it down to 50 baud
	tst	r0			; did it work ?
	bne	100$			; no, forget it
	calls	binwri	,<#200$,#2,2(r5)>;yes, send a null over
	calls	setspd	,<@r5,r2,2(r5)>	; restore the terminal's speed
100$:	clr	r0
	return

200$:	.byte	0,0

	.end
