.title	k11m41	kermit i/o for RSX11M/M+ v4.1 and 2.1

	.ident	/5.0.01/	; Bob Denny (see below)

;	define macros and things we want for KERMIT-11


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


;	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 )
;	doconn ( )
;	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


;	20-Jan-84  09:50:18 BDN	Test and fix TTSPEED, SETSPD and BINREAD
;
; 03-Mar-84 Bob Denny	4.2.00  [RBD01]
;			Rewrote namcvt().  Eliminated FCS parsing
;			in favor of home-brew code which can handle
;			the infinite variety of filespecs that may
;			crop up when doing DECnet remote file access.
;
; 07-Mar-84 Bob Denny	5.0.00  [Edit trails removed]
;			Fair rewrite, particularly of terminal handling.
;			Changed within the existing KERMIT-11 architecture,
;			which is better suited to RSTS/E (which seems to
;			have a lot more terminal & communications options).
;			Modes for RSX now allow operation at 9600 baud for
;			packet communication.  CONNECT is still a problem.
;
; 10-Mar-84 Bob Denny	5.0.01   The method used for CONNECT on RSTS/RSX
;			will not work reliably on native RSX at baud rates
;			over 1200 on a busy system.  The "doconn()" routine
;			was rewritten.  Now there are 2 separate modules.
;			Also, the binrea() function is now used only for
;			packet reading, and has been greatly simplified.
;
; 16-mar-84 Brian Nelson
;
;			Merged origional K11M41 with Bob Denny's mods.


	.sbttl	macros

	.macro	clrfqb		; Clear the "Furk-bee" 		(I love it!!)
	call	$clrfq
	.endm	clrfqb

	.macro	clrxrb		; Clear the "Exer-bee"
	call	$clrxr
	.endm	clrxrb

	.macro	moverr	val,dst
	movb	val	,-(sp)
	call	$mover
	movb	(sp)+	,dst
	.endm	moverr

	.iif ndf, r$rsts, r$rsts = 0

	ef.tmp	=	17
	ef.tt	=	20
	ef.tmo	=	21
	er.tmo	==	176		; for now, timeout
	er.nod	==	177		; pseudo error for no data
	nodata	==	er.nod

	.sbttl	data areas

	.psect	$idata	rw,d,lcl,rel,con

fu$def::.word	0			; if rms needs the DNA filled in

	.psect	$idata	rw,d,lcl,rel,con

;
; Terminal settings and parameter lists for line setting
;
savass:	.byte	TC.SLV,0			; /{no}SLAVE
setass:	.byte	TC.SLV,1			; /SLAVE=TTnn:
assdon:	.word	0

savchr:						; Saved line parameters
	.byte	TC.ACR,0			; /{NO}WRAP
	.byte	TC.FDX,0			; /{NO}FULLDUPLEX
	.byte	TC.HFF,0			; /{NO}FORMFEED
	.byte	TC.HHT,0			; /{NO}TAB
	.byte	TC.NEC,0			; /{NO}ECHO
	.byte	TC.SLV,0			; /{NO}SLAVE
	.byte	TC.SMR,0			; /{NO}LOWERCASE
	.byte	TC.WID,0			; /WIDTH = n
	.byte	TC.8BC,0			; /{NO}EIGHTBIT
	.byte	TC.BIN,0			; /{NO}RPA	(BDN 04-Aug-84)
savlen = .-savchr
savdon:	.word	0
;
; Local line buffer for binary reading
;
inilun:	.word	0
linbuf:	.blkb	140.				; Buffer itself
maxlin 	= 	.-linbuf			; Maximum read length
	.even
linptr:	.word	linbuf				; Scan pointer
icrem:	.rept	15.				; # characters remaining
	.word	0
	.endr

;
; Other r/w data
;


	.psect	$pdata	ro,d,lcl,rel,con	; Read-only data

datchr:						; Data mode line parameters
	.byte	TC.ACR,0			; /NOWRAP
	.byte	TC.FDX,1			; /FULLDUPLEX
	.byte	TC.HFF,1			; /FORMFEED
	.byte	TC.HHT,1			; /TAB
	.byte	TC.NEC,1			; /NOECHO
	.byte	TC.SLV,1			; /SLAVE
	.byte	TC.SMR,1			; /LOWERCASE
	.byte	TC.WID,200.			; /WIDTH = 200.
	.byte	TC.8BC,1			; /EIGHTBIT
datlen	= . - datchr
ibmmod:	.byte	tc.bin,1			; /RPA (need to read XON's)

	.sbttl	xinit - assign & attach command terminal
	.mcall	alun$s	,astx$s	,qiow$s

	.psect	$code

; XINIT - Assign and attach the command terminal
;
; This routine assigns and attaches the command terminal (the
; terminal that "ran" this copy of Kermit-11.
; *** N O T E *** Later, this routine should establish a ^C
; AST so that user can abort in-progress file transfers, and
; get Kermit out of server mode without having to send it a
; finish command.  I'll wait for Brian to send me his changes
; for graceful transfer abort before I implement this, though.

	.enabl	lsb

xinit::	call	getsys					; rsx or m+
	cmpb	r0	,#sy$mpl			; if m+ require defdev
	bne	10$					; not m+
	mov	sp	,fu$def				; m+, set SY: as def
10$:	cmpb	r0	,#sy$pro			; p/os?
	bne	20$					; no
	mov	sp	,proflg				; yes, flag it
	copyz	#xk$dev	,#ttname			; also set the device
	copyz	#xk$dev	,#ttdial			; to XK0:
	clr	remote					; and we are local
	clr	con8bit					; clear bit 7
	message	<Link default set to XK0: for P/OS>,cr	; tell the user
	calls	setspd	,<#ttname,xk$spd,#lun.co>	; try to set the speed
	tst	r0					; for XK0:
	bne	20$					; oops
	message	<Link speed for XK0: set to >		; tell them
	decout	xk$spd					; print the speed
	message						; cr/lf
20$:	alun$s	#lun.tt,#"TI,#tiunit			; Assign command term.
	qiow$s	#io.att,#lun.tt,#ef.tt,,#kbiost		; Attach it, also
	clr	tcdlu					; don't change tc.dlu
	call	setcc					; enable ^C asts
	return

	.save
	.psect	$xkdev	,ro,d,lcl,rel,con
xk$dev::.asciz	/XK0:/
	.even
	.dsabl	lsb
xk$spd::.word	9600.
	.restore


	global	<lun.tt, tiunit>

setcc::	qiow$s	#io.det,#lun.tt,#ef.tt,,#kbiost
	qiow$s	#io.ata,#lun.tt,#ef.tt,,#kbiost,,<,0,#ttast>
	return


ttast:	cmpb	(sp)	,#'c&37		; control C ?
	bne	100$			; no
	call	cctrap			; yes, call handler to check it
100$:	tst	(sp)+
	astx$s				; and exit from ast service

	global	<cctrap>




	.sbttl	ttyini - Save & switch line to data mode

;	T T Y I N I
;
;	ttyini( %loc device_name ,%val channel_number ,%val ccflag )
;
;
;	input:	@r5	.asciz string of device name (Ignored on native RSX)
;		2(r5)	channel number (LUN)
;		4(r5)	mode bits:		     (Ignored on native RSX)
;
;	output:	r0	error codes
;
;	On RSX, this routine does dynamic switching of terminal from
;	interactive mode(s) to data mode(s).  The ttysav(), ttyset()
;	and noecho() routines are no-ops ...
;
;	It is used only for packet communications.  The "doconn()" in
;	this module handles the setup and restoration of the terminal
;	lines for CONNECT modes.
;
;    ** Someday, the whole command terminal and communication line handling
;	architecture should be smoothed out and simplified, once Brian and
;	I get together and compare notes re: native RSX versus emulated RSX,
;	and what is required for compatibility without too much pain ...
;
;	Added SREX 22-Jun-84  11:15:46  Brian Nelson
;
;	Bob Denny
;

	.mcall	srex$s	,exit$s

ttyini::save	<r1>
	call	ttpars				; Get unit number
	bcs	10$
	alun$s	2(r5),r1,r0			; Assign LUN
	mov	$dsw,r0				; get the result
	bcs	10$				; oops
	clr	r0				; Make return success
	clr	savdon				; not saved tt settings yet
	cmp	2(r5),#lun.co			; Command terminal (SAFETY)
	beq	10$				; (yes, ignore this)
	qiow$s	#sf.gmc,2(r5),#ef.tt,,#kbiost,,<#savchr,#savlen>
	mov	kbiost,r0
	cmpb	r0,#IS.SUC			; OK?
	bne	10$				; (no)
	mov	sp	,savdon			; we have done the save
	mov	2(r5)	,inilun			; save this lun (BDN)
	srex$s	#abort				; in case server aborted (BDN)
	tstb	handch				; IBM crap (BDN 04-Aug-84)
	beq	5$				; no
	qiow$s	#sf.smc,2(r5),#ef.tt,,#kbiost,,<#ibmmod,#2> ;
5$:	qiow$s	#sf.smc,2(r5),#ef.tt,,#kbiost,,<#datchr,#datlen>
	mov	kbiost,r0
	cmpb	r0,#IS.SUC			; OK?
	bne	10$				; (no)
	clr	r0				; Yes - clear r0 = OK
10$:	tst	proflg				; if a pro/350, ignore errors
	beq	100$				; not a 350
	clr	r0				; a 350, forget about the errors
100$:	unsave	<r1>
	return


abort:	qiow$s	#sf.smc,inilun,#ef.tt,,#kbiost,,<#savchr,#savlen>
	jmp	exit


;	T T Y F I N
;
;	ttyfin( %loc device_name ,%val channel_number )
;
;
;	input:	@r5	.asciz string of device name (Ignored on native RSX)
;		2(r5)	channel number (LUN)
;
;	No need for ttyrst()
;

ttyfin::					; no more abort handling
	srex$s
	cmp	2(r5),#lun.co			; Command terminal?
	beq	10$				; (yes, skip it)
	tst	savdon				; ever save the crap?
	beq	10$				; no, don't reset it
	qiow$s	#sf.smc,2(r5),#ef.tt,,,,<#savchr,#savlen>
10$:	clr	r0
	return

;	STUB ROUTINES - Not needed here
;
ttrini::
ttrfin::
ttysav::
ttyset::
ttyrst::
noecho::
echo::
	clr	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

	.mcall	glun$s

gttnam::save	<r1,r2,r3>		; save temps please
	mov	@r5	,r3		; point to output buffer please
	sub	#20	,sp		; allocate a buffer for GLUN$S
	mov	sp	,r2		; point to it please
	glun$s	#lun.tt	,r2		; try it
	cmpb	@#$DSW	,#is.suc	; did it work ?
	bne	90$			; no, return the error code please
	movb	g.luna+0(r2),(r3)+	; get the device name next
	movb	g.luna+1(r2),(r3)+	; both bytes of it please
	clr	r1			; get the unit number next please
	bisb	g.lunu(r2),r1		; simple
	clr	r0			; now compute the ascii name
	div	#10	,r0		; simple (in octal please for RSX)
	mov	r1	,-(sp)		; save the low order unit number
	cmp	r0	,#7		; unit number > 77 octal ?
	blos	10$			; no
	mov	r0	,r1		; yes, do it again please
	clr	r0			; simple
	div	#10	,r0		; and so on
	add	#'0	,r0		; convert to ascii please
	movb	r0	,(r3)+		; get the high part copied
	mov	r1	,r0		; and now put the next digit back
10$:	mov	(sp)+	,r1		; get the low digit back now
	add	#'0	,r0		; convert to ascii
	add	#'0	,r1		; likewise
	movb	r0	,(r3)+		; move the unit number in now
	movb	r1	,(r3)+		; at last ....
	movb	#':	,(r3)+		; please insert a colon:
	clrb	@r3			; make it .asciz
	clr	r0			; no errors
	br	100$			; exit
90$:	moverr	@#$dsw	,r0		; get the directive error code
100$:	add	#20	,sp		; pop glun$s buffer
	unsave	<r3,r2,r1>
	return

	.sbttl	Vanilla read from command terminal


;	K B R E A D
;
; Read a line from the command terminal (80 characters max)
;
;	Input:	@r5	Address of 80 character buffer
;
;	Output:	r0 =	0 if OK, else error code
;		r1 = 	Number of characters if OK, else 0
;
;	Echoes a <LF> on completion to counter Dave Cutler's old
;	FORTRAN record processing view of the world.

kbread::
	qiow$s	#io.rvb,#5,#ef.tt,,#kbiost,,<@r5,#80.>
	clr	r0			; assume no errors
	mov	kbiost+2,r1		; return bytecount in r1
	cmpb	kbiost	,#is.suc	; successful read ?
	beq	100$			; yes
	clr	r1			; no data please
	moverr	kbiost	,r0		; return the error
100$:	print	#200$
	return

200$:	.byte	lf,0





	.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) (do this for RSX??)
;
;	output:	r0	error
;		r1	character read
;
;	This version uses "normal" reading, as KERMIT sends its packets
;	ending in its "EOL" character, which we need to be a <CR>.  This
;	makes reading packets a piece'o cake.  We simply buffer lines
;	here and scan off characters as needed.  Terminal modes have
;	been set for reasonably low driver overhead.
;
;	No longer used by CONNECT
;
binrea::tstb	handch			; doing ibm style xon handshaking  BDN
	beq	5$			; then we must do single char qios BDN
	call	xbinrea			; do that and exit		   BDN
	return				; bye				   BDN

5$:	save	<r2>
	mov	@r5	,r2		; lun to use today
	asl	r2			; fix it for word indexing
10$:	tst	icrem(r2)		; Anything remaining in current line?
	bne	20$			; (yes)
	call	rdlin			; No, maybe issue a read
	bcs	30$			; (read error)
	br	10$			; Try again

20$:	clr	r1			; Move next char unsigned ...
	bisb	@linptr,r1		; ... into r1
	inc	linptr			; Advance pointer
	dec	icrem(r2)		; Decrement # characters remaining
	clr	r0			; Success
30$:	unsave	<r2>
	return				; Return


;
; RDLIN - Local read routine
;
; Inputs:
;	@r5	LUN to read on
;	2(r5)	timeout, seconds
;
; Outputs:
;	C-bit clear	Successful read (something read before timeout)
;			icrem = number of characters in this line
;			linptr -> 1st character in the line
;
;	C-bit set	Failed
;			R0 = error code
;			icrem = 0

rdlin:
	clr	icrem(r2)		; Reset buffer counter
	mov	#linbuf,linptr		; Reset scan pointer
10$:	clr	r0			; Assume no timeout
	mov	2(r5),r1		; R1 = timeout in seconds
	ble	20$			; (no timeout)
	add	#9.,r1			; Round up to nearest 10 second clicks
	div	#10.,r0			; Convert to 10 sec. clicks

20$:	tst	proflg			; pro/350?
	bne	25$			; yes
	tst	chario			; force pro/350 style reads today?
	bne	25$			; yes
	qiow$s	#<io.rlb!tf.tmo>,@r5,#ef.tt,,#kbiost,,<#linbuf,#maxlin,r0>
	br	30$
25$:	clr	-(sp)			; get the typehead buffer size
	mov	sp	,r1		; point to the parameter area
	movb	#tc.tbf	,@r1		; we want amount in the buffer
	qiow$s	#sf.gmc,@r5,#ef.tt,,,,<r1,#2>
	movb	1(r1)	,r1		; get the typeahead size
	bne	26$			; we have something to get there
	inc	r1			; nothing, wait for one character
26$:	qiow$s	#<io.ral!tf.tmo!tf.rne>,@r5,#ef.tt,,#kbiost,,<#linbuf,r1,r0>
	tst	(sp)+			; pop sf.gmc buffer please
30$:	cmpb	kbiost	,#is.tmo	; timed out on the read ?
	beq	40$			; yes
	movb	kbiost,r0		; Some kind of success?
	bmi	90$			; no
	mov	kbiost+2,icrem(r2)	; Yes, set up number of characters
	mov	#linbuf,r1		; R1 --> line buffer
	add	icrem(r2),r1		; R1 --> first free byte at end of line
	movb	kbiost+1,(r1)		; Get possible terminator character
	beq	35$			; (none)
	inc	icrem(r2)		; Adjust for terminator
35$:	clrb	(r1)			; Null terminate just for grins
	clr	r0			; Clear r0 and C-bit
	return				; Finished

40$:	movb	#er.tmo	,r0		; return timeout error code
	clr	icrem(r2)		; just to be safe
	sec				; say it failed
	return

90$:	clr	icrem(r2)		; to be safe
	sec				; Error
	return				; bye




;	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::
	qiow$s	#io.wal,4(r5),#ef.tt,,#kbiost,,<@r5,2(r5)>
	clr	r0
	return




	.sbttl	real binary i/o for doing ^X and ^Z things

;	X B I N R E A
;
;	binread( %val channel_number, %val timeout )
;
;
;	input:	@r5	channel number
;		2(r5)	timeout	(if -1, then no wait) (do this for RSX??)
;
;	output:	r0	error
;		r1	character read
;


xbinre::save	<r2,r3>			; save a register for a friend
	clr	-(sp)			; allocate a buffer please
	mov	sp	,r2		; and point to it now
	clr	-(sp)			; allocate a buffer for SF.GMC
	mov	sp	,r3		; and point to it please
	cmp	2(r5)	,#-1		; get without any wait today ?
	bne	20$			; no, check for timeouts now

	movb	#tc.tbf	,@r3		; create a .byte tc.tbf,0
	qiow$s	#sf.gmc,@r5,#ef.tt,#50,#kbiost,,<r3,#2>
	cmpb	kbiost	,#is.suc	; did the read terminal thing work?
	bne	90$			; no
	tstb	1(r3)			; any data in the typeahead buffer?
	bne	20$			; yes
	movb	#nodata	,r0		; fake a psuedo no data error
	br	100$			; and exit
	
20$:	clr	r0			; get timeout in seconds into
	mov	2(r5)	,r1		; ten second chunks (better than
	ble	30$			; -1 timeout or no timeout
	div	#10.	,r0		; nothing, i suppose)
	tst	r0			; anything left ? if not, make it
	bne	30$			; 10 seconds please
	inc	r0			; 1 --> 10 seconds
30$:	.iif ne, r$rsts,emt 22		; if testing under RSTS disable echo

	qiow$s	#io.ral!tf.rne!tf.tmo,@r5,#ef.tt,#50,#kbiost,,<r2,#1,r0>

	.iif ne, r$rsts,emt 20		; if testing under RSTS enable echo
	clr	r1			; get the character now please
	bisb	@r2	,r1		; copy it with sign extension!
	clr	r0			; assume no errors
	cmpb	#is.suc	,kbiost		; did it work ?
	beq	100$			; yes, exit
	cmpb	#is.tmo	,kbiost		; timeout
	bne	90$			; no
	movb	#er.tmo	,r0		; yes
	br	100$			; bye

90$:	moverr	kbiost	,r0		; no, return the error
100$:	cmp	(sp)+	,(sp)+		; pop the 2 buffers please
	unsave	<r3,r2>			; from DIRECTIVE errors
	return				; bye


chkabo::calls	xbinrea	,<#lun.tt,#-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$:	clr	r0			; it failed
	return






	.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
	movb	kbiost	,-(sp)		; save old io status
	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$:	qiow$s	#io.wvb,#5,#ef.tt,,#kbiost,,<@r5,r0>
	cmpb	kbiost	,#is.suc	; did it work ?
	bne	90$			; no, exit with carry set
	clc				; yes, it worked
	br	100$			; exit
90$:	sec				; write failed, set error flag and exit
100$:	movb	(sp)+	,kbiost
	unsave	<r1,r0>			; pop registers that we used
	return				; and exit


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	exit kermit and logout

	.mcall	exit$s	,rpoi$s

bye:	.rad50	/...BYE/

logout::
	tst	assdon			; ever slave the line?
	beq	10$			; no
	qiow$s	#sf.smc,#lun.as,#ef.tt,,#kbiost,,<#savass,#2> ;
10$:	rpoi$s	#bye
	exit$s

exit::
	tst	assdon			; ever slave the line?
	beq	10$			; no
	qiow$s	#sf.smc,#lun.as,#ef.tt,,#kbiost,,<#savass,#2> ;
10$:	exit$s


quochk::
	clr	r0			; try to see if the logout will work
	return


dskuse::
	mov	@r5	,r0
	copyz	#120$	,r0
	return

120$:	.asciz	/Can't do space enquiry for RSX/
	.even





	.sbttl	cantyp	cancel typeahead


;	C A N T Y P
;
;	cantyp(%val channel_number)
;
;	input:	@r5	device name
;		2(r5)	lun
;
;
;	 Cantyp tries to dump all pending input on a given terminal
;	line.


cantyp::
	save	<r0,r1>			; use r0 to point into xrb
	clr	-(sp)			; allocate buffer for SF.SMC
	mov	sp	,r1		; point to it please
	movb	#tc.tbf	,@r1		; cancel all typeahead please
	mov	2(r5)	,r0		; get the channel number please
	asl	r0			; purge internally buffer chars
	clr	icrem(r0)		; simple
	asr	r0			; restore lun
	bne	10$			; ok
	mov	#5	,r0
10$:	qiow$s	#sf.smc,r0,#ef.tt,,#kbiost,,<r1,#2>
100$:	tst	(sp)+
	unsave	<r1,r0>			; all done
	return				; bye


;	T T X O N
;
;	input:	@r5	device name
;		2(r5)	lun
;	output:	r0	error code (really, it will be zero)
;
;
;	TTXON cancels xoff on a line


ttxon::	save	<r1,r2>			; use r0 to point into xrb
	clr	-(sp)			; allocate buffer for SF.SMC
	mov	sp	,r1		; point to it please
	movb	#tc.cts	,@r1		; cancel all typeahead please
	clrb	1(r1)			; zero means to cancel xoff
	mov	2(r5)	,r2		; get the channel number please
	bne	10$			; ok
	mov	#5	,r2
10$:	qiow$s	#sf.smc,r2,#ef.tmp,,,,<r1,#2>
	qiow$s	#io.wal,r2,#ef.tmp,,,,<#200$,#1>
100$:	tst	(sp)+
	unsave	<r2,r1>			; all done
	clr	r0			; no errors
	return				; bye

200$:	.byte	'Q&37,0




	.sbttl	get uic


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

	.mcall	gtsk$s


getuic::
	sub	#40	,sp		; allocate gtsk buffer
	mov	sp	,r0		; point to the buffer please
	gtsk$s	r0			; simple
	mov	g.tspc(r0),r0		; return the uic
	add	#40	,sp		; pop the buffer and exit
	return



drpprv::
	return


getprv::
	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

	.mcall	mrkt$s	,wtse$s

suspen::
	tst	@r5			; nonzero seconds call ?
	bne	10$			; yes
	mrkt$s	#ef.tt,2(r5),#1		; no, sleep passed # of ticks
	br	20$			; and now wait for the timeout
10$:	mrkt$s	#ef.tt,@r5,#2		; sleep integral # of seconds
20$:	wtse$s	#ef.tt
	return


	.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 are doing it in software as of
	.ift				; 28-Mar-84  09:11:18  (BDN)

ttypar::
	call	ttpars			; get the terminal unit number
	bcs	100$			; oops
100$:	movb	@#$DSW	,r0		; get any errors
	return

	.endc

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::save	<r1>
	call	ttpars			; the usual, parse the device name
	bcs	100$			; oops
	alun$s	#lun.co,r1,r0		; assign the terminal please
	qiow$s	#io.att,#lun.co,#ef.tt,#50,#kbiost
	qiow$s	#io.hng,#lun.co,#ef.tt,#50,#kbiost
	moverr	kbiost	,r0
	qiow$s	#io.det,#lun.co,#ef.tt,#50,#kbiost
	br	100$			; bye

90$:	moverr	@#$DSW	,r0		; return TTPARS error code
100$:	unsave	<r1>
	return






;	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
100$:	movb	@#$DSW	,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

splst:	.word	0	,50.	,75.	,110.	,134.	,150.	,200.
	.word	300.	,600.	,1200.	,1800.	,2000.	,2400.	,3600.
	.word	4800.	,7200.	,9600.	,19200. ,38400. ,-1

setlst:	.word	s.0	,s.50	,s.75	,s.110	,s.134	,s.150	,s.200
	.word	s.300	,s.600	,s.1200	,s.1800	,s.2000	,s.2400	,s.3600
	.word	s.4800.	,s.7200	,s.9600	,s.19.2 ,s.38.4 ,-1


	.psect	$code

ttspee::
	save	<r1,r2>
	clr	-(sp)			; allocate buffer for SF.GMC
	clr	-(sp)
	call	ttpars			; parse the terminal device name
	bcs	90$			; error in device name ?
	alun$s	#lun.co,r1,r0		; assign the terminal please
	mov	sp	,r2
	movb	#tc.xsp	,@r2
	movb	#tc.rsp	,2(r2)
	qiow$s	#sf.gmc,#lun.co,#ef.tt,,#kbiost,,<r2,#4>
	movb	kbiost	,-(sp)
	movb	(sp)+	,kbiost
	clr	r0			; assume zero speed
	cmpb	kbiost	,#is.suc	; did the read speed thing work ?
	bne	90$			; not really
	movb	1(r2)	,r2		; get the speed setting please
	clr	r1			; find the index into speed table
10$:	cmp	setlst(r1),#-1		; reached the end of table yet ?
	beq	90$			; yes, exit
	cmpb	setlst(r1),r2		; a match yet
	beq	20$			; yes
	tst	(r1)+			; no, index := index + 2
	br	10$			; next please
20$:	mov	splst(r1),r0		; return decimal of the speed
	br	100$			; bye

90$:
100$:	cmp	(sp)+	,(sp)+
	unsave	<r2,r1>
	return






	.sbttl	set the speed of a terminal line
	.mcall	astx$s	,cmkt$s	,mrkt$s	,qiow$s



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

setspd::save	<r1,r2,r3,r4>
	mov	2(r5)	,r2		; the speed
	mov	4(r5)	,r4		; save the lun
	call	ttpars			; parse the terminal name
	bcs	90$			; oops
	clr	r3			; match the passed speed to the
10$:	cmp	splst(r3),#-1		; speed desired to get the index
	beq	80$			; end of the table, invalid speed
	cmp	splst(r3),r2		; a match yet ?
	beq	20$			; yes
	tst	(r3)+			; no, look again please
	br	10$			; next

20$:	clr	-(sp)			; we have the index into speedtable
	clr	-(sp)			; allocate a SF.SMC buffer now
	mov	sp	,r2		; point to a buffer for SF.SMC
	movb	#tc.xsp	,(r2)+		; stuff xmitter change code in
	movb	setlst(r3),(r2)+	; and the desired speed now
	movb	#tc.rsp	,(r2)+		; stuff receiver change code in
	movb	setlst(r3),(r2)+	; and the desired speed now
	mov	sp	,r2		; point back to the buffer now
	alun$s	r4,r1,r0		; assign the terminal please
;	qiow$s	#io.att,r4,#ef.tt,#50
	mrkt$s	#ef.tmo,#2,#2,#spdtmo	; in case we can't get the device
	qiow$s	#sf.smc,r4,#ef.tt,#50,#kbiost,,<r2,#4>
	cmkt$s	#ef.tmo,#spdtmo		; we got it ok
;	qiow$s	#io.det,r4,#ef.tt,#50
	cmp	(sp)+	,(sp)+		; pop the buffer we used
	clr	r0			; assume success
	cmpb	kbiost	,#is.suc	; did it work ?
	beq	100$			; yes, exit without error
	cmpb	kbiost	,#ie.pri	; protection violatian here ?
	bne	70$			; no
	call	spwnbd			; yes, try to spawn MCR SET /SPEED=
	br	100$			; and exit
70$:	moverr	kbiost	,r0		; no, return the error and exit
	br	100$			; and exit with the error code

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

90$:	moverr	@#$dsw	,r0		; error from parse
	br	100$

100$:	unsave	<r4,r3,r2,r1>		; bye
	return

spdtmo:	tst	(sp)+			; remove the event flag number
	qiow$s	#io.kil,r4,#ef.tt,#50,#kbiost
	movb	#ie.abo	,kbiost		; insure that's the error code
	astx$s				; exit from this timeout ast


	.sbttl	SPWNBD	set the line speed via a spawn if SF.SMC fails

;	input:
;		@r5	address of terminal name, asciz
;		2(r5)	speed to do it to
;	output:
;		r0	error code from spawn



spwnbd:	sub	#70	,sp		; allocate some buffers please
	mov	sp	,r1		; pointer to the MCR command line
	sub	#10	,sp		; pointer to decimal conversion buffer
	mov	sp	,r2		; simple
	copyz	#200$	,r1		; copy over MCR SET/SPEED=
	strlen	r1			; get over to the end of it now
	add	r0	,r1		; simple
	copyz	@r5	,r1		; copy the device name over now
	strlen	r1			; point to the end of it please
	add	r0	,r1		; simple
	deccvt	2(r5)	,r2		; convert speed to decimal now
	calls	cvt$$	,<r2,#6,#377>	; remove any spaces please
	add	r0	,r2		; point to the end of the line
	clrb	@r2			; make it .asciz please
	mov	sp	,r2		; point back to the start of buffer
	copyz	r2	,r1		; stuff the speed data into the mcr
	add	r0	,r1		; command buffer
	movb	#':	,(r1)+		; simple
	copyz	r2	,r1		; again
	add	r0	,r1		; point to the end of it
	clrb	@r1			; insure .asciz please
	add	#10	,sp		; pop the conversion buffer
	mov	sp	,r1		; point back to the mcre command
	calls	runmcr	,<#1,r1>	; buffer and try the spawn
	add	#70	,sp		; pop the mcr command buffer
	return				; and exit

200$:	.asciz	#SET /SPEED=#		; part of the mcr command line
	.even





	.sbttl	spawn a set slave command


setsla::save	<r1>			; save temps we may want
	sub	#60	,sp		; allocate a local buffer
	mov	sp	,r1		; point to it
	copyz	#200$,r1		; copy the SET/SLAVE=
	strlen	r1			; point to the end by getting
	add	r1	,r0		; the length and adding it in
	copyz	@r5,r0,#30		; add the ttname in
	calls	runmcr	,<#1,r1>	; simple to do
	add	#60	,sp		; restore the stack
	unsave	<r1>			; bye
	clr	r0			; no error return
	return

200$:	.asciz	#SET /SLAVE=#
	.even






	.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
;		r1	device name

ttpars::				; NEEDS TO BE GLOBAL(RBD)
	save	<r2,r3>			; parse a device name
	clr	r1			; no device name yet
	clrb	@#$DSW			; set no error as of yet
	mov	#377	,r0		; presume no device name
	mov	@r5	,r3		; get the string address
	tstb	@r3			; anything there ?
	beq	90$			; no, error

	cmpb	@r3	,#'X&137	; i may try this on 350 some day??
	beq	10$			; ok
	cmpb	@r3	,#'A&137	; must be of the format ?Tnnn:
	blo	90$			; ok so far
	cmpb	@r3	,#'Z&137	; must be of the format ?Tnnn:
	blos	10$			; no

	cmpb	@r3	,#'A!40		; must be of the format ?Tnnn:
	blo	90$			; ok so far
	cmpb	@r3	,#'Z!40		; must be of the format ?Tnnn:
	bhi	90$			; no
10$:	bisb	(r3)+	,r1		; ok, save the first character
	swab	r1			; and make a place for the next
	cmpb	@r3	,#'I&137	; passed 'TI:' ?
	beq	105$			; return unit of 377 then please
	cmpb	@r3	,#'I!40		; passed 'TI:' ?
	beq	105$			; return unit of 377 then please
	
	cmpb	@r3	,#'K&137	; XK: (?)
	beq	20$			; yep
	cmpb	@r3	,#'T&137	; must be of the format TTnnn:
	beq	20$			; ok so far
	cmpb	@r3	,#'T!40		; must be of the format TTnnn:
	bne	90$			; no
20$:	bisb	(r3)+	,r1
	swab	r1			; have the device name in r1 now
	clr	r0			; could use .parse but this is

30$:	movb	(r3)+	,r2		; get the next digit in the string
	beq	90$			; hit end of string
	cmpb	r2	,#':		; end of the device name ?
	beq	105$			; yes, exit please
	cmpb	r2	,#'0		; in the range '0'..'7' ?
	blo	90$			; oops
	cmpb	r2	,#'7		; keep checking please
	bhi	90$			; bad device name
	asl	r0			; r0 = r0 * 8
	asl	r0			; ditto
	asl	r0			; and so forth
	sub	#'0	,r2		; convert to binary
	add	r2	,r0		; and sum the digit in please
	br	30$			; next

90$:	movb	#ie.idu	,@#$dsw		; fake a bad device name and exit
	sec				; ok
	br	110$			; bye
105$:	clr	@#$dsw			; no errors
	clc				; success
110$:	unsave	<r3,r2>			; bye
	return



	.sbttl	assign device


;	Fake a device assignment by attaching to a dummy lun. Also
;	check for someone else having it via issueing a mark time.
;	Thanks to Bob Denny for that one.
;

	.mcall	alun$s	,astx$s	,cmkt$s	,mrkt$s	,qiow$s	,wtse$s


assdev::tst	proflg
	beq	1$
	clr	r0
	return
1$:	save	<r1,r2,r3>
	qiow$s	#io.det,#lun.as,#ef.tt	; Detach possible old device
	call	ttpars
	bcc	5$
	jmp	100$
5$:	mov	r0	,r3		; save the unit number please
	clr	r2			; flag if we timed out
	mrkt$s	#ef.tmo,#2,#2,#asstmo	; give 2 seconds to do this
	cmpb	r3	,#377		; local terminal ?
	bne	10$			; no
	alun$s	#lun.as,#"TI,#0		; assign the terminal please
	br	20$
10$:	alun$s	#lun.as,r1,r3		; assign the terminal please
20$:	qiow$s	#io.att,#lun.as,#ef.tt,,#kbiost
	mov	r2	,r0		; did we ever time out
	bne	110$			; yes, return busy device
	cmkt$s	#ef.tmo,#asstmo		; and cancel the mark time
	sub	#20	,sp		; allocate a buffer for glun
	mov	sp	,r2		; and a pointer to it
	glun$s	#lun.tt	,r2		; get name of the console terminal
	cmpb	r3	,#377		; no unit?
	beq	40$			; yes, must be TI:
	cmp	g.luna(r2),r1		; device name of console same as dev?
	bne	30$			; no
	cmpb	g.lunu(r2),r3		; unit number the same ?
	beq	40$			; yes
30$:	qiow$s	#sf.gmc,#lun.as,#ef.tt,,,,<#savass,#2> ;
	qiow$s	#sf.smc,#lun.as,#ef.tt,,,,<#setass,#2> ;
	mov	sp	,assdon		; flag we did the set /slave=ttnn:
40$:	add	#20	,sp		; pop glun buffer
	clr	r0
	cmpb	kbiost	,#is.suc	; did it work
	beq	110$			; yes, return error zero
	cmpb	kbiost	,#ie.daa	; ignore already attached errors
	beq	110$			; simple to do
	moverr	kbiost	,r0		; no, get the error code
	br	110$			; and exit
100$:	moverr	@#$DSW	,r0
110$:	unsave	<r3,r2,r1>
	return


asstmo:	tst	(sp)+			; remove the event flag number
	qiow$s	#io.kil,#lun.as,#ef.tt,#50,#kbiost
	moverr	#ie.daa	,r2		; get the error code and exit
	astx$s				; exit from this timeout ast


	.sbttl	namcvt	remove everything but the filename.type

	.if ne	,0			; removeed 21-Mar-84  11:02:40  BDN
	.ift				; new version in K11CVT.MAC


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


	.psect	rsxdat	,rw,d,lcl,rel,con

tmpbuf:	.blkb	100.			; Scratch string buffer		;RBD01+

	.psect	$code

namcvt::
	save	<r1,r2,r3,r4>
	mov	#tmpbuf,r4		; r4 -> scratch buffer
	copyz	(r5),r4,#100.		; Make a scratch copy of raw string
	strlen	r4			; R0 = length of raw string
	add	r4,r0			; R0 -> byte after last in string
	;
	; Locate '.', tack one on if not there.  Strip filetype.
	;
	mov	r0,r3			; R3 -> byte after last in string
	scan	#'.,r4			; R0 = index of '.' or 0
	tst	r0			; Is there a '.'
	bne	10$			; (yes, strip file type)
	movb	#'.,(r3)+		; No '.', tack one on
	clrb	(r3)			; Terminate string.
	br	40$			; Skip file type stripping

10$:	add	r4,r0			; r0 -> char after the '.'
	mov	#3,r1			; Counter
20$:	call	isalnum			; Scan forward for up to 3 alphamerics
	bcs	30$			; (non-alphameric)
	inc	r0			; Next
	sob	r1,20$			; Loop for up to 3
30$:	clrb	(r0)			; Terminate string here
	;
	; Now back up from '.' for up to 9 alphamerics or to start of
	; string.
	;
40$:	scan	#'.,r4			; R0 = index of '.' (should be there!)
	add	r4,r0			; R0 -> char after '.'
	sub	#2,r0			; R0 -> char before '.'
	cmp	r0,r4			; Before start?
	blo	60$			; (yes)
	mov	#9.,r1			; Counter
50$:	call	isalnum			; Scan backward for up to 9 alphamerics
	bcs	60$			; (non-alphameric)
	dec	r0			; Next
	cmp	r0,r4			; Backed up bast start?
	blo	60$			; (yes)
	sob	r1,50$			; Loop for up to 9
60$:	inc	r0			; R0 -> 1st character of file name
	;
	; Copy the string from R0 to the null
	;
	copyz	r0,2(r5)		; Return the stripped specification

	unsave	<r4,r3,r2,r1>		; THAT'S IT!! (ain't that easy?)
	return

;
; Local routines for namcvt()
;

; ISALNUM - Test character for alphamericity
;
; Input:	r0 -> character to test
; Output:	C-bit: Clear = alphameric else C-set
;
	.enabl	lc			; For safety's sake
isalnum:
	mov	r0,-(sp)		; Save r0
	movb	(r0),r0			; r0 = character
	cmp	r0,#'a			; Fold character to upper case
	blo	10$
	bic	#177440,r0		; Make it word-wise upper case
10$:	cmp	r0,#'Z			; Past "Z"?
	bhi	100$			; Yes, not alphameric
	cmp	r0,#'0			; Below "0"?
	blo	100$			; Yes, not alphameric
	cmp	r0,#'A			; Above "A"?
	bhis	90$			; Yes, alpha
	cmp	r0,#'9			; Above "9"?
	bhi	100$			; Yes, not alphameric

90$:	clc				; Indicate alphameric-ness
	br	110$

100$:	sec				; Non-alphameric

110$:	mov	(sp)+,r0		; Restore pointer
	return

	.endc				; for new version




	.sbttl	get date and time

	.enabl	lc
	.mcall	gtim$s


ascdat::save
	mov	@r5	,r0		; r0 := caller result addr
	sub	#16.	,sp		; make room for result
	mov	sp	,r1		; result addr for gtim$
	gtim$s	r1			; get time and date
	mov	g.tida(r1),r2		; r2 := day
	jsr	pc	,cnvert		; convert and store day
	movb	#'-	,(r0)+		; insert dash
	mov	g.timo(r1),r2		; r2 := month
	asl	r2
	add	g.timo(r1),r2		; r2 := 3*month
	add	#mnthtab-3,r2		; r2 := mnthtab[3*month]@
	movb	(r2)+	,(r0)+
	movb	(r2)+	,(r0)+		; store month name
	movb	(r2)+	,(r0)+
	movb	#'-	,(r0)+		; insert dash
	mov	@r1	,r2		; r2 := year
	jsr	pc	,cnvert		; convert and store year
	movb	#40 	,(r0)+		; final space
	clrb	@r0
	add	#16.	,sp
	unsave
	return

asctim::save
	mov	@r5	,r0		; the desitination
	sub	#16.	,sp		; make room for result
	mov	sp	,r1		; result addr for gtim$
	gtim$s	r1			; get time and date
	mov	#3,r3			; loop count := 3
	add	#g.tihr,r1		; start with hours
1$:	mov	(r1)+,r2		; begin loop
	jsr	pc,cnvert		;   convert to ascii and store
	dec	r3			;   if done
	beq	2$			;     then exit loop
	movb	#':,(r0)+		;     else insert colon
	br	1$			; end loop
2$:	clrb	@r0
	add	#16.	,sp
	unsave
	return

; cnvert: internal procedure to convert
; integer in r2 to ascii.
cnvert:	add	#366,r2		;begin loop
	tstb	r2
	bpl	cnvert		;end loop
	add	#"00-366,r2	;convert to ascii
	swab	r2		;reorder bytes
	movb	r2,(r0)+	;store digit
	swab	r2
	movb	r2,(r0)+	;store digit
	rts	pc

mnthtab:.ascii	/JanFebMarAprMayJunJulAugSepOctNovDec/
	.even




	.sbttl	systat	get list of users logged in

sercmd::
systat::
	moverr	#-1	,r0
	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
;
;	Unfortunately, RMS does not seem to return all the nice things
;	like dates and sizes and protection.  While I have written the
;	same  using FCS (CSI and .PARSE and qio's) for MINITAB and TED
;	I would  rather not have  to do it that way since we are using
;	RMS for everything else.

dodir::
	save	<r1,r2,r3,r4>		; save these just for kicks
	sub	#140	,sp		; allocate a buffer for filenames
	mov	sp	,r2		; and a pointer to the buffer
	clr	-(sp)			; flag to get lookup to do a $parse
	mov	sp	,r4		; and point to it please
	mov	@r5	,r1		; get the filespec address
	tstb	@r1			; anything passed at all ?
	bne	10$			; yes
	mov	#300$	,r1		; no, use *.*;*
10$:	call	250$			; print a header out please
	clr	r3			; filecount := 0
20$:	calls	lookup	,<#3,r1,r4,r2>	; do the $search via RMS11 now
	tst	r0			; did it work at all ?
	bne	90$			; no, it failed
	call	200$			; it worked, decide where to put it
	inc	r3			; filecount := succ( filecount )
	br	20$			; next please

90$:	cmp	r0	,#ER$NMF	; no more files error ?
	bne	100$			; no, just exit then
	tst	r3			; yes, did we ever find anything ?
	beq	95$			; no, change error to ER$FNF
	clr	r0			; found at least one and we got
	br	100$			; no more files error from RMS
95$:	mov	#ER$FNF	,r0		; no files found
100$:	tst	(sp)+
	add	#140	,sp		; pop resultant filename buffer
	unsave	<r4,r3,r2,r1>		; pop registers we used and exit
	return				; bye


200$:	tst	2(r5)			; i/o to TI: or to a disk file ?
	bne	210$			; disk
	print	r2			; terminal
	print	#320$			; cr/lf
	br	220$			; exit
210$:	strlen	r2			; to disk, get the string length
	calls	putrec	,<r2,r0,2(r5)>	; simple
220$:	return


250$:	copyz	#310$	,r2		; yes, copy a header over
	strlen	r2			; get the current length
	add	r2	,r0		; point to the null in it
	calls	fparse	,<r1,r0>	; build the filename string
	tst	r0			; did that work ok ?
	bne	260$			; no, just exit then
	strlen	r2			; get the current length again
	add	r2	,r0		; and point to the end again
	movb	#cr	,(r0)+		; and stuff a cr/lf/null
	movb	#lf	,(r0)+		; simple
	clrb	@r0			; ok
	call	200$			; print it and exit
260$:	return


300$:	.asciz	/*.*;*/			; everything please
310$:	.asciz	/Directory of /		; a simple header
320$:	.byte	cr,lf,0			; the lonely crlf
	.even





	.sbttl	fix up error codes


$mover:	tstb	2(sp)
	bmi	10$
	clr	2(sp)
	return
10$:	neg	2(sp)
	return


	.sbttl	rsxsys	sys command for RSX11M/M+


;	21-Aug-83  16:12:37	Brian Nelson
;	12-Jan-84  09:54:02	Created from MINITAB v82 source
;	07-Mar-84  21:58:10	Bob Denny - Stop instead of wait, nicer.

	.enabl	gbl
	.mcall	spwn$s	,stse$s	,r50$


runjob::
	mov	#cli...	,r0
	call	rsxsys
	return

runmcr::
	mov	#mcr...	,r0
	call	rsxsys
	return

rsxsys::
	save	<r1,r2,r3,r4>
	qiow$s	#io.det,#lun.tt,#ef.tt,#50,#kbiost
	mov	r0	,r4		; save the CLI we want to use
	sub	#12*2	,sp		; need eight word exit block BDN
	mov	sp	,r2		; Get address of exit block  BDN
	clr	@r2			; to be safe ?
	mov	2(r5)	,r1		; the command buffer address
	mov	r1	,r3		; save it
	strlen	r1			; get the command string length
	add	r0	,r3		; point to the end
	cmpb	-(r3)	,#cr		; trailing carriage return ?
	bne	5$			; no
	dec	r0			; yes, fix the length up
5$:	mov	r0	,r3		; save the length
	clr	r0			; assume no error please
	spwn$s	r4,,,,,#6,,r2,r1,r3	; do it
	bcc	10$			; Ignore error for now
	moverr	@#$DSW	,r0		; get the error code please
	qiow$s	#io.att,#lun.tt,#ef.tt,#50,#kbiost
	print	#100$
	br	20$
10$:	stse$s	#6			; Stop for task to exit
20$:	add	#12*2	,sp		; pop exit status block
	qiow$s	#io.att,#lun.tt,#ef.tt,#50,#kbiost
	unsave	<r4,r3,r2,r1>		; pop registers and exit
	return



100$:	.asciz	<15><12>/Spawn failure for SYS command/<15><12>
	.even

mcr...:	r50$	MCR...
cli...:	r50$	CLI...


	.sbttl	spool to printer


	.mcall	print$

;	can we do this with RMS i/o ?????

qspool::movb	#1	,r0
	return
;	calls	open	,<@r5,2(r5)>
;	calls	rsxspl	,<2(r5)>
;100$:	return
;
;
;rsxspl::mov	r0	,-(sp)		; save temps
;	mov	r1	,-(sp)		; also this one
;	mov	@r5	,r1		; unit number file is open on
;	asl	r1			; get into word offset
;	mov	fdblst(r1),r1		; fdb for that file
;	clr	errsav
;	print$	r1,,,#"LP,#1		; spool file to lp0 now
;	bcc	100$
;	moverr	f.err(r1)
;100$:	mov	(sp)+	,r1		; pop temps and exit
;	mov	(sp)+	,r0		;
;	return				; bye





	.sbttl	detach for the server

;	Much simpler for RSX than for RSTS

detach::qiow$s	#io.det,#5,#ef.tt,,#kbiost
	clr	r0
	return



	.sbttl	error message text

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	direrr	,<#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	<direrr	,rmserp	,rmserr>


	.sbttl	SENBRK	send a break, lun assigned, passed in 2(r5)



senbrk::save	<r1,r2>			; save scratch registers please
	clr	-(sp)			; clear a sf.gmc buffer out
	clr	-(sp)			; ditto
	mov	sp	,r2		; and a pointer to it please
	movb	#tc.xsp	,@r2		; we want the current speed settings
	movb	#tc.rsp	,2(r2)		; ditto
	qiow$s	#sf.gmc,2(r5),#ef.tmp,#50,,,<r2,#4>
	movb	1(r2)	,r1		; save the old speed setting please
	mov	sp	,r2		; reset the buffer address please
	movb	#tc.xsp	,(r2)+		; stuff xmitter change code in
	movb	#s.50	,(r2)+		; and the desired speed now
	movb	#tc.rsp	,(r2)+		; stuff receiver change code in
	movb	#s.50	,(r2)+		; and the desired speed now
	mov	sp	,r2		; point back to the buffer now
	qiow$s	#sf.smc,2(r5),#ef.tmp,#50,,,<r2,#4>
	qiow$s	#io.wal,2(r5),#ef.tmp,#50,,,<#200$,#2>
	mov	sp	,r2		; reset the buffer address please
	movb	#tc.xsp	,(r2)+		; stuff xmitter change code in
	movb	r1	,(r2)+		; and the old speed now
	movb	#tc.rsp	,(r2)+		; stuff receiver change code in
	movb	r1	,(r2)+		; and the old speed now
	mov	sp	,r2		; point back to the buffer now
	qiow$s	#sf.smc,2(r5),#ef.tmp,#50,,,<r2,#4>
	cmp	(sp)+	,(sp)+		; pop local buffer and exit
	clr	r0			; no errors are ever returned
	unsave	<r2,r1>			; pop local registers and exit
	return				; bye


200$:	.byte	0,0

	.end