	.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   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.
;
;
;	binread( %val channel_number, %val timeout )
;	binwrit( %loc buffer, %val buffer_length, %val channel_number )
;	cantyp ( %val channel_number )
;	drpprv ( )
;	echo   ( )
;	exit   ( )
;	getprv ( )
;	getuic ( )
;	gttnam ( %loc buffer )
;	noecho ( )
;	read   ( %loc buffer, %val buffer_length, %val channel_number,
;	         %val block_number )
;	setdlm ( %val channel_number )
;	suspen ( %val sleep_time )
;	ttyini ( %loc device_name ,%val channel_number , %val ccflag )
;	write  ( %loc buffer, %val buffer_length, %val channel_number,
;	        %val block_number )

	.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

	.psect	$code

xinit::	clr	r0			; no specific RSTS init
	return




	.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::call	getprv			; will need for binary open
	clrfqb
	clrxrb
	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	2(r5)	,firqb+fqfil	; channel number please
	aslb	firqb+fqfil		; times 2 for FIP

	bit	#ter$bi	,4(r5)		; use straight binary mode today ?
	beq	30$			; no
	mov	#100001	,firqb+fqmode	; yes
	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	100$			; 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
	com	r0			; no, make control C a delimiter
40$:	calls	setdlm	,<2(r5),r0>	; no, try to set up delimiter
50$:	tst	r0			; did it work also
	beq	100$			; yes
	cmpb	r0	,#102		; "missing special feature?"
	bne	100$			; no
	.print	#200$			; yes, make it reasonable
100$:	call	drpprv			; no longer want privs please
	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



ttyfin::calls	clrdlm	,<2(r5)>	; clear private delimiters
	clrfqb				; close the terminal
	movb	#clsfq	,firqb+fqfun	; close it
	movb	2(r5)	,firqb+fqfil	; channel number
	aslb	firqb+fqfil		; times 2
	calfip
	movb	firqb	,r0
	return


	.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	#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>

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



setdlm::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$
	 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	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
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
	.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
	.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::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



;	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
	clr	(r1)+			; unused	
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	.write
	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
	.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
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	#7*2	,r0		; clear xrb out first
10$:	clrb	xrb(r0)			; simple
	sob	r0	,10$		; backwards
	.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


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


	.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,  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	save/restore terminal setting

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


ttysav::save	<r1,r2>			; save registers please
	call	ttpars			; and now parse the device name
	bcs	90$			; oops
	clrfqb				; clear the firqb for no changes
	movb	#uu.trm	,firqb+fqfun	; get terminal characteristics
	movb	r0	,firqb+5	; get the unit number
	.uuo				; now get RSTS to tell us about it
	tstb	firqb			; did it work ?
	bne	90$			; no
	mov	#firqb	,r0		; copy the entire firqb over now
	mov	#ttparm	,r1		; where to save it at
	mov	#40	,r2		; byte count
10$:	movb	(r0)+	,(r1)+		; simple
	sob	r2	,10$		; next please
	clr	r0			; no errors
	br	100$			; bye

90$:	movb	firqb	,r0		; error, return it in r0
100$:	unsave	<r2,r1>			; pop registers and exit
	return



ttyrst::save	<r1,r2>			; save registers please
	mov	#ttparm	,r0		; where to save it at
	mov	#firqb	,r1		; copy the entire firqb over now
	mov	#40	,r2		; byte count
10$:	movb	(r0)+	,(r1)+		; simple
	sob	r2	,10$		; next please
	movb	#uu.trm	,firqb+fqfun	; set terminal characteristics
	.uuo				; simple
	movb	firqb	,r0		; copy error code if one
	unsave	<r2,r1>			; pop registers and exit
	return


ttyset::save	<r1>
	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
	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
	.uuo				; go get RSTS's attention
90$:	movb	firqb	,r0		; return possible errors
	unsave	<r1>
	return

	global	<ttparm>

	.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:	clrfqb				; get speed of the interface
	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
	movb	firqb+fqdevn,@sp	; yes, save unit number
20$:	clc				; flag success
	br	100$			; and exit

90$:	sec				; flag failure
100$:	mov	(sp)+	,r0
	return


	.sbttl	assign device


assdev::call	ttpars
	bcs	100$
	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
	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


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



	.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	250$			; print a header please
	sub	#100	,sp		; allocate a buffer
	clr	r4			; index in directory
	mov	@r5	,r2		; string address
	beq	5$			; address of zero ?
	tstb	@r2			; a null string ?
	bne	10$			; no
5$:	mov	#300$	,r2		; yes, supply *.*
10$:	mov	sp	,r3		; point to the output buffer
	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$:	mov	r4	,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
	call	200$			; yes, convert it please
	inc	r4			; 
	br	10$


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

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

	global	<defdir>



	.sbttl	more routines for dodir


200$:	mov	r2	,-(sp)
	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	270$			; do the disk or terminal i/o now
220$:	mov	(sp)+	,r2		; pop old r2 also
	return
	

250$:	sub	#100	,sp		; build an expanded filespec string
	mov	sp	,r3		; now point to it please
	mov	r5	,r1		; point to parameter list
	mov	@r1	,r0		; get the first character in string
	tstb	@r0			; anything there ?
	bne	255$			; yes
	mov	#300$	,r1		; no, insert *.*
255$:	calls	fparse	,<r1,r3>	; and get the expanded filename
	sub	#100	,sp		; now allocate a text buffer
	mov	sp	,r1		; allocate and point to a buffer
	copyz	#310$,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	270$			; dump this record
	mov	#320$	,r1		; add in an extra cr/lf
	mov	#2	,r0		; and dump that also please
	call	270$			; do it
260$:	add	#100*2	,sp		; pop the local buffer
	return				; and exit



270$:	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	#320$,#2		; a crlf
290$:	return				; bye


300$:	.asciz	/*.*/
310$:	.asciz	<cr><lf>/Directory of /
320$:	.byte	cr,lf
	.even

	.sbttl	dupatr	copy file attributes from lun to lun


;	input:	0(r5)	lun for input file
;		2(r5)	lun for output file
;	output:	r0	error code


dupatr::save	<r1>			; save a register we will use
	clrfqb				; clear the firqb out first please
	movb	#uu.atr	,firqb+fqfun	; read attributes call
	movb	@r5	,firqb+4	; channel number please
	.uuo				; try to read the attributes
	movb	firqb	,r0		; anything happen we don't want?
	bne	100$			; yes, die
	mov	#firqb+34,r1		; now count the number of entries
	mov	#13	,r0		; max number of entries possible
10$:	tst	-(r1)			; a real entry here ?
	bne	20$			; yes, stop
	sob	r0	,10$		; next one please
	br	100$			; no attributes, just exit
20$:	movb	#uu.atr	,firqb+fqfun	; write attributes this time
	movb	2(r5)	,firqb+4	; channel number to do it for
	movb	r0	,firqb+5	; number of words to write out
	.uuo				; simple to do
	movb	firqb	,r0		; get any error codes
100$:	unsave	<r1>			; time to leave now
	return
	




	.sbttl	setcc	setup a control C trap

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


	.end
