.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



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

	.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
lokahd:	.word	0			; /44/
linit:	.blkw	20
lpoint:	.blkw	20
lsize:	.blkw	20
lbuffer:.blkb	MAXLNG+<MAXLNG/10>	; /42/ Bigger for LONG PACKETS
	.even
ttsave:	.blkb	40*15
bufqsav:.blkb	15
	.even
ver9.x::.word	0
$xon:	.byte	'Q&37
$off:	.byte	'S&37

	ALSIZE	==	400
	SDBSIZ	==	400

$albuf:	.blkb	ALSIZE
$phnum:	.blkb	60


	global	<albuff,phnum>


	.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
	.enabl	lsb

xinit::	save	<r1>
	call	rmsini			; /53/ Setup SST
	call	getsys			; /58/ See if really RSTS
	cmpb	r0	,#SY$RSTS	; /58/ Well?
	beq	1$			; /58/ Its ok
	MESSAGE	<This task image was linked for RSTS/E>,CR
	mov	(pc)+	,-(sp)		; /58/ RSX exit
	.byte	51.,1			; /58/ Code for EXIT$S
	emt	377			; /58/ Do it
1$:	mov	#$phnum	,phnum		; /51/
	mov	#$albuf	,albuff		; /51/ Fill address in.
	clrb	@phnum			; /51/ Clear
	clr	@albuff			; /51/ Clear first word.
	mov	#$cmdbuf,cmdbuf		; /53/ $CMDBUF defined in K11RMS
	mov	#$argbuf,argbuf		; /53/ $ARGBUF defined in K11RMS
	mov	sp	,infomsg	; /41/ msg displaying
	mov	#doconn	,altcon		; /44/
	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.
	clrb	bufqsav(r0)		; /40/ clear old buffer quotas
	sob	r0	,10$		; makes it easy to save via LUN
	calls	l$fss	,<#kb>		; 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	20$			; ok
	direrr	r0			; oops
20$:	call	inqv9			; /40/ global flag for version 9.x
	bcs	40$			; /45/ Not version 9 or later
	clrfqb				; /45/ V9, get the JOB type
	movb	#UU.SYS	,FIRQB+FQFUN	; /45/ Job stats, part 3
	movb	#2	,FIRQB+5	; /45/ Subfunction code
	.UUO				; /45/ Do it please
	mov	#proctype,r0		; /45/ Address of process_type
	clr	(r0)			; /45/ Word sized
	movb	FIRQB+20,(r0)		; /45/ Save our process type now
	clr	jobtype			; /45/ Assume interactive
	cmpb	(r0)	,#PRO$NET	; /45/ Is this a SET HOST job ?
	beq	30$			; /45/ Yes, let it be INTERACTIVE
	cmpb	(r0)	,#PRO$BAT	; /45/ Is this a BATCH job ?
	bne	30$			; /45/ No, assume INTERACTIVE for now
	mov	#JOB$BAT,jobtype	; /45/ Set BATCH access
30$:					; /45/ Maybe more kinds in the future
40$:	call	inqter			; /39/ get terminal type
	movb	r0	,vttype		; /39/ same terminal type
	cmp	jobtype	,#JOB$BAT	; /59/ Batch?
	bne	50$			; /59/ No
	clr	vttype			; /59/ Yes, dumb terminal
	clr	blip			; /59/ No packet count updates
50$:
	clr	r0
	unsave	<r1>
	return

	.save
	.psect	$PDATA	,D
kb:	.asciz	/_KB:/
	.even
	.restore
	.dsabl	lsb

	global	<lastli,lastcn>
	global	<df$rat,df$rfm,fb$stm,getuic,lun.tt,vttype>
	global	<infomsg,inqter>
	global	<doconn,altcon,jobtyp,procty>	; /44/
	global	<ARGBUF,CMDBUF,$ARGBUF,$CMDBUF>	; /53/
	global	<RMSINI,GETSYS,BLIP>		; /53/

	.assume	JOB$INT eq 0			; /45/


	.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

	.enabl	lsb

ttyini::save	<r2>
	clr	lokahd			; /44/ Clear lookahead
	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	,<#kb>		; 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

	.save
	.psect	$PDATA	,D
	.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
	.restore
	.dsabl	lsb




	.sbttl	close up a terminal line


ttyfin::save	<r1,r2,r3>
	call	ttpars			; get unit number
	mov	r0	,r3		; save it
	movb	FIRQB	,r0		; check foor any errors from parse
	bne	100$			; oops
	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
	clrfqb				; /40/ insure no unpleasant effects
	movb	#UU.TRM	,FIRQB+FQFUN	; /40/ uuo code for terminals
	incb	FIRQB+4			; /40/ subfunction one
	movb	r3	,FIRQB+5	; /40/ unit number or 377
	movb	bufqsav(r1),FIRQB+27	; /40/ restore old buffer quotas
	.UUO				; /40/ ignore errors
	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>

	.save
	.psect	$PDATA	,D

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

	.restore

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

	.save
	.psect	$PDATA	,D

xzmask:	.byte	^B00100010		; control E and A (/56/)
	.byte	0
	.byte	0
	.byte	^B00000101		; control X and control Z please
	.rept	34
	.byte	0
	.endr

	.RESTORE

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
	bne	10$			; /52/ Not Chan zero
	.TTECH				; /52/ Chan zero, insure echo
10$:	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
	clr	r1			; /36/ assume error
	movb	FIRQB	,r0		; return error code and exit
	bne	100$			; /36/ insure zero bytecount on error
	mov	xrb+xrbc,r1
100$:	return

kbread::.TTECH
	calls	read	,<@r5,#80.,#0,#0> ; do the actual read now
	mov	r1	,-(sp)		; /36/ save byte count
	add	@r5	,r1		; /36/ point to end to make it .asciz
	clrb	@r1			; /36/ .asciz
	mov	(sp)+	,r1		; /36/ restore length
	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
;
;
;	BINREAD is called ONLY for packet reading.
;	XBINREA is called for general single character data reading
;
;
; /44/	If a packet reads gets ESC<letter>, where LETTER is in the
;	range 100-137,  then we can safely assume that the version
;	9 terminal driver did us the favor of converting a C1 char
;	into the equivalent (?) escape sequence. What a hack!


pakrea::
binrea::tstb	lokahd+1		; /44/ Anything REALLY there?
	bne	90$			; /44/ Yes, use it
	call	doread			; /44/ Read next character
	tst	r0			; /44/ Success?
	bne	100$			; /44/ No, just exit with error
	cmpb	r1	,#33		; /44/ Escape character?
	bne	100$			; /44/ No, use it as is
	call	doread			; /44/ Yes, look for char in 100..137
	tst	r0			; /44/ Should always work
	bne	95$			; /44/ But if not, return( '\033' )
	cmpb	r1	,#100		; /44/ Is it in the range of \0100
	blo	80$			; /44/ to \0137 ?
	cmpb	r1	,#137		; /44/ Well ?
	bhi	80$			; /44/ Yes, we can't control it then
	bisb	#100	,r1		; /44/ In range, restore to CORRECT
	br	100$			; /44/ format of CTL+0100

80$:	incb	lokahd+1		; /44/ Invalid, set lookahead flag
	movb	r1	,lokahd+0	; /44/ Save the data please
	movb	#33	,r1		; /44/ Return( '\033' )
	br	100$			; /44/ for next read and exit

90$:	clr	r1			; /44/ Setup for lookahead data
	bisb	lokahd	,r1		; /44/ Insert lookahead data
95$:	clr	lokahd			; /44/ No more lookhahead data
	clr	r0			; /44/ No errors
100$:	return				; /44/ Exit



	.sbttl	Really read next character in the buffer now
doread:	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	#MAXLNG	,(r0)+		; /42/ buffer length
	clr	(r0)+			; must be zero
	mov	#lbuffer,(r0)+
	movb	r2	,(r0)+		; channel number
	bne	5$			; /52/ Not zero
	.TTECH				; /52/ Zero, insure echoing
5$:	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
	beq	30$			; /45/ No errors
	cmpb	r0	,#DETKEY	; /45/ I/O to detached Keyboard ?
	bne	100$			; /45/ No
	mov	#1	,XRB+0		; /45/ Yes, sleep a moment
	.SLEEP				; /45/ ...
	br	100$			; /45/ Exit
30$:	mov	xrb+xrbc,lsize(r2)	; Read size, save it
	clr	lpoint(r2)
	add	#1	,rdrate+4	; /56/ Stats
	bcs	40$			; /56/ Overflowed
	add	lsize(r2),rdrate+2	; /56/ Count the data
	adc	rdrate+0		; /56/ 32 bits worth
	br	100$			; /56/ And exit
40$:	clr	rdrate+0		; /56/ Overflow, so reset
	clr	rdrate+2		; /56/ Overflow, so reset
	clr	rdrate+4		; /56/ Overflow, so reset	
100$:	return

	global	<rdrate>		; /56/

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
	bne	5$			; /52/ Not zero
	.TTECH				; /52/ Zero, insure echoing
5$:	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::tst	jobtyp			; /45/ Can't do from batch
	bne	110$			; /45/ Exit then
	calls	xbinrea	,<#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

	.assume	JOB$INT eq 0
	.assume	JOB$BAT eq 1


read1c::CLRXRB				; Insure XRB is zapped
	.TTNCH				; No echo
	.TTDDT				; One shot ODT mode
	CLRXRB				; Insure XRB zapped
	clr	-(sp)			; Allocate a buffer
	mov	sp	,r1		; A pointer
	mov	r1	,XRB+XRLOC	; Buffer address
	inc	XRB+XRLEN		; One character size buffer
	.READ				; Simple
	clr	r0			; Return the character next
	tstb	FIRQB			; Errors?
	bne	100$			; Yes, return a NULL
	tst	XRB+XRBC		; No data?????
	beq	100$			; Should never happen.
	bisb	@r1	,r0		; No, return the data then.
100$:	tst	(sp)+			; Pop the buffer and exit
	return				; Bye

Wrtall::SAVE	<r0,r1,r2>		; Save registers
	mov	2+6(sp)	,r2		; String address
	STRLEN	r2			; Get the length
	mov	#xrb	,r1		; address of xrb parameter block
	mov	r0	,(r1)+		; buffer length
	mov	r0	,(r1)+		; byte count for the i/o
	mov	r2	,(r1)+		; address of the buffer
	clr	(r1)+			; Channel zero
	clr	(r1)+			; unused
	clr	(r1)+			; unused
	mov	#4096.	,(r1)+		; modifier (ie, io.wal+nostall)
	.WRITE				; Do the WRITE
	UNSAVE	<r2,r1,r0>		; Pop registers
	mov	(sp)+	,(sp)		; Move return address up
	return				; And exit


	.sbttl	write everything to the communications line

;	P A K W R I
;
;	input:	@r5	buffer address
;		2(r5)	buffer size
;		4(r5)	channel number
;	output:	r0	error code
;
;	 Pakwrite(buffer,size,lun) attempts  to  write out the specified
;	number of bytes in pass all  mode  to  the  line.  Additionally,
;	NOSTALL  is  specified  the first time to allow us to detect the
;	line being XOFF'ed. The side effect is  that  we  may  also  get
;	returned  on  a  lack  of  small  buffers,  so  thus  we must be
;	prepared to try again if that was the case. If we  are  XOFF'ed,
;	which  is indicated by the 'bytes not sent' value being equal to
;	the requested write size, then we force  an  XON  to  the  line.
;	We also can get an XOFF via line noise in the middle of a packet
;	thus we should also force an XOFF even for a partial write.
;	 This  is messy, addtionally, it ALWAYS requires SYSIO priv even
;	if you own the line. The code to do this always has  to  inquire
;	about  the  unit number, which is currently only possible via an
;	UU.FCB call. This is undesirable in the unlikely event that  the
;	first  few  words of the terminal DDB get changed by DIGITAL. We
;	could, of course, save the  unit  number  in  TTYINI  in  a  LUN
;	indexed table, but that's conceptually unattractive.  Even if it
;	does change,  the UU.FCB code is rarely called and not very dan-
;	gerous if things change.
;	
;	 Ideally, we  need  a  .SPEC call to return XOFF'ed status and a
;	.SPEC call to clear XOFF'ed status. The method used in  the  RSX
;	based  Kermit-11  uses  a QIOW$S with a marktime in front of it,
;	this if the mark time goes off we can  issue  an  IO.KIL,  clear
;	the  xoffed  state  with  SF.SMC+IO.CTS,  and  redo  the QIOW$S.
;	Again, the usefulness of MARK TIME and the equiv of IO.KIL comes
;	to mind for RSTS/E, as noted before in the case of having a CTRL
;	C ast routine being able to kill io requests on lines other than
;	one's console terminal, which a control C always does.
;	 Hopefully, a future  release of  RSTS/E  will  make  these task
;	simpler.  At  such  time,  we would have to consider the case of
;	older version of RSTS/E; I would simply  cut  the  current  code
;	out  and let those user's not upgrading suffer; reverting to the
;	old code in BINWRI (next page). 
;	 Lately,  I seem to be turning my comments into essays about the
;	deficiences a given exec may have.  RSTS developers, take heart,
;	using the RSTS/E terminal  driver is a LOT more predictable than 
;	than what you find on the various flavors of RSX.  I simply have
;	spent a lot of time in the last couple of years with RT11,  RSX, 
;	P/OS, TSX+ and VMS; they all have strong points and weaknesses.
;	What one likes in one is rarely found in the other.


	.sbttl	Now for the real packet writer (enough of the soapbox)

pakwri::save	<r1,r2,r3>		; /45/ Save this please
	mov	@r5	,r2		; /45/ Address of the write
	mov	2(r5)	,r3		; /45/ Size of the write
	mov	#8192.!4096.,r1		; /45/ First time modifier
10$:	mov	#XRB	,r0		; /45/ Address of xrb parameter block
	mov	r3	,(r0)+		; /45/ Buffer length
	mov	r3	,(r0)+		; /45/ Byte count for the i/o
	mov	r2	,(r0)+		; /45/ Address of the buffer
	movb	4(r5)	,@r0		; /45/ Channel number
	aslb	(r0)+			; /45/ Times 2
	clrb	(r0)+			; /45/ Unused
	clr	(r0)+			; /45/ Unused
	clr	(r0)+			; /45/ Unused
	mov	r1	,(r0)+		; /45/ Modifier (ie, io.wal+nostall)
	.WRITE				; /45/ Really dump the data
	movb	FIRQB	,r0		; /45/ return error code and exit
	bne	100$			; /45/ Error, exit NOW
	tst	XRB+XRBC		; /45/ Did EVERTHING get dumped ?
	beq	100$			; /45/ Yes, exit with SUCCESS

	bic	#8192.	,r1		; /45/ No more 'NO STALL' modes
	mov	r3	,r0		; /45/ Get the old write size
	sub	XRB+XRBC,r0		; /45/ And compute a new buffer addr
	add	r0	,r2		; /45/ buffer = buffer + (size-left)
	mov	XRB+XRBC,r3		; /45/ New write size
					; /45/ Now try to XON the line
	clrfqb				; /45/ Try a UU.FCB to get the unit
	movb	#UU.FCB	,FIRQB+FQFUN	; /45/ number. While it's acknowledged
	movb	4(r5)	,FIRQB+FQFIL	; /45/ that data strutures may change,
	.UUO				; /45/ its unlikely that terminal DDB's
	movb	FIRQB	,r0		; /45/ will change in the first few
	bne	100$			; /45/ words.
	mov	#XRB	,r0		; /45/ Point to the XRB now
	mov	#5	,(r0)+		; /45/ Xoffed, try to clear the line
	mov	#1	,(r0)+		; /45/ One byte, an XON, to force.
	mov	#$xon	,(r0)+		; /45/ XRLOC, address of the buffer.
	mov	#TTYHND*400,(r0)+	; /45/ Low byte unused, high=driveridx
	movb	FIRQB+7	,(r0)+		; /45/ Unit number to force to
	clrb	(r0)+			; /45/ Unused
	clr	(r0)+			; /45/ Unused
	clr	(r0)+			; /45/ Unused
	.SPEC				; /45/ At last !
	mov	#4	,XRB+0		; /45/ Take a short nap and then retry
	.SLEEP				; /45/ Wait a moment.
	br	10$			; /45/ Go back, stalled write this time

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





;	B I N W R I
;
;	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+nostall)
	.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::MESSAGE
	return


	.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::	MESSAGE
	clrxrb				; /55/ ensure xrb is clear first
	.TTECH				; /55/
	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 moved to K1180S /54/ 23-Aug-86  12:21:41




	.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

clrcns::CLRXRB				; Insure XRB is cleared
	mov	#7	,XRB+XRLEN	; Cancel typeahead call
	movb	#2	,XRB+XRBLKM	; Driver index
	.SPEC				; Should be it
	return				; Exit



	.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
	MESSAGE
	unsave	<r0>
	return



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	inquire if DTR is up on a device

;	INQDTR(ttname)
;
;	Find out if DTR is up.
;
;	 On RSTS/E, DTR is up if (1) Carrier detect is up or (2) Ring is up
;	Thus,  to connect to a dialout modem,  some means  must be provided
;	for the terminal driver to 'See' CD. This can be done from internal
;	modem options, or one can cut CD and loop DTR to CD on the cpu side
;	and use the Kermit-11 command SET DTR to get CD up. This routine is
;	to return the current DTR status.  For RSX, it would be more useful
;	to return TRUE if TC.DLU==2 or TRUE if CD is up.
;
;	Returns:	1	DTR is present
;			0	DTR is NOT present
;			-1	Line is not modem controlled
;
;	18-Dec-85  09:16:08 BDN

	.iif ndf, UU.CFG, UU.CFG = 42	; So this builds on version 8 systems

inqdtr::tst	ver9.x			; /40/ only works on 9.0 or later
	beq	90$			; /40/ if so, return(-1)
	call	ttpars			; /40/ get device unit number
	tstb	FIRQB			; /40/ Was parse successful?
	bne	90$			; /40/ No, return(-1)
	clrfqb				; /40/ clear firqb out please
	movb	#UU.CFG	,FIRQB+FQFUN	; /40/ Find out if line has Modem ctl
	mov	#"KB	,FIRQB+FQDEV	; /40/ Always a KB: device please
	movb	r0	,FIRQB+FQDEVN	; /40/ Unit number please
	movb	#377	,FIRQB+FQDEVN+1	; /40/ Unit number is 'real'
	.UUO				; /40/ do it
	tstb	FIRQB			; /40/ If failure, return(nomodem)
	bne	90$			; /40/ Failed
	bitb	#4	,FIRQB+7	; /40/ If set, the line is modem ctl
	beq	90$			; /40/ No modem control, return(-1)
	clrfqb				; /40/ We have modem control, what
	movb	#UU.TRM	,FIRQB+FQFUN	; /40/ about DTR being around ?
	movb	r0	,FIRQB+5	; /40/ Unit number here this time
	.UUO				; /40/ get tt characteristics, part 1
	tstb	FIRQB			; /40/ Can't fail
	bne	90$			; /40/ But it did ?
	bitb	#200	,FIRQB+4	; /40/ At last, is DTR up ?
	bne	80$			; /40/ No, return(0)
	mov	#1	,r0		; /40/ Yes, return(1)
	br	100$			; /40/ Exit

80$:	clr	r0			; /40/ Modem line and no DTR
	br	100$			; /40/ exit
90$:	mov	#-1	,r0		; /40/ Not modem or pre 9.x system
100$:	return


inqbuf::mov	#maxpak	,r0		; /42/ Assume pre RSTS v9
	tst	ver9.x			; /42/ 9.X with huge buffer quotas?
	beq	100$			; /42/ No
	mov	#MAXLNG	,r0		; /42/ Yes, return the MAX size
100$:	return				; /42/ exit

	global	<maxpak>		; /42/


inqpar::clr	r0
	return


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

	.save
	.psect	$pdata

ttdevl:	.asciz	/KLDCDLDEPKDJDHDZVH/
	.even
splst:	.word	dlalst,dclst,dlclst,dlelst,pklst,djlst,dhlst,dzlst,dhvlst
	.word	10$,10$,10$,10$,10$,10$
10$:	.word	0,0
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
	.restore

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
	mov	splst(r1),r0		; /40/ is the speed settable?
	tst	2(r0)			; /40/ second entry is always <> 0
	beq	90$			; /40/ not settable
	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
	mov	2(r5)	,r1		; /40/ get the channel number please
	tst	ver9.x			; /40/ version 9.x or later?
	beq	4$			; /40/ no

	clrb	bufqsav(r1)		; /40/ assume nothing saved for quota
	clrfqb				; /40/ insure no unpleasant effects
	movb	#UU.TRM	,FIRQB+FQFUN	; /40/ uuo code for terminals
	incb	FIRQB+4			; /40/ UU.TRM part two
	movb	r0	,FIRQB+5	; /40/ unit number or 377
	.UUO				; /40/ get the current settings
	tstb	FIRQB			; /40/ did the set list work ?
	bne	4$			; /40/ should have
	movb	FIRQB+27,bufqsav(r1)	; /40/ save old buffer quotas
	clrfqb				; /40/ insure no unpleasant effects
	movb	#UU.TRM	,FIRQB+FQFUN	; /40/ uuo code for terminals
	incb	FIRQB+4			; /40/ subfunction one
	movb	r0	,FIRQB+5	; /40/ unit number or 377
..BUFQ	== . + 2			; /46/ Patchable
	movb	#40.	,FIRQB+27	; /40/ raise buffer quotas now
	.UUO				; /40/ ignore errors

4$:	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	7$			; /36/ yes, can't set 8bit mode then
	tstb	parity			; /36/ If software parity enabled
	beq	6$			; /36/ then we must prevent TTDVR
	cmpb	parity	,#PAR$NO	; /36/ from changing characters in
	bne	7$			; /36/ range 201-237 into esc seqs.
6$:	movb	#30	,r1		; no parity so please set 8bit mode
	br	10$			; /36/
7$:	bisb	#20	,r1		; /36/ explicitly turn 8bit mode off
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	,parity	,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

	.enabl	lsb

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

	.save
	.psect	$PDATA	,D
200$:	.byte	ttyhnd	,pkbhnd	,dmchnd	,dmphnd	,0
	.even
	.restore
	.dsabl	lsb

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
	.enabl	lsb

;	Assign the device for SET LINE. Device characteristics are
;	set in TTYINI and reset in TTYFIN. For edit /41/, check to
;	be sure that the JOB privilege mask includes HWCFG,  which
;	is needed to alter settings on other terminal lines (9.x).

	.iif ndf , PRVIOL,	PRVIOL = 12

assdev::mov	r1	,-(sp)		; /41/
	call	ttpars			; parse the terminal name
	bcs	100$			; oops
	cmpb	r0	,#377		; Return KB: ?
	bne	10$			; no
	clr	r0			; Yes, simply return
	br	110$			; exit
10$:	mov	r0	,r1		; /41/ save unit number
	tst	ver9.x			; /45/ What if this is version 8?
	beq	20$			; /45/ If so, don't try this out.
	mov	#HWCFG	,-(sp)		; /41/ See if we have JOB privs
	call	jobprv			; /41/ Well?
	tst	r0			; /41/ 1 == success
	beq	90$			; /41/ No
20$:	clrfqb				; A Real LINE today
	movb	#UU.ASS	,FIRQB+FQFUN	; Assign the device please
	mov	#FIRQB+FQDEV,r0		; Where to place the device name
	movb	#'K	,(r0)+		; name
	movb	#'B	,(r0)+		; ..name continued (Always KBnn:)
	movb	r1	,(r0)+		; unit
	movb	#377	,@r0		; Unit is 'real'
	.UUO				; get RSTS/E to do the assignment
	br	100$			; exit with error in FIRQB+0
90$:	message	<You lack the HWCFG privilege to assign a line>,cr
	mov	#PRVIOL	,FIRQB		; /41/
100$:	movb	FIRQB	,r0		; Return the error code please
110$:	mov	(sp)+	,r1		; /41/ Restore register please
	return				; exit

	.dsabl	lsb

	.save
	.psect	$PDATA
hwcfg:	.asciz	/HWCFG/
	.even
	.restore




	.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
;	output:	r0	error code
;
;	DODIR prints a directory listing at the local terminal.
;
;
;	S D O D I R
;
;	Passed:	@r5	wildcarded name
;	Return:	r0	error code, zero for no errors
;		r1	next character in the directory listing
;
;	SDODIR is called by the server to respond to a remote directory
;	command.  Instead of the pre 2.38 method of dumping output to a
;	disk file and then sending the disk file in an extended replay,
;	SDODIR  returns the next  character so that  BUFFIL can use it.
;	The routine  GETCR0  is actually a dispatch routine to call the
;	currently selected GET_NEXT_CHARACTER routine.




	.save
	.psect	dirctx	,rw,d,lcl,rel,con
dirnam:	.blkb	120
dirfir:	.blkb	42
dirbuf:	.blkb	60
diridx:	.word	0
dirptr:	.word	dirbuf
dcrlf:	.byte	15,12,0
	.even
	.restore


dodir::	save	<r1,r2,r3,r4>
	strcpy	#dirnam	,@r5
	call	dirini			; init things
	bcs	100$			; error in the .FSS parse
10$:	call	dirnex			; get the next file
	bcs	100$			; all done
	.print	#dirbuf
	br	10$
100$:	unsave	<r4,r3,r2,r1>
	clr	diridx
	return


sdirin::strcpy	#dirnam	,@r5		; copy name over
	clr	diridx			; ditto
	call	dirini			; init for calls to sdodir
	bcs	100$
	mov	#dirbuf	,dirptr		; yes, init pointers please
	clrb	@dirptr			; yes, zap the buffer
	call	dirnex			; preload buffer
100$:	return

sdodir::save	<r2,r3,r4>
10$:	movb	@dirptr	,r1		; get the next character please
	bne	20$			; something was there
	mov	#dirbuf	,dirptr		; reset the pointer
	clrb	@dirptr			; yes, zap the buffer
	call	dirnex			; empty buffer, load with next file
	bcs	90$			; no more, return ER$EOF
	br	10$			; and try again
20$:	inc	dirptr			; pointer++
	clr	r0			; no errors
	br	100$			; exit
90$:	mov	#ER$EOF	,r0		; failure, return(EOF)
95$:	clr	r1			; return no data also
	clr	diridx			; init for next time through
100$:	unsave	<r4,r3,r2>
	return
	


	global	<defdir,ER$EOF>



	.sbttl	init for the directory


dirini:	clr	diridx			; /38/
	mov	#dirnam	,r2		; string address
	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	40$			; yes
	bit	#10	,xrb+10		; no extension, was the extension an
	bne	40$			; explicit null (ie, abcdef.) ?
	mov	#134745	,FIRQB+FQNAM1+4	; no, stuff .* into the filespec

40$:	mov	#dirfir	,r4		; 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
	clc				; success
	br	100$			; bye

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

	global	<getuic>


	.sbttl	more routines for dodir


dircvt:	save	<r0,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
	strcat	r3	,#dcrlf		; append crlf
	mov	(sp)+	,r3		; point back to the string
	unsave	<r2,r1,r0>
	return
	

dirnex:	mov	#dirfir	,r4		;
	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	diridx	,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	#dirbuf	,r3		; point to the string buffer
	call	dircvt			; yes, convert it please
	inc	diridx			; setup for the next time
	clc				; success
	return				; failure

90$:	tst	diridx			; error, did we already find a file?
	beq	100$			; no, retain error code
	clr	r0			; yes, return zero and C set
100$:	clr	diridx			; clear for next time around
	sec
	return


	.save
	.psect	$PDATA	,D
wild:	.asciz	/*.*/
	.even
	.restore	



	.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	#$xon	,(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


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

	.save
	.psect	$PDATA	,D
sp.dev::.word	0
sp.mod::.word	0			; use 4!40 for delete and noheader
	.restore

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	inqterm	get terminal type (v9.x only)

;	Assume:	Login.com did a $ SET TER/INQ

	.enabl	lsb

inqter:	call	inqv9			; /39/ RSTS/E 9.x ?
	bcs	90$			; /39/ no
	clrfqb				; /39/ clear out again
	movb	#UU.TRM	,FIRQB+FQFUN	; /39/ terminal char function
	mov	#1+<400*377>,FIRQB+4	; /39/ subfunction 1, KB:
	.UUO				; /39/ read chars
	tstb	FIRQB			; /39/ success?
	bne	90$			; /39/ no
	mov	#200$	,r0		; /39/ yes, look for VT type term
10$:	tstb	@r0			; /39/ end of list yet?
	beq	90$			; /39/ yes, return( TTY )
	cmpb	(r0)+	,FIRQB+6	; /39/ no, check for a match
	bne	10$			; /39/ not yet
	mov	#VT100	,r0		; /39/ yes, return(VT100)
	br	100$			; /39/ exit

90$:	mov	#TTY	,r0		; /39/ nothing
100$:	return				; /39/ exit


	.save
	.psect	$PDATA	,D
200$:	.byte	6.			; /39/  vt100
	.byte	13.			; /39/  vt101
	.byte	14.			; /39/  vt102
	.byte	15.			; /39/  vt125
	.byte	16.			; /39/  vt131
	.byte	17.			; /39/  vt132
	.byte	18.			; /39/  vt220
	.byte	19.			; /39/  vt240
	.byte	20.			; /39/  vt241
	.byte	21.			; /39/  vt105
	.byte	22.			; /39/  vk100 (gigi)
	.byte	23.			; /39/  rt02
	.byte	48.			; /58/  VT330
	.byte	49.			; /58/  VT430
	.byte	0			; /39/  end
	.even
	.restore
	.dsabl	lsb


	.sbttl	login


	.iif ndf , UU.CHK,	UU.CHK = 40
	.iif ndf , UU.PRV,	UU.PRV = 34
	.iif ndf , NOSUCH,	NOSUCH = 5
	.iif ndf , NOTAVL,	NOTAVL = 10
	.iif ndf , PRVIOL,	PRVIOL = 12
	.iif ndf , QUOTA ,	QUOTA  = 105

;	LOGIN	24-Sep-85  10:01:33  Brian Nelson (V9.x and later only)
;		Added on Edit 2.36
;		Moved to K1180S 11-Apr-86  12:27:18




	.sbttl	Check for given privilege (V9.x and later)

;	 SETPRV is intended to reset the CURRENT privilege mask to the
;	user's AUTHORIZED mask. They could be different as a result of
;	the REMOTE LOGIN command, moving from a high access account to
;	once with lesser access.

setprv::sub	#12	,sp		; a buffer
	mov	#JFSYS	,XRB+0		; drop all privs that are not mine
	.CLEAR				; in case we inherited privilege
	clrfqb				; now read the authorized priv mask
	movb	#UU.PRV	,FIRQB+FQFUN	; UUO function code
	.UUO				; simple
	mov	#FIRQB+FQFIL,r0		; and save them
	mov	sp	,r2		; copy them onto stack save area
	mov	(r0)+	,(r2)+		; copy
	mov	(r0)+	,(r2)+		; ..copy
	mov	(r0)+	,(r2)+		; ....copy
	mov	(r0)+	,(r2)+		; ......copy
	mov	#JFSYS	,XRB+0		; now get all we had back again
	.SET				; simple

	clrfqb				; 
	movb	#UU.PRV	,FIRQB+FQFUN	; read current privilege
	.UUO				; call RSTS to do so
	mov	#FIRQB+FQFIL,r0		; now setup to copy current over
	mov	#FIRQB+FQNAM2,r1	; the current mask to the 'clear'
	mov	#4	,r2		; mask
10$:	mov	@r0	,(r1)+		; copy the privilege mask
	clr	(r0)+			; and clear this one out
	sob	r2	,10$		; next please
	movb	#UU.PRV	,FIRQB+FQFUN	; now drop ALL privileges we had
	.UUO				; simple
	clrfqb				; At last, make current privs the
	mov	sp	,r2		; ones that the user is authorized
	mov	#FIRQB+FQFIL,r1		; to have
	mov	(r2)+	,(r1)+		; insert these privileges
	mov	(r2)+	,(r1)+		; ..insert these privileges
	mov	(r2)+	,(r1)+		; ....insert these privileges
	mov	(r2)+	,(r1)+		; ......insert these privileges
	movb	#UU.PRV	,FIRQB+FQFUN	; at last, set the correct mask
	.UUO				; simple
	add	#12	,sp		; exit
	mov	#1	,r0		;
	return


chkprv::mov	2(sp)	,r1		; get address of priv to look for
	clrfqb				; clear the FIRQB out
	mov	#FIRQB+FQFUN,r0		; setup to get the bit value of WACNT
	movb	#UU.CHK	,(r0)+		; UUO subfunction
	inc	(r0)+			; UU.CHK subfunction
	tst	(r0)+			; not used
10$:	movb	(r1)+	,(r0)+		; copy the desired priv to check
	bne	10$			; next please
	.UUO				; try it out
	movb	FIRQB	,r0		; if this fails its not verison 9.x
	bne	90$			; or later
	movb	FIRQB+4	,r0		; success, check if priv is present
	bne	90$			; no
	mov	#1	,r0		; yes, return(1)
	br	100$			; exit
90$:	clr	r0			; no,  return(0)
100$:	mov	(sp)+	,(sp)		; pop stack and exit
	return				; bye


inqv9::	clrfqb				; /39/ clear FIRQB out
	clr	ver9.x			; /40/ assume old RSTS/E
	movb	#UU.PRV	,FIRQB+FQFUN	; /39/ see if version 9 or later
	.UUO				; /39/ always works (read priv mask)
	tstb	FIRQB			; /39/ success?
	bne	90$			; /39/ no
	mov	sp	,ver9.x		; /40/ flag for v9.x and later
	clc				; /39/ v.9x
	return				; /39/ exit
90$:	sec				; /39/ not 9.x
	return				; /39/ return



	.sbttl	check for current JOB priv , not PROGRAM priv.

;	 Added edit  2.41 to check if a user has HWCFG authorized to
;	effect a SET LINE command. Note that this  will  not  affect
;	the  current mask, it just checks to see if the JOB has this
;	priv. This is different than UU.CHK in that here we look  at
;	current  'JOB'  mask  where  the other (CHKPRV) looks at the
;	CURRENT program priv mask. To find AUTHORIZED priv, you must
;	call AUTHPR.
;	 Added cause the  M+  v3  Kermit will get and drop privs for
;	SET LINE.
;
;	Passed:	2(sp)	Address of priv name to check
;	Return:	r0	1 for success (or pre 9.x), zero for no priv
;
;	Example:
;
;	mov	#HWCFG	,-(sp)
;	call	JOBPRV
;	tst	r0
;	beq	error
;
;
; hwcfg:.asciz	/HWCFG/
;	.even



jobprv::mov	r1	,-(sp)		; /41/ Save a register
	mov	r2	,-(sp)		; /41/ ... save another one
	sub	#10	,sp		; /41/ temp save area
	mov	#1	,r2		; /41/ Assume success
	tst	ver9.x			; /41/ version nine or later?
	beq	100$			; /41/ no, return( success )
	clrfqb				; /41/
	mov	#FIRQB+3,r1		; /41/ point to FQFUN offset
	movb	#UU.PRV	,(r1)+		; /41/ read current priv mask.
	.UUO				; /41/ Do it
	tstb	FIRQB			; /41/ Check status (has to work)
	bne	90$			; /41/ Return( failure )
	mov	sp	,r0		; /41/ a pointer to mask save area
	mov	(r1)+	,(r0)+		; /41/ save current priv mask
	mov	(r1)+	,(r0)+		; /41/ .save current priv mask
	mov	(r1)+	,(r0)+		; /41/ ..save current priv mask
	mov	(r1)+	,(r0)+		; /41/ ...save current priv mask
	mov	#JFSYS	,XRB+0		; /41/ what to do
	.CLEAR				; /41/ Drop ALL privs now
	clrfqb				; /41/ clear firqb out
	mov	#FIRQB+FQFUN,r0		; /41
	movb	#UU.CHK	,(r0)+		; /41/ Convert priv name to bitmask
	inc	(r0)+			; /41/ Subfunbction code = 1
	tst	(r0)+			; /41/ skip this field
	mov	2+14(sp),r1		; /41/ copy the priv over
10$:	movb	(r1)+	,(r0)+		; /41/ copy the asciz name over
	bne	10$			; /41/ simple
	.UUO				; /41/ convert NAME to MASK
	mov	sp	,r1		; /41/ point back to save area
	mov	#FIRQB+FQNAM1,r0	; /41/ Where the bit pattern is
	mov	#4	,r2		; /41/ Four words to check
20$:	bit	(r0)+	,(r1)+		; /41/ Any bit(s) set here ?
	bne	30$			; /41/ Yes, we have it
	sob	r2	,20$		; /41/ No, keep looking
	clr	r2			; /41/ Flag not found
	br	40$			; /41/ Restore old priv mask
30$:	mov	#1	,r2		; /41/ Flag we have it
40$:	clrfqb				; /41/ Now restore JOB privs
	mov	#FIRQB+FQFUN,r0		; /41/ point to FQFUN offset
	movb	#UU.PRV	,(r0)+		; /41/ read current priv mask.
	mov	sp	,r1		; /41/ Saved OLD priv mask
	mov	(r1)+	,(r0)+		; /41/ save current priv mask
	mov	(r1)+	,(r0)+		; /41/ .save current priv mask
	mov	(r1)+	,(r0)+		; /41/ ..save current priv mask
	mov	(r1)+	,(r0)+		; /41/ ...save current priv mask
	.UUO				; /41/ Do it
	br	100$			; /41/ exit

90$:	clr	r2			; /41/ failure
100$:	mov	r2	,r0		; /41/ Return the status now
	add	#10	,sp		; /41/ Pop buffer
	mov	(sp)+	,r2		; /41/ ...Pop a register
	mov	(sp)+	,r1		; /41/ Pop a register
	mov	(sp)+	,(sp)		; /41/ pop parameter
	return				; /41/ At last






	.sbttl	setcc	setup a control C trap


;	SETCC	arm the control C trap
;	TTAST	field the ast
;
;	It would be REALLY nice if we had the equivalent of an IO.KIL
;	so we could cancel a pending terminal read as I do in the RSX
;	based Kermits. While it is true that control C will terminate
;	a read on your console terminal, we need to be able to cancel
;	a read that's waiting on another terminal,  as is the case if
;	Kermit is running LOCAL (set lin ttnn:).  Hopefully, some day
;	DIGITAL will provide that.



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

tidias::
tidiar::return
tmsdia::
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
tc.xsp	==	0
tc.rsp	==	0
tf.rne	==	20
tf.wal	==	10

	.save
	.psect	$PDATA	,D
fu$def::.word	177777			; do we need a defdir for RMS11v2
	.restore

xdorsx::call	doconn
	return

	global	<doconn>

rstsrv::clr	r0
	return



	.end