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

	.ident	/4.1.02/

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



;	define macros and things we want for KERMIT-11


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


	r$rsts	=	0		; <> for debugging under RSTS


;	Copyright (C) 1983   Change Software, Inc.
;	
;	
;	This software is furnished under a license and may
;	be  used  and  copied  only in accordance with the
;	terms of such license and with  the  inclusion  of
;	the  above copyright notice.  This software or any
;	other copies thereof may not be provided or other-
;	wise made available to any other person.  No title
;	to and ownership of the software is hereby  trans-
;	ferred.
;	
;	The information in this  software  is  subject  to
;	change  without notice and should not be construed
;	as a commitment by the author.
;
;
;	binread( %val channel_number, %val timeout )
;	binwrit( %loc buffer, %val buffer_length, %val channel_number )
;	cantyp ( %val channel_number )
;	drpprv ( )
;	echo   ( )
;	exit   ( )
;	getprv ( )
;	getuic ( )
;	gttnam ( %loc buffer )
;	noecho ( )
;	read   ( %loc buffer, %val buffer_length, %val channel_number,
;	         %val block_number )
;	setdlm ( %val channel_number )
;	suspen ( %val sleep_time )
;	ttyini ( %loc device_name ,%val channel_number , %val ccflag )
;	write  ( %loc buffer, %val buffer_length, %val channel_number,
;	        %val block_number )

	.sbttl	edits


;	20-Jan-84  09:50:18 BDN	Test and fix TTSPEED, SETSPD and BINREAD


	.sbttl	macros

	.macro	clrfqb
	call	$clrfq
	.endm	clrfqb

	.macro	clrxrb
	call	$clrxr
	.endm	clrxrb

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


	.psect	$code


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

	.mcall	alun$s	,qiow$s

xinit::	alun$s	#lun.tt,#"TI,#tiunit	; assign the terminal please
;-	qiow$s	#io.ata,#lun.tt,#ef.tt,#50,#kbiost,,<,#0,#ttast>
	qiow$s	#io.att,#lun.tt,#ef.tt,#50,#kbiost
	return

	global	<lun.tt	,tiunit>


	.sbttl	terminal initialization
	.psect	$code


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


ttyini::call	ttpars			; parse the device name to get unit
	bcs	100$			; oops
	alun$s	2(r5),#"TT,r0		; try to assign the device
	qiow$s	#io.att,2(r5),#ef.tt,#50,#kbiost
	cmpb	kbiost	,#ie.daa	; if already attached then ignore it
	bne	10$			; no
	clrb	kbiost			; yes, say it was successful
10$:	moverr	kbiost	,r0		; get the result of this operation
	br	110$			; make it > 0 for error text print
100$:	moverr	@#$DSW	,r0		; exit
110$:	return




ttyfin::qiow$s	#io.det,2(r5),#ef.tt,#50,#kbiost
	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	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 please
	clr	-(sp)			; a buffer for sf.smc
	clr	r0			; assume our terminal
	mov	@r5	,r1		; passed value of zero ?
	beq	10$			; yes, assume TI:
	tstb	@r1			; well, what about a null string?
	beq	10$			; yes, again assume TI:
	call	ttpars			; a real name, try to parse it
	bcs	90$			; oops
10$:	mov	sp	,r1		; point to the local buffer
	alun$s	#lun.co,#"TT,r0		; assign the terminal please
	qiow$s	#io.att,#lun.co,#ef.tt,#50,#kbiost
	movb	#tc.nec	,@r1		; say we want no echoing
	qiow$s	#sf.smc,#lun.co,#ef.tt,#50,#kbiost,,<r1,#2>
	movb	kbiost	,-(sp)		; save the error code if any
	qiow$s	#io.det,#lun.co,#ef.tt,#50,#kbiost
	cmpb	(sp)+	,#ie.pri	; priv violation here ?
	bne	20$			; no
	call	200$			; yes, try to spawn MCR command
	br	100$
20$:	clr	r0			; asuume no error and exit
	br	100$			; bye

90$:	movb	@#$DSW	,r0		; return TTPARS error code
100$:	tst	(sp)+			; pop local buffer
	unsave	<r1>			; pop saved register
	return


200$:	sub	#100	,sp		; use mcr set /noecho=ttnn:
	mov	sp	,r1		; point to it please
	copyz	#300$	,r1		; copy the 'SET /NOECHO='
	strlen	r1			; get the current string length
	add	r0	,r1		; point to the end of the line
	mov	@r5	,r0		; get the string address
	tstb	@r0			; anything there at all ?
	beq	210$			; no, just exit please
	copyz	@r5	,r1		; simple
	mov	sp	,r1		; point back to the buffer
	calls	runmcr	,<#1,r1>	; simple, call mcr to do it
210$:	add	#100	,sp		; pop the local buffer and exit
	return

300$:	.asciz	#SET /NOECHO=#
	.even



;	E C H O
;
;	input:	nothing
;	output:	nothing


echo::	clr	r0
	return




kbread::qiow$s	#io.rvb,#5,#ef.tt,#50,#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
;


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




;	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,#50,#kbiost,,<@r5,2(r5)>
	clr	r0
	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,#50,#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

logout::
exit::	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
	bne	10$			; ok
	mov	#5	,r0
10$:	qiow$s	#sf.smc,r0,#ef.tt,#50,#kbiost,,<r1,#2>
100$:	tst	(sp)+
	unsave	<r1,r0>			; all done
	return				; bye





	.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


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


	.sbttl	hangup a terminal, set dtr on a terminal


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


ttyhan::call	ttpars			; the usual, parse the device name
	bcs	100$			; oops
	alun$s	#lun.co,#"TT,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$:	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.	,-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	,-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,#"TT,r0		; assign the terminal please
	qiow$s	#io.att,#lun.co,#ef.tt,#50,#kbiost
	mov	sp	,r2
	movb	#tc.xsp	,@r2
	movb	#tc.rsp	,2(r2)
	qiow$s	#sf.gmc,#lun.co,#ef.tt,#50,#kbiost,,<r2,#4>
	movb	kbiost	,-(sp)
	qiow$s	#io.det,#lun.co,#ef.tt,#50,#kbiost
	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



;	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
	clr	r1			; match the passed speed to the
10$:	cmp	splst(r1),#-1		; speed desired to get the index
	beq	80$			; end of the table, invalid speed
	cmp	splst(r1),2(r5)		; a match yet ?
	beq	20$			; yes
	tst	(r1)+			; 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(r1),(r2)+	; and the desired speed now
	movb	#tc.rsp	,(r2)+		; stuff receiver change code in
	movb	setlst(r1),(r2)+	; and the desired speed now
	mov	sp	,r2		; point back to the buffer now
	alun$s	#lun.co,#"TT,r0		; assign the terminal please
	qiow$s	#io.att,#lun.co,#ef.tt,#50,#kbiost
	qiow$s	#sf.smc,#lun.co,#ef.tt,#50,#kbiost,,<r2,#4>
	movb	kbiost	,-(sp)
	qiow$s	#io.det,#lun.co,#ef.tt,#50,#kbiost
	movb	(sp)+	,kbiost
	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	<r2,r1>			; bye
	return


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

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


ttysav::save	<r1,r2>			; save registers please
	call	ttpars			; and now parse the device name
	bcs	90$			; oops
90$:	movb	@#$DSW	,r0		; error, return it in r0
100$:	unsave	<r2,r1>			; pop registers and exit
	return



ttyrst::save	<r1,r2>			; save registers please
	unsave	<r2,r1>			; pop registers and exit
	return


ttyset::save	<r1>
	call	ttpars			; set terminal up for KERMIT
	bcs	90$			; oops, bad device name
90$:	movb	@#$DSW	,r0		; return possible errors
	unsave	<r1>
	return

	global	<ttparm>

	.sbttl	ttpars	get unit number from ttname

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


ttpars:	save	<r1,r2,r3>		; parse a device name
	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	,#'T&137	; must be of the format TTnnn:
	beq	10$			; ok so far
	cmpb	@r3	,#'T!40		; must be of the format TTnnn:
	bne	90$			; no
10$:	inc	r3
	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$:	inc	r3
	clr	r0			; could use .parse but this is

30$:	movb	(r3)+	,r1		; get the next digit in the string
	beq	90$			; hit end of string
	cmpb	r1	,#':		; end of the device name ?
	beq	100$			; yes, exit please
	cmpb	r1	,#'0		; in the range '0'..'7' ?
	blo	90$			; oops
	cmpb	r1	,#'7		; keep checking please
	bhi	90$			; bad device name
	asl	r0			; r0 = r0 * 8
	asl	r0			; ditto
	asl	r0			; and so forth
	sub	#'0	,r1		; convert to binary
	add	r1	,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
100$:	tst	r0			; did we get a real value here ?
	bne	105$			; yes
	mov	#377	,r0		; no, return psuedo unit for self
105$:	clr	@#$dsw			; no errors
	clc				; success
110$:	unsave	<r3,r2,r1>		; 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::save	<r1>
	call	ttpars
	bcs	100$
	clr	r1			; flag if we timed out
	mrkt$s	#ef.tmo,#2,#2,#asstmo	; give 2 seconds to do this
	alun$s	#lun.as,#"TT,r0		; assign the terminal please
	qiow$s	#io.att,#lun.as,#ef.tt,#50,#kbiost
	mov	r1	,r0		; did we ever time out
	bne	110$			; yes, return busy device
	cmkt$s	#ef.tmo,#asstmo
	clr	r0
	cmpb	kbiost	,#is.suc	; did it work
	beq	110$			; yes, return error zero
	moverr	kbiost	,r0		; no, get the error code
	br	110$			; and exit
100$:	moverr	@#$DSW	,r0
110$:	unsave	<r1>
	return


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


	.sbttl	namcvt	remove everything but the filename.type


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



	.mcall	fdop$r	,csi$1	,csi$2	,nmblk$	,csi$
	.psect	rsxdat	,rw,d,lcl,rel,con

	csi$

defnam:	nmblk$	,,0,SY,0
	.even

	fdbsiz	=	150.

	.psect	$code


namcvt::save	<r1,r2,r3,r4>

	sub	#fdbsiz	,sp		; allocate fdb on the stack
	mov	sp	,r4		; use r5 to point to it
	mov	#fdbsiz	,r0		; and clear the new fdb out
5$:	clrb	(r4)+			; to avoid strange side effects
	sob	r0	,5$		; next, please
	mov	sp	,r4		; restore pointer to the fbd

	sub	#c.size+2,sp		; allocate a csi buffer
	mov	sp	,r3		; and a pointer to it.
	add	#c.dsds	,r3		; setup for fdop$ call
	fdop$r	r4,#lun.sr,r3,#defnam,<#fa.rd!fa.shr>
	mov	sp	,r3		; restore pointer to the csi block

	strlen	@r5			; get the string length now
	mov	r0	,r1		; anything there at all ?
	csi$1	r3,@r5,r1		; now do the first scan.
	bcs	180$			; oops
	csi$2	r3,OUTPUT		; finish up the scan please
	bcs	180$			; oops

	save	<r4,r5>			; now parse the filename
	mov	r4	,r0		; setup for call to .parse
	mov	r4	,r1		; setup a pointer to the
	add	#f.fnb	,r1		; filename block
	mov	f.dspt(r4),r2		; where to get the filespec
	mov	#defnam	,r3		; defaults to be filled in.
	call	.parse			; parse it to get the rad50
	unsave	<r5,r4>			; and other stuff for the file
	bcs	190$			; oops

	add	#f.fnb+n.fnam,r4	; point to file filename block
	mov	2(r5)	,r3		; point to the resultant string
	calls	rdtoa	,<r3,(r4)+>	; and convert to ascii
	add	#3	,r3		; next three please
	calls	rdtoa	,<r3,(r4)+>	; and convert to ascii
	add	#3	,r3		; next three please
	calls	rdtoa	,<r3,(r4)+>	; and convert to ascii
	add	#3	,r3		; next three please
	movb	#'.	,(r3)+		; insert a dot please
	calls	rdtoa	,<r3,(r4)+>	; and convert to ascii
	add	#3	,r3		; next three please
	clrb	@r3			; .asciz
	calls	cvt$$	,<2(r5),#15,#377>; remove junk like imbedded spaces
	add	2(r5)	,r0		; and make it .asciz
	clrb	@r0			; simple
	clr	r0			; no errors
	br	200$			; bye

180$:	moverr	@#$DSW	,r0		; error from CSI ?
	br	200$			; bye

190$:	moverr	f.err(r4),r0		; error from .parse ?

200$:	add	#c.size+2,sp
	add	#fdbsiz	,sp
	unsave	<r4,r3,r2,r1>
	return
	





	.sbttl	ascdat	get the ascii string for the date

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


ascdat::save	<r0,r1>
	mov	@r5	,r0
	clrb	@r0
	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>
	mov	@r5	,r0
	clrb	@r0
	unsave	<r1,r0>			; pop temps and exit
	return


	.sbttl	systat	get list of users logged in

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

setcc::	return

$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

	.enabl	gbl
	.mcall	spwn$s	,wtse$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$:	wtse$s	#6			; Wait 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	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>

	.end
