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

	.ident	/5.0.05/	; Jerry Hudgins (see below)

;	define macros and things we want for KERMIT-11




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

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


;	Copyright (C) 1983 1984 1985 1986  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	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.
;
; 11-Dec-85 Robin Miller 5.0.02  Attach the terminal in the TTYINI routine
;	(RTM01)		so incoming characters are not lost.  On a /SLAVE
;			terminal, the terminal must be attached so charac-
;			ters will be placed in the typeahead buffer.
;			Also detach the terminal in the TTYFIN routine.
;
; 11-Dec-85 Robin Miller 5.0.03  Change routine TTPARS to allow device names
;	(RTM02)		other name XK, TI, or TT for logical names.  Also
;			check for an error from ALUN$S directive in ASSDEV.
;
; 12-Dec-85 Robin Miller 5.0.04  Change routine ASSDEV to check for logged
;	(RTM03)		on terminal and to get real device name via GLUN$
;			incase we've assigned a logical name.
;
;
; 25-Dec-85 Brian Nelson
; 08-Feb-86 Steve Heflin
; 10-Feb-86 Brian Nelson
;			Finish added Steve Heflin's mods for ATOZ in.
;
; 03-Feb-89 Jerry Hudgins 5.0.05
;			Moved GETPRV call in ASSDEV to ensure priv's are
;			up for SF.SMC; will otherwise crash M+ V4.0.  Set
;			priv's on in EXIT routine also.
;
;
;	RSX11M,M+ and P/OS support.
;
;	If this looks like it's a mess, it's because it IS. It gets changed
;	a little bit here and there (for the past 2 years),  and thus has a
;	number of contributions and changes from others, and changes due to
;	'NEW' versions of M+ and MicroRSX (ie, things stop working).

	.sbttl	macros


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

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


	.save
	.psect	CLECTX	,RW,D,GBL,REL,CON
	.restore

	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

	.library	/LB:[1,1]EXEMC.MLB/
	.mcall	UCBDF$
	UCBDF$

	.sbttl	data areas

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

fu$def::.word	0			; if rms needs the DNA filled in
;	The following defaults can be changed in the TKB command file as in:
;
;	GBLPAT=K11PAK:DO$APP:1
;	GBLPAT=K11PAK:DO$APP:0
;	GBLPAT=K11PAK:DO$APP:0

do$dte::.word	0			; if NE, force PROCOMM to default
do$app::.word	0			; if NE, then append to logfiles
do$msg::.word	1			; if EQ, then don't be verbose at times
do$tra::.word	1			; if we look in logical name tables
					; for an available terminal.
do$alt::.word	1			; Force SET RSX CON ALT

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

;
; Terminal settings and parameter lists for line setting
;
;
;	Add mods from Steve Heflin in (SSH and /41/ comments)
;
;	Do not include the TC.TBC in the main GMC or SMC as we will
;	not know if we are running on M, M+ or Micro-RSX. TC.TBS is
;	not available on M. If built on M, the undefined global for
;	TC.TBS won't hurt anything.   BDN 20-DEC-1985 10:29

savass:					; Remote line saved attributes
savdlu::.byte	TC.DLU,0		; /{no}REMOTE		   /41/
	.byte   TC.SLV,0                ; /{no}SLAVE
	.byte	TC.BIN,0		; /{no}READ_PASSALL	   /45/
	.byte	TC.NEC,0		; /{no}ECHO		   /41/
	.byte	TC.RAT,0		; /{no}TYPEAHEAD	   /41/
	.byte	TC.8BC,0		; /{no}EIGHT_BIT	   /41/
savtbs:	.byte	TC.TBS,0		; typeahead buffer size	   /41/
	.byte	TC.NBR,0		; /{no}BROADCAST	   /41/
diarst	= . - savass			; Restore this much for DIAL /45/
savxsp: .byte	TC.XSP,0		; /SPEED:xmt		   /41/
savrsp: .byte	TC.RSP,0		; /SPEED:rcv		   /41/
asvlen = .-savass			;			   /41/



setass: .byte   TC.SLV,1                ; /SLAVE=TTnn:
	.byte	TC.NEC,1		; /NOECHO		   /41/
	.byte	TC.RAT,1		; /TYPEAHEAD		   /41/
	.byte	TC.8BC,1		; /EIGHT_BIT		   /41/
settbs:	.byte	TC.TBS,220.		; typeahead buffer size	   /41/
	.byte	TC.NBR,1		; /NOBROADCAST		   /41/
astlen = .-setass			;			   /41/


assdon: .word   0			; flag remote save/set done
 
aslspd:					; Assigned line speed block/41/
aslxsp::.byte	TC.XSP,0		; /SPEED:xmt		   /41/
aslrsp::.byte	TC.RSP,0		; /SPEED:rcv		   /41/

iopend:	.word	0			; /36/ lun i/o waiting on

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	MAXLNG+<MAXLNG/10>		; /42/ (larger) Buffer itself
	.even					; /42/ Safety
maxlin 	= 	.-linbuf			; Maximum read length
	.even
linptr:	.word	linbuf				; Scan pointer
icrem:	.rept	15.				; # characters remaining
	.word	0
	.endr
privon:	.word	0				; /41/ Save priv on/off status

	ALSIZE	==	440
	SDBSIZ	==	440

$albuf:	.blkb	ALSIZE				; /51/ Moved from K11DAT
$phnum:	.blkb	60
$lnrea::.word	RDLIN			; Default for packet reading

; Other r/w data for dialout line set routines				/45/
;
	.psect	rwdata	,rw,d,lcl,rel,con ; read/write data

;  Buffers for Autocall modem fix	;				/45/

fixti2:	.byte	TC.DLU,2,TC.ABD,0	; values we need for a modem    /45/
sizti2 = . - fixti2			; size of buffers for autocall	/45/



; Read only code section


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


; System Macros used to get/set characteristics for dial out		/45/

	.mcall	qiow$,dir$		; call in system macroes	/45/

	ef.rem = 14.			; use remote event flag (14)	/45/

set.dlu:    qiow$ sf.smc,lun.ti,ef.rem,,,,<fixti2,sizti2>	;	/45/
set.chars:  qiow$ sf.smc,lun.ti,ef.rem,,,,<diachr,dialen> 	;	/45/
rest.chars: qiow$ sf.smc,lun.ti,ef.rem,,,,<datchr,datlen>	;	/45/

;	M+3.0 Carrier loss detection

dtrast:	.byte	TC.MHU,0
	.word	carast		
dtrclr:	.byte	TC.MHU,0
	.word	0


; Attributes needed to dialout						/45/

diachr:	.byte	TC.BIN,1	; binary mode to pass CNTR chars	/45/
dialen = .-diachr		; - length of dialout char set		/45/



; 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
	.byte	TC.BIN,0			; /NORPA
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	,SREX$S	,FEAT$S

	FE$EXT	=	1

	.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.
;
; 23-Dec-85  19:28:43 BDN
;
;  For P/OS,  M+ v3 and Micro Rsx v3, also do a TLOG (or TRAN) and
; if we we a translation, do an implicit SET LINE. Can be disabled
; by setting DO$TRAN eq to zero.

	.enabl	lsb

xinit::	call	rmsini			; /53/ Setup SST
	FEAT$S	#FE$EXT			; /56/ See if 4.2 or M+ 3.x
	bcc	1$			; /56/ Ok
	mov	sp	,rsx32		; /56/ Set 3.2 flag
	SREX$S	#1$			; /56/ See if this is OLD Rsx (3.2)
	bcs	1$			; /56/ Must be old RSX
	clr	rsx32			; /56/ 4.0 or later, or M+ 1.0 and later
	SREX$S				; /56/ Clear requested exit address
1$:	mov	#$albuf	,albuff		; /51/ Fill in
	mov	#$phnum	,phnum		; /51/ Fill in
	clrb	@phnum			; /51/ Zero it
	clr	@albuff			; /51/ Init to empty.
	mov	#$cmdbuf,cmdbuf		; /53/ $CMDBUF defined in K11RMS
	mov	#$argbuf,argbuf		; /53/ $ARGBUF defined in K11RMS
	mov	do$tran	,dotran		; /41/ flag for translation
	mov	do$msg	,infomsg	; /41/ flag for msg displaying
	mov	do$app	,logapp		; /41/ Append to logfile flag
	mov	do$dte	,procom		; /50/ Set default for PRO/COMM
	message	<Linked for RSX11M/M+ and P/OS >
	tst	#dapsup			; /56/
	bne	4$			; /56/
	message	<no DAP support>	; /56/
4$:	message				; /56/
	tst	do$alt			; /46/ Force alternate code?
	beq	5$			; /46/ No
	mov	#xdorsx	,con$ds		; /46/ Yes
5$:	mov	#xdorsx	,altcon		; /44/
	call	getsys			; Find out whats running
	cmpb	r0	,#SY$MPL	; M+?
	bne	10$			; No
	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
20$:	tst	dotran			; /41/ look for logical name
	beq	30$			; /41/ no
	CALLS	trntrm	,<#ttname>	; /41/ see if translation exits
	tst	r0			; /41/ did this succeed ?
	bne	30$			; /41/ no
	MESSAGE	<Logical name translation returned >; /41/ inform the user
	print	#ttname			; /41/ print the equivalence name
	MESSAGE				; /41/
	STRCPY	#ttdial	,#ttname	; /41/ copy it over here also 
	clr	remote			; /41/ and we are local
	br	40$			; /41/ continue
30$:	tst	proflg			; /41/ assume default line for P/OS?
	beq	40$			; /41/ not P/OS
	mov	#poscon	,con$ds		; /44/ Force my connect code for p/os
	STRCPY	#ttname	,#xk$dev	; /41/ use xk0: device
	STRCPY	#ttdial	,#xk$dev	; /41/ use xk0: device
	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	ttspeed	,<#ttname>	; /54/ Find out current speed
	tst	r0			; /54/ Can't faile
	beq	40$			; /54/ It did
	MESSAGE	<Current speed: >	; /54/ A MESSAGE
	DECOUT	r0			; /54/ Simple
	MESSAGE				; cr/lf
40$:	ALUN$S	#LUN.TT,#"TI,#TIUNIT	; Assign command term.
	QIOW$S	#IO.ATT,#LUN.TT,#EF.TT,,#kbiost; Attach it, also
	QIOW$S	#SF.SMC,#LUN.TT,,,,,<#echoch,#2>
	sub	#10	,sp		; /53/ Get terminal driver support
	mov	sp	,r2		; /53/ A buffer
	QIOW$S	#IO.GTS,#LUN.TT,,,,,<r2,#4>
	bcs	50$			; /53/ Oops
	bit	#F2.EIO	,2(r2)		; /53/ Extended IO today?
	beq	50$			; /53/ No
	mov	#eioread,$lnread	; /53/ M+, try IO.EIO for version 3
50$:	add	#10	,sp		; /53/ Pop buffer
	clr	tcdlu			; don't change tc.dlu
	call	setcc			; enable ^C asts
	call	inqter			; /45/ No, get the terminal type
	mov	r0	,vttype		; /45/ Done
	return

	.save
	.psect	$xkdev	,ro,d,lcl,rel,con
echoch:	.byte	TC.NEC,0
xk$dev::.asciz	/XK0:/
	.even
	.dsabl	lsb
	.restore


	global	<altcon, xdorsx	,con$ds	,poscon>	; /44/
	global	<lun.tt, tiunit>
	global	<ARGBUF,CMDBUF,$ARGBUF,$CMDBUF>	; /53/
	global	<DAPSUP,RSX32>			; /56/

inqbuf::mov	#200.	,-(sp)		; /42/ Assume M+
	call	getsys			; /42/ M+ today?
	cmpb	r0	,#SY$MPL	; /42/ If so, large buffering
	beq	100$			; /42/ M+
	mov	#500.	,(sp)		; /42/ Assume P/OS
	tst	proflg			; /42/ P/OS and XK:?
	bne	100$			; /42/ Yes, return(500)
	mov	#90.	,(sp)		; /42/ Vanilla RSX11M
100$:	mov	(sp)+	,r0		; /42/ Return buffering available
	return				; /42/ for LONG PACKET support.


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
	tst	iopend			; /36/ Is a QIO pending for packet?
	beq	100$			; /36/ no
	QIOW$S	#IO.KIL,iopend		; /36/ Yes, force an IO.ABO error
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	getprv				; /41/ May need privs
	call	ttpars				; Get unit number
	bcs	1$
	alun$s	2(r5),r1,r0			; Assign LUN
	mov	$dsw,r0				; get the result
	bcc	2$				; oops
1$:	jmp	10$				; Too far to branch
2$:	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	#io.att,2(r5),#ef.tt		; Attach the terminal.	(RTM01)
	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>
	clr	eioinit				;
	mov	kbiost,r0
	cmpb	r0,#IS.SUC			; OK?
	bne	10$				; (no)
	clr	r0				; Yes - clear r0 = OK
	QIOW$S	#SF.SMC,2(r5),,,,,<#dtrast,#4>	; Set this up for carrier loss
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>
	call	drpprv				; /41/ No privs wanted now
	return


rstsrv::tst	inserv
	beq	100$
	call	..abort
100$:	return


..abort:call	getprv			; /41/ May need privs turned on
	QIOW$S	#sf.smc,inilun,#ef.tt,,#kbiost,,<#savchr,#savlen>
	call	drpprv			; /41/ Don't want privs anymore
	return


abort:	call	..abort
	jmp	exit

	global	<inserv>


;	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::call	getprv				; /41/ May need privs up now
	srex$s					; no more abort handling
	cmp	2(r5),#lun.co			; Command terminal?
	beq	10$				; (yes, skip it)
	QIOW$S	#SF.SMC,2(r5),,,,,<#dtrclr,#4>	; Set this up for carrier loss
	QIOW$S	#io.det,2(r5),#ef.tt		; Attach the terminal.	(RTM01)
	tst	savdon				; ever save the crap?
	beq	10$				; no, don't reset it
	QIOW$S	#sf.smc,2(r5),#ef.tt,,,,<#savchr,#savlen>
10$:	call	drpprv				; /41/ Don't want privs up
	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	#lf1
	return

	.save
	.psect	$PDATA	,D
lf1:	.byte	lf,0
	.restore



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

pakrea::
binrea::mov	@r5	,iopend		; /36/ save lun i/o is waiting on
	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
	br	100$			; /36/ exit

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	40$			; (yes)
	jsr	pc	,@$lnread	; Call someone to read data
	bcs	50$			; (read error)
	br	10$			; Try again

40$:	clr	r1			; Move next char unsigned ...
	bisb	@linptr,r1		; ... into r1
	inc	linptr			; Advance pointer
	dec	icrem(r2)		; Decrement # characters remaining
	clr	r0			; Success
50$:	unsave	<r2>
100$:	clr	iopend			; /36/ i/o no longer pending
	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

	.mcall	mrkt$s	,wtse$s	,qiow$s

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
	tstb	parity			; /39/ must check if TTDRV may never
	beq	24$			; /39/ see it's <CR> to terminate the
	cmpb	parity	,#PAR$NO	; /39/ line. Use a read with terminator
	beq	24$			; /39/ QIO if parity is on.
	br	25$			; /41/ IO.RTT did not work

;-/41/	mov	#<IO.RTT!TF.RNE!TF.TMO>,r1 ; /39/ 
;-/41/	QIOW$S	r1,@r5,#ef.tt,,#kbiost,,<#linbuf,#maxlin,r0,#tt$trm> ; /39/
;-/41/	br	30$			; /39/

24$:	QIOW$S	#<io.rlb!tf.tmo>,@r5,#ef.tt,,#kbiost,,<#linbuf,#maxlin,r0>
	br	30$

25$:	call	getprv			; /41/ May need for SF.GMC call
	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
	call	drpprv			; /41/ Drop privs if need be

30$:	movb	kbiost	,r0		; /41/
	cmpb	r0	,#IE.DNR	; /45/ Did we drop carrier ?
	bne	31$			; /45/ No
	mrkt$s	#2,#1,#2		; /45/ Yes, suspend for 1 second
	wtse$s	#2			; /45/ ...
	br	40$			; /45/ Treat as timeout at upper lev
31$:	cmpb	r0	,#IS.TMO	; timed out on the read ?
	beq	40$			; yes
	cmpb	r0	,#IE.ABO	; /36/ from IO.KIL on control C ast?
	beq	40$			; /36/ yes, treat as a timeout then
	cmpb	r0	,#IE.EOF	; /41/ End of file today (control Z)?
	beq	80$			; /41/ Yes, return control Z and 1 byte
	cmpb	kbiost+1,#33		; /47/ Was \033 the terminator?
	beq	80$			; /41/ Yes, Again return control Z
	cmpb	linbuf	,#'Z&37		; /41/ P/OS style reads and control Z?
	beq	80$			; /41/ Yes, exit
	tst	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

80$:	movb	#'Z&37	,linbuf		; /41/ EOF or Escape sequence, return
	mov	#1	,icrem(r2)	; /41/ control Z and char_count == 1
	clc				; /41/ success
	return				; /41/ exit

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



	.sbttl	Extended I/O read for M+ and MicroRsx version 3.x
	.enabl	lsb

;	Added 27-Jun-86  13:24:18  Brian Nelson
;
;	Now that I finally have an 11/73 running M+, I can do stuff
;	like this.

	E$MOD1	=	0		; Modifier word 1
	E$MOD2	=	2		; Modifier word 2
	E$BUFF	=	4		; Buffer address
	E$LEN	=	6		; Buffer length
	E$TMO	=	10		; Timeout (in seconds here)
	E$PRM	=	12		; Prompt address
	E$PRML	=	14		; Prompt length
	E$PRMV	=	16		; Prompt VFC
	E$TT	=	20		; Terminator table address
	E$TTL	=	22		; Terminator table length
	E$DFD	=	24		; Default data address
	E$DFDL	=	26		; Default data length

	.save				; Save current code psect
	.psect	rwdata	,d		; New psect
	.even				; Insure
eiojnk:	.word	0
eiolst:	.word	0,0,0,0,0,0,0,0,0,0,0,0,0 ; Itemlist for IO.EIO
eioios:	.word	0,0,0,0
eioini:	.word	0
eiochr:	.byte	TC.BIN,0,TC.PTH,0
eiosav:	.byte	TC.BIN,0,TC.PTH,0
	$$eiol	=	. - eiosav
	.restore			; Restore old psect


eiorea::mov	r3	,-(sp)		; Save please
	tst	eioini			; Need to set chars for EIO?
	bne	10$			; No (reset to zero in TTYINI)
	mov	sp	,eioini		; Yes, change to /NORPA and /PASTHRU
	tstb	handch			; Hand shaking in effect?
	bne	10$			; Yes, leave TC.BIN on please
	call	getprv			; May need privs on
	QIOW$S	#SF.GMC,(r5),#EF.TT,,,,<#eiosav,#$$EIOL>
	QIOW$S	#SF.SMC,(r5),#EF.TT,,,,<#eiochr,#$$EIOL>
	call	drpprv			; Drop them now.
10$:	clr	ICREM(r2)		; Reset buffer counter
	mov	#linbuf,linptr		; Reset scan pointer
	mov	#eiolst	,r3		; The itemlist
	mov	2(r5)	,E$TMO(r3)	; Insert the timeout please
	mov	#linbuf	,E$BUFF(r3)	; Insert the buffer address next.
	mov	#maxlin	,E$LEN(r3)	; Insert the buffer size also.
	mov	#TF.TMO	,E$MOD1(r3)	; Insert desired read modifiers.
	tst	chario			; Do we read EXACTLY whats in buffer?
	bne	15$			; Yes.
	tstb	parity			; Is parity on ?
	beq	20$			; No, wait for terminators
	cmpb	parity	,#PAR$NO	; Well?
	beq	20$			; Ok. Otherwise, read typeahead ONLY
15$:	clr	E$TMO(r3)		; Yes, later we will not timeout first
	bis	#TF.RAL	,E$MOD1(r3)	; Also, we want everything AS IS!
					;
20$:	QIOW$S	#IO.EIO!TF.RLB,(r5),#EF.TT,,#eioios,,<#eiolst,#30>
	bcs	90$			; The directive completely died
	movb	eioios	,r0		; Get the QIO result.
	cmpb	r0	,#IE.IFC	; Did it die because of this
	beq	90$			; Yes, reset to old read mode.
	cmpb	r0	,#IE.ABO	; Did the ^C ast routine do IO.KIL
	beq	80$			; Yes, return(TIMEOUT)
	cmpb	r0	,#IE.DNR	; Do we lack carrier now?
	beq	70$			; Yes, sleep a moment, return(TMO)
	cmpb	r0	,#IE.EOF	; Well, what about END of FILE?
	beq	60$			; Thats it, return a control Z
	tst	r0			; Did we get ANY kind of success?
	bmi	90$			; No, reset reader address, redo.
	cmpb	eioios+1,#33		; Did we get ESCAPE as terminator?
	beq	60$			; Yes, also treat as control Z
	cmpb	linbuf	,#'Z&37		; Does the buffer START with ^Z?
	beq	60$			; Yes, same thing.
	cmpb	r0	,#IS.TMO	; Success with a TIMEOUT?
	bne	30$			; No
	tst	eioios+2		; Yes, was there ANY data present?
	bne	30$			; There was data, return it please.
	tstb	E$TMO(r3)		; No data, but did we want only the
	bne	80$			; typeahead that was there? No
	mov	2(r5)	,E$TMO(r3)	; Yes, stuff a REAL timeout in.
	mov	#1	,E$LEN(r3)	; And only ONE character this time.
	bis	#TF.RAL	,E$MOD1(r3)	; Insure no waits for terminators.
	br	20$			; Try the read over again now.
					;
30$:	mov	eioios+2,ICREM(r2)	; Return the size of the read now.
	mov	#linbuf	,r1		; Get the buffer address
	add	ICREM(r2),r1		; And point to the end of it.
	movb	eioios+1,(r1)		; Get possible terminator character
	beq	40$			; (none)
	inc	ICREM(r2)		; Adjust for terminator
40$:	clrb	(r1)			; Null terminate just for grins
	clr	r0			; Clear r0 and C-bit
	br	100$			; Exit at last....
					;
					;
60$:	movb	#'Z&37	,linbuf		; Force a control Z to be returned
	inc	ICREM(r2)		; Return exactly ONE character.
	clc				; Successfull
	br	100$			; Exit
					;
70$:	MRKT$S	#2,#1,#2		; Lost carrier, suspend for a
	WTSE$S	#2			; moment and return(TIMEOUT)
					; Drop through to timeout
80$:	movb	#ER.TMO	,r0		; Return timeout error code
	sec				; Say the read failed
	br	100$			; And exit
					;
90$:	mov	#rdlin	,$lnread	; Total failure, switch readers.
	call	getprv			; May need privs on
	QIOW$S	#SF.SMC,(r5),#EF.TT,,,,<#eiosav,#$$EIOL>
	call	drpprv			; Drop them now.
	clc				; Force caller to try again.
100$:	mov	(sp)+	,r3		; Restore r3
	return

	.dsabl	lsb


	.sbttl	BINWRITE(&buffer,size,channel)

;		0(r5)	Buffer address
;		2(r5)	buffer size
;		4(r5)	channel number
;	output:	r0	error code


;	Edit:	/40/ 16-Dec-85  14:58:01 BDN	Set timer in case line xoffed


	.mcall	mrkt$s	,cmkt$s	,QIOW$S	,astx$s	; /40/
	.enabl	lsb				; /40/

pakwri::
binwri::mov	4(r5)	,310$			; /40/ Registers saved in ASTs?
	mrkt$s	#ef.tmo,#7,#2,#200$		; /40/ start 7 second timeout
	QIOW$S	#io.wal,4(r5),#ef.tt,,#kbiost,,<@r5,2(r5)>
	cmpb	kbiost	,#IE.ABO		; /41/ Did the timeout occur?
	beq	90$				; /41/ Yes, try again
	cmkt$s	#ef.tmo,#200$			; /40/ write ok, cancel timer
	br	100$				; /40/ and exit
90$:	QIOW$S	#io.wal,4(r5),#ef.tt,,#kbiost,,<@r5,2(r5)> ; /40/
100$:	clr	r0
	return


200$:	QIOW$S	#IO.KIL,310$			; /40/ abort the pending I/O
	call	getprv				; /41/ May need privs up now
	QIOW$S	#SF.SMC,310$,,,,,<#300$,#2>	; /40/ insure line is XON'ED
	call	drpprv				; /41/ Don't want privs anymore
	tst	(sp)+				; /40/ pop timeout flag and
	astx$s					; /40/ exit

	.save
	.psect	$idata	rw,d,lcl,rel,con
	.even
300$:	.byte	TC.CTS,0
310$:	.word	0
	.restore
	.dsabl	lsb






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

;	X B I N R E A
;
;	binread( %val channel_number, %val timeout )
;
;
;	 XBINREAD is used in Kermit-11 for the DIAL command to read the
;	responses from the modem on a character by character basis, and
;	also  is called once per  packet if in local  mode to check for
;	typeahead  in the form of  CTRL E, X or Z to implement graceful
;	transfer aborts. While this could be done under M/M+ via an un-
;	solicited character AST,  that won't work for RT11  and RSTS/E.
;	Thus the sampling method (XBINREA called by CHKABO).
;
;	/38/ Change  QIO timed read to untimed with a MARKTIME (MRKT$S)
;	to allow better  granularity on the timeout interval.  If time-
;	out occures, do a IO.KIL
;
;
;	input:	@r5	channel number
;		2(r5)	timeout	(if -1, then no wait) (do this for RSX??)
;
;	output:	r0	error
;		r1	character read
;

	.mcall	QIOW$S	,mrkt$s	,cmkt$s	,astx$s


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$:	tst	2(r5)			; /38/ a real timed read ?
	ble	30$			; /38/ no
	mov	@r5	,iopend		; /38/ save LUN
	mrkt$s	#ef.tmo,2(r5),#2,#200$	; /38/ we really want 1 second chuncks
30$:	QIOW$S	#io.ral!tf.rne,@r5,#ef.tt,#50,#kbiost,,<r2,#1>
	cmkt$s	#ef.tmo,#200$		; /38/ cancel marktime please
	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	#IE.ABO	,kbiost		; /38/ convert IO.KIL to timeout
	beq	40$			; /38/
	cmpb	#is.tmo	,kbiost		; timeout
	bne	90$			; no
40$:	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
	clr	iopend			; /38/
	return				; bye

200$:	tst	(sp)+			; mark time ast entry
	QIOW$S	#IO.KIL,iopend,#ef.tt	; kill the i/o
	astx$s				; exit

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	Special routines for command line editor

read1c::clr	-(sp)
	mov	sp	,r0
	QIOW$S	#IO.RAL!TF.RNE,#5,#EF.TT,,#kbiost,,<r0,#1>
	cmpb	kbiost	,#IS.SUC
	beq	10$
	clrb	@r0
10$:	movb	kbiost	,r0
	mov	(sp)+	,r0
	cmpb	r0	,#CR
	bne	100$
	mov	#LF	,r0
100$:	bic	#^C377	,r0
	return

wrtall::SAVE	<r0,r2>			; Must use IO.WAL for CLE for
	mov	2+4(sp)	,r2		; some versions of RSX11M
	STRLEN	r2			; Get the string length.
	QIOW$S	#IO.WAL,#5,,,,,<r2,r0>	; Dump the string in pass-all mode
	UNSAVE	<r2,r0>			; Pop register
	mov	(sp)+	,(sp)		; Move return address over parameter
	return				; Exit


clrcns::QIOW$S	#SF.SMC,#5,,,,,<#can,#2>; Simple
	return

	.save
	.psect	rwdata	,d
can:	.byte	TC.TBF,0
	.restore


	.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::MESSAGE
	return




	.sbttl	exit kermit and logout

;	Logout a server (LOGOUT:) by requesting ...BYE
;	Exit Kermit-11
;
;	Steve Heflin's mods added 25-Dec-85  12:46:29  BDN


	.mcall	exit$s	,rpoi$s	,exst$s; /41/ add EXST$S

	.save
	.psect	$PDATA	,D
bye:	.rad50	/...BYE/
	.restore

logout::
	tst	assdon			; ever slave the line?
	beq	10$			; no
	call	rstass			; /41/ restore more things now
10$:	RPOI$S	#BYE			; request ...BYE
	br	exits			; /41/ exit with status please

exit::	tst	eioini			; /54/ Extended IO init
	beq	10$			; /54/ No
	Call	getprv			; /60/ privs on
	QIOW$S	#SF.SMC,#LUN.AS,#EF.TT,,,,<#eiosav,#$$EIOL>
	Call	drpprv			; /60/ privs off
10$:	tst	assdon			; ever slave the line?
	beq	exits			; no
	call	rstass			; /41/ restore more things now
exits:	mov	exstac	,r0		; /41/ get exit status
	bne	20$			; /41/ something is there to emit
	EXIT$S				; /41/ nothing there, exit w/o status
20$:	asl	r0			; /41/ shift over 4 bits
	asl	r0			; /41/  ...
	asl	r0			; /41/   ...
	asl	r0			; /41/    ... done
	cmp	exstal	,#15.		; /41/ Will command file line number
	blos	30$			; /41/ fit into exit status word ?
	mov	#15.	,exstal		; /41/ No, stuff 15 (10) into it
30$:	bisb	exstal	,r0		; /41/ Set bits in from line number
	EXST$S	r0			; /41/ Exit with status now

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


dskuse::
	mov	@r5	,r0
	copyz	#nogu	,r0
	return

	.save
	.psect	$PDATA	,D
nogu:	.asciz	/Can't do space enquiry for RSX/
	.even
	.restore





	.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
	call	getprv			; /41/ May need privs now
	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)+
	call	drpprv			; /41/ Don't want privs right now
	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
	call	getprv			; /41/ May need privs turned on
	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,,,,<#xon1,#1>
100$:	tst	(sp)+
	unsave	<r2,r1>			; all done
	call	drpprv			; /41/ Don't want privs anymore
	clr	r0			; no errors
	return				; bye

	.save
	.psect	$PDATA	,D
xon1:	.byte	'Q&37,0
	.even
	.restore



	.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



;	Drop/Regain privs for M+ v3 and Micro/Rsx V3 /41/

	.mcall	GIN$S			; /41/ the macro that does such things


drpprv::mov	r1	,-(sp)		; /41/ save a register today
	clr	r1			; /41/ say we want to drop it all
	br	doprv			; /41/ off to common code now

getprv::mov	r1	,-(sp)		; /41/ save a register today
	mov	#-1.,R1			; /60/ set bit 0 to request privs

doprv:	mov	r0	,-(sp)		; /41/ Lets not trash r0 this time
	call	getsys			; /41/ insure that it's not virgin 11M
	cmpb	r0	,#SY$11M	; /41/ old type 11M today ?
	beq	100$			; /41/ yes, do nothing
	tst	proflg			; /41/ Also skip for P/OS
	bne	100$			; /41/ P/OS, then exit
	tst	#GI.SPR			; /41/ if this is not defined then skip
	beq	100$			; /41/ it
	mov	r1	,privon		; /41/ Save priv on/off status
	GIN$S	#GI.SPR,r1		; /41/ Set the privs up/down now
100$:	mov	(sp)+	,r0		; /41/ Restore R0
	mov	(sp)+	,r1		; /41/ pop a register now
	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


	.enabl	lsb

;	Inqpar added /53/

Inqpar::SAVE	<r1>			; Save this one
	clr	-(sp)			; Allocate a buffer
	call	ttpars			; the usual, parse the device name
	bcs	90$			; oops
	ALUN$S	#LUN.CO,r1,r0		; assign the terminal please
	mov	sp	,r1		; Point to it
	movb	#TC.PAR	,(r1)		; Want to know about parity
	QIOW$S	#SF.GMC,#LUN.CO,,,,,<r1,#2>
	bcs	90$			; Oops
	movb	1(r1)	,r0
	mov	sp	,r0		; Assume parity
	tstb	1(r1)			; Is parity set?
	bne	100$			; Yes
90$:	clr	r0			; No parity or directive error
100$:	tst	(sp)+			; Pop buffer
	UNSAVE	<r1>			; Restore this one
	return				; Exit

	GLOBAL	<TC.PAR,LUN.CO>

	.dsabl	lsb



	.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


	.mcall	ALUN$S	,CMKT$S	,MRKT$S	,QIOW$S
 

ttyhan::save    <r1>
	MRKT$S	#EF.TMO,#2,#2,#200$	; /41/ Set a timeout up please
	call	getprv			; get privs			  +SSH
	tst	assdon			; /41/ assign ever done ?
	bne	5$			; /41/ Yes
	call	ttpars			; /41/ No, likely we are on P/OS
	bcs	100$			; /41/ Parse failed (?)
	ALUN$S	#LUN.AS,r1,r0		; /41/ Never assigned, do it now
	QIOW$S	#IO.ATT,#LUN.AS		; /41/ 
5$:	tstb	logstr			; /41/if logoff MESSAGE len > 0	  +SSH
	beq	10$			; /41/no			  +SSH
	strlen	#logstr			; /41/yes, send logout line	  +SSH
	QIOW$S	#IO.WLB,#lun.as,#ef.tt,,,,<#logstr,r0,#53> ;/41/	  +SSH
	MRKT$S	#ef.tt,#2,#2		; wait 2 seconds		  +SSH
	WTSE$S	#ef.tt			; 2 seconds up when ef set	  +SSH
10$:
	QIOW$S  #IO.HNG,#lun.as,#ef.tt,#50,#kbiost	;		  /SSH
	tst	assdon			; /41/ Ever reach ASSDEV ?
	beq	20$			; /41/ No
	QIOW$S	#IO.DET,#lun.as		; /41/ Likely P/OS, so detach NOW
20$:	call	rstass			; restore any old line setting	  +SSH
	CMKT$S	#EF.TMO,#200$		; /41/ Kill the mark time now
        moverr  kbiost  ,r0
	unsave  <r1>
100$:	return


200$:	QIOW$S	#IO.KIL,#LUN.AS		; /41/ We get here on a timeout
	tst	(sp)+			; /41/ Pop EF
	ASTX$S				; /41/ Exit from the AST



carast:	MESSAGE
	MESSAGE	<?Carrier lost>,CR
	ASTX$S


;	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


;	For INQDTR, see same in K11E80.MAC (RSTS/E version)

inqdtr::mov	#-1	,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
;

	.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::call	getprv			; /41/ May need privs turned on
	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>
	call	drpprv			; /41/ Insure privs are turned off
	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>
	call	getprv			; /41/ May need privs turned on
	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$:	movb	setlst(r3),aslxsp+1	; /41/ insert the transmitted speed
	movb	setlst(r3),aslrsp+1	; /41/ insert the received speed also
	mov	#aslspd	,r2		; /41/ pointer to it
	alun$s	r4,r1,r0		; assign the terminal please
	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
	clr	r0			; assume success
	cmpb	kbiost	,#is.suc	; did it work ?
	beq	100$			; yes, exit without error
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
	call	drpprv			; /41/ Don't want privs on now
	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	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(RTM02)
;	beq	10$			; ok				(RTM02)
	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	(RTM02)
	swab	r1			; and make a place for the next
	cmpb	(r3)+	,#'T&137	; Is this possibly "TI:" ?	(RTM02)
	bne	15$			; If NE, no.			(RTM02)
	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: (?)			(RTM02)
;	beq	20$			; yep				(RTM02)
;	cmpb	@r3	,#'T&137	; must be of the format TTnnn:	(RTM02)
;	beq	20$			; ok so far			(RTM02)
;	cmpb	@r3	,#'T!40		; must be of the format TTnnn:	(RTM02)
;	bne	90$			; no				(RTM02)

15$:	cmpb	@r3	,#'A&137	; Is this possibly uppercase ?	(RTM02)
	blo	90$			; If LO, no.			(RTM02)
	cmpb	@r3	,#'Z&137	; Is this really uppercase ?	(RTM02)
	blos	20$			; If LOS, yes.			(RTM02)
	cmpb	@r3	,#'A!40		; Is this possibly lowercase ?	(RTM02)
	blo	90$			; If LO, no.			(RTM02)
	cmpb	@r3	,#'Z!40		; Is this really lowercase ?	(RTM02)
	bhi	90$			; If HI, no.			(RTM02)

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			; if this is a pro/350 we don't
	beq	1$			; have to worry about all these
	clr	r0			; characteristics.
	return				; simply exit
1$:	save	<r1,r2,r3>
	call	rstass			; /41/ restore possible previous set
	call	getprv			; /60/ restore privs again
	call	ttpars
	bcc	5$
	jmp	100$
5$:	mov	r0	,r3		; save the unit number please
	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
	bcc	12$			; If CC, device is assigned.	(RTM02)
	jmp	100$			; Else, report the error.	(RTM02)
12$:	sub	#20	,sp		; Allocate a buffer for glun.	(RTM03)
	mov	sp	,r2		; Set pointer to the buffer.	(RTM03)
	glun$s	#lun.as	,r2		; Get real name of terminal.	(RTM03)
	mov	g.luna(r2),r1		; Copy the device name.		(RTM03)
	movb	g.lunu(r2),r3		; Copy the unit number.		(RTM03)
	mov	g.lucw(r2),r2		; Copy the device char. word.	(BDN53)
	add	#20	,sp		; Pop the glun buffer.		(RTM03)
	bit	#DV.F11!DV.COM!DV.MNT,r2; Insure not disk or tape	(BDN53)
	beq	15$			; Yes				(BDN53)
	movb	#IE.IDU	,@#$DSW		; No, force an error please	(BDN53)
	jmp	100$			; Exit 				(BDN53)
15$:	mov	@r5,r0			; Copy the device name buffer.	(RTM03)
	call	fmtdev			; Format the real device name.	(RTM03)

20$:	clr	r2			; flag if we timed out		(RTM03)
	mrkt$s	#ef.tmo,#2,#2,#asstmo	; give 2 seconds to do this	(RTM03)
	QIOW$S	#io.att,#lun.as,#ef.tt,,#kbiost
	mov	r2	,r0		; did we ever time out
	beq	25$			; no
	jmp	110$			; yes, return busy device
25$:	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,#asvlen> ; /41/ more things
	QIOW$S	#SF.SMC,#lun.as,#ef.tt,,,,<#setass,#astlen> ; /41/ ditto
	Call	drpprv			; /60/ drop privs now
	movb	savrsp+1,aslrsp+1	; /41/ copy to assigned recv speed
	movb	savxsp+1,aslxsp+1	; /41/ copy to assigned xmit speed
	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


rstass:	tst	assdon			; /41/ If line was ever assigned then
	beq	100$			; /41/ we need to reset the prev line
	clr	assdon			; /41/ no longer assigned
	call	getprv			; /41/ insure privs are up
	QIOW$S	#SF.SMC,#lun.as,#ef.tt,,,,<#savass,#asvlen>
	QIOW$S	#IO.DET,#lun.as		; /41/ detach it
	call	drpprv			; /41/ Insure no privs now
100$:	return





	.sbttl	fmtdev - Format the real device name.
;+
;
; fmtdev - Format the real device name.
;
; Inputs:
;	R0 = The output buffer.
;	R1 = The ASCII device name.
;	R3 = The BINARY unit number.
;
; Outputs:
;	All registers are preserved.
;
;-
fmtdev:	save	<r0,r1,r2>		; Save some registers.		(RTM03)
	swab	r1			; Copy 				(RTM03)
	movb	r1,(r0)+		;     the			(RTM03)
	swab	r1			;       device			(RTM03)
	movb	r1,(r0)+		;	    name.		(RTM03)
	mov	r3,r1			; Copy the binary unit number.	(RTM03)
	clr	r2			; Set for zero supression.	(RTM03)
	call	$cbtmg			; Convert it to octal ASCII.	(RTM03)
	movb	#':,(r0)+		; Finish the device name.	(RTM03)
	clrb	(r0)			; And terminate with a null.	(RTM03)
	unsave	<r0,r1,r2>		; Restore the registers.	(RTM03)
	return



	.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

	.save
	.psect	$PDATA	,D
mnthtab:.ascii	/JanFebMarAprMayJunJulAugSepOctNovDec/
	.even
	.restore




	.sbttl	systat	get list of users logged in

sercmd::
systat::
	moverr	#-1	,r0
	return



	.sbttl	dodir	get a reasonable directory printed

	.save
	.psect	dirctx	,rw,d,lcl,rel,con
dirnam:	.blkb	120
dirbuf:	.blkb	120
diridx:	.word	0
dirptr:	.word	dirbuf
dcrlf:	.byte	15,12,0
wild:	.asciz	/*.*;*/
	.even
	.restore

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


dodir::save	<r1,r2,r3,r4>		; /38/ Entirely rewritten
	STRCPY	#dirnam	,@r5		; copy the filespec to save area
	call	dirini			; initialize things
10$:	call	dirnex			; get next entry to display
	bcs	100$			; error, exit please
	.print	#dirbuf			; ok, dump it
	br	10$			; next please
100$:	unsave	<r4,r3,r2,r1>		; exit
	clr	diridx			; clear flag and exit
	return				; bye

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
	



	.sbttl	return next directory entry and init directory

dirini:	clr	diridx			; clear context flag
	mov	#dirbuf	,dirptr		; set pointer up for SDODIR
	clrb	@dirptr			; clear buffer
	return				; thats all folks



dirnex:	movb	defdir	,-(sp)		; anything in DEFDIR ?
	bne	10$			; yes, don't alter it please
	STRCPY	#defdir	,#wild		; nothing, insert *.*;*
10$:	CALLS	lookup	,<#3,#dirnam,#diridx,#dirbuf>
	tst	r0			; successfull?
	bne	20$			; no
	strcat	#dirbuf	,#dcrlf		; yes, append <cr><lf>
	clr	r0			; strcat returns DST addr in r0
	br	100$			; exit
20$:	cmp	r0	,#ER$NMF	; no more files error ?
	bne	90$			; no
	tst	diridx			; ever do anything?
	bne	90$			; yes
	mov	#ER$FNF	,r0		; no, convert to file not found
90$:	sec
100$:	movb	(sp)+	,defdir		; restore DEFDIR
	return
	



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

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



	.save
	.psect	$PDATA	,D
100$:	.asciz	<15><12>/Spawn failure for SYS command/<15><12>
	.even

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

	.restore
	.dsabl	lsb


	.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


login::	mov	4(r5)	,r0
	STRCPY	r0,#nologin
	mov	#1	,r0
	return

	.save
	.psect	$PDATA	,D
nologin:.asciz	#Can't do REMOTE LOGIN for RSX11M/M+ and P/OS#<15><12>
	.even
	.restore




	.sbttl	error MESSAGE text

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	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	dodial for the DIAL command
	.enabl	lsb

;	This is Steve Covey's code for dialing on XT1 or XT2 on the
;	PRO/TMS Telephone Management System. BDN 06-Dec-85 11:00:40
;
; TMS
; TMS for a Telephone Management System (TMS) on a PRO/350
; TMS supports lines XT1: or XT2: under P/OS V2
; TMS
; TMS the DIAL command establishes the phone connection
; TMS assuming that the appropriate SET LINE XTn: and SET SPEED n
; TMS commands have been issued, and that the lun has been assigned
; TMS and attached.
; TMS
; TMS the phone number can consist of the following:
; TMS	digits	to be dialed
; TMS	!	6 second access pause for dial tone
; TMS	!!	40 second access pause for dial tone
; TMS	,	2 second delay
; TMS	#	changes to DTMF if initially pulse mode
; TMS	*ABCD	other valid DTMF codes
; TMS	^	as the first character causes a "hook flash"
; TMS	()- and spaces ignored.  max total number 48 characters


	.mcall	QIOW$S	,alun$s		; TMS 
					; TMS 
ef.rem	= 14.				; TMS 

tmsdia::save	<r1>			; TMS 
	CALLS	ttpars	,<#ttname>	; TMS
	bcs	5$			; TMS 
	alun$s	#lun.ti,r1,r0		; TMS 
	QIOW$S	#io.att,#lun.ti,#ef.rem,,#tmsios ; TMS 
	QIOW$S	#sf.smc,#lun.ti,#ef.rem,,#tmsios,,<#smctms,#smclen> 	; TMS 
	strlen	argbuf			; TMS get length of phone number
	QIOW$S	#io.con,#lun.ti,#ef.rem,,#tmsios,,<argbuf,r0>		; TMS 
	cmpb	tmsios,#is.suc		; TMS did it work?
	beq	10$			; TMS yes
5$:	unsave	<r1>			; TMS 
	MESSAGE	<Unsuccessful call>,cr	; TMS/BDN
	mov	#-1	,r0		; TMS/BDN
	return				; TMS 
10$:	unsave	<r1>			; TMS 
	MESSAGE	<Call complete, type CONNECT to access system>,cr ; TMS/BDN
	clr	r0			; TMS/BDN
	return				; TMS 

	.save
	.psect	$PDATA	,D

tmsios:	.word	0,0		; TMS iosb for tms CALLS
smctms:	.byte	xt.dmd		; TMS set data mode
	.byte	xt.ser		; TMS serial data (not codec, dtmf, or voice)
	.byte	xt.dlm		; TMS set dial mode
	.byte	xt.dtm		; TMS DTMF (not pulse 10 or 20, or off hook)
	.byte	xt.dit		; TMS set DTMF intertone time * 10ms
	.byte	10.		; TMS 100 milliseconds
	.byte	xt.dtt		; TMS set DTMF tone time * 10ms
	.byte	10.		; TMS 100 milliseconds
;	.byte	xt.mtp		; TMS set modem type - should default from speed
;	.byte	xtm.ps		; TMS DPSK - 1200 baud Bell 212
smclen	= . - smctms		; TMS 

	.restore
	.dsabl	lsb



	.sbttl	Look in logical name tables for KERMIT$LINEn


	.mcall	tlog$s	,alun$s	,QIOW$S	,cmkt$s	,astx$s	,mrkt$s


;	TRNTRM(&return_name)		; Added edit /41/
;
;	Passed:	0(r5)	address of where to return first available dev
;	Return:	r0	zero for success, else directive error code.
;
;
;	Look through logical name tables for a free terminal to use. The
;	first translation will be on KERMIT$LINEn, where N is null, then
;	1 though NN. Stop on first translation that has a free terminal,
;	or when we fail on the translation (IE.LNF).  For now, to see if
;	the line is free,  try IO.ATT with a short marktime to abort the
;	attach in case the line is already in use (actually call ASSDEV)
;
;	Added edit /41/ 23-DEC-1985 10:20
;
;	Local copy of TLON$S from M+ v3
;
;	Since I may have to do this on M+ 2.1 or RSTS v9, those RSXMAC's
;	have TLOG$S but not TLON$S.  Thus lets define it here. Note that
;	trying to execute TLON or TLOG on old RSX's won't hurt anything,
;	they will simply return an error.

	.MACRO	TLON$S	MOD,TBMSK,STATUS,LNS,LNSSZ,ENS,ENSSZ,RSIZE,RTBMOD,ERR
	.MCALL	DIR$,MOV$,MVB$,LNMOD$
	LNMOD$
	MOV$	STATUS
	MOV$	RTBMOD
	MOV$	RSIZE
	MOV$	ENSSZ
	MOV$	ENS
	MOV$	LNSSZ
	MOV$	LNS
	MVB$	TBMSK,#0
	MVB$	#13.,MOD
	MOV	(PC)+,-(SP)
	.BYTE	207.,10.
	DIR$	,ERR
	.ENDM	TLON$S


	tr$res	=	0
	tr$nam	=	2
	tr$uni	=	4

trntrm::save	<r1,r2,r3,r4>		; +/41/ save temp registers 
	sub	#10	,sp		; local r/w things
	mov	sp	,r3		; base it off of r3
	sub	#30	,sp		; allocate a result buffer
	mov	sp	,tr$res(r3)	; and a pointer to it
	sub	#30	,sp		; allocate buffer for xlate name
	mov	sp	,tr$nam(r3)	; and a pointer to the buffer
	mov	#-1	,tr$uni(r3)	; 'unit' number counter
	call	getsys			; vanilla RSX 11M today?
	cmpb	r0	,#SY$11M	; well ?
	bne	10$			; no
	jmp	90$			; yes, do nothing at all then

10$:	STRCPY	tr$nam(r3),#ln$nam	; copy the prototype name over
	tst	tr$uni(r3)		; is this the first time through?
	bmi	30$			; yes (ie, it's -1)
	mov	tr$uni(r3),r1		; no, append the 'unit' on logical
	clr	r2			; so we get a name like KERMIT$LINE2
20$:	tstb	(r0)+			; get to the end of the logical
	bne	20$			; not yet
	dec	r0			; r0 --> end of copy of prototype
	call	$cbdmg			; r0 already had address from STRCPY
	clrb	@r0			; insure .asciz
30$:	clr	-(sp)			; allocate buffer for returned_size
	mov	sp	,r1		; and a pointer to it
	clr	-(sp)			; allocate buffer for 'RTBMOD'
	mov	sp	,r2		; and a pointer to it also
	strlen	tr$nam(r3)		; get length of name to translate
	tst	proflg			; is this P/OS today ?
	bne	40$			; yes, use TLOG$S then
	TLON$S	#0,ln$msk,#0,tr$nam(r3),r0,tr$res(r3),#27,r1,r2
	br	50$			;	
40$:	TLOG$S	#0,ln$msk,#0,tr$nam(r3),r0,tr$res(r3),#27,r1,r2
50$:	tst	(sp)+			; ignore the returned table number
	mov	(sp)+	,r1		; get the length of translated string
	cmpb	@#$DSW	,#IS.SUC	; successfull translation ?
	bne	70$			; no
60$:	add	tr$res(r3),r1		; success, make name .asciz
	clrb	@r1			; simple
	CALLS	assdev	,<tr$res(r3)>	; parse and assign the device
	cmpb	r0	,#IE.DAA	; device busy today ?
	beq	80$			; yes, try next logical
	tst	r0			; other errors are fatal
	bne	100$			; exit
	STRCPY	@r5	,tr$res(r3)	; success, return device name
	clr	r0			; success
	br	100$			; exit

70$:	tst	tr$uni(r3)		; translation failure, first time?
	bpl	90$			; no, error is fatal
80$:	inc	tr$uni(r3)		; first time, goto KERMIT$LINE0
	jmp	10$			; next logical name please

90$:	clr	r0			; return an error
	bisb	#IE.IDU	,r0		; return invalid device name
100$:	add	#10+<2*30>,sp		; pop local buffers
	unsave	<r4,r3,r2,r1>		; and pop registers we saved
	return				; -/41/ exit


	.save
	.psect	$idata
ln$nam::.asciz	/KERMIT$LINE/		; prototype logical name
	.even				; always please
ln$msk::.word	0			; may want .word IN.SYS!IN.GRP
	.restore



	.sbttl	dialout line setup routines	;			  /45/


;	From Steve Heflin, 08-Feb-86
;
;	These SET and RESTORE line characteristics for the DIAL command
;	that are special for talking to the modem. These are NOT needed
;	for RSTS/E and RT11,  so thus are return stubbs to  resolve the
;	global symbol references.


tidias::				; Setup line for dialout	  /45/
	call	getprv			; get privledges		  /45/
	cmpb	savdlu+1,tcdlu		; already in dialout mode ?	  /45/
	beq	45$			; yes, no need to change it	  /45/
	tstb	tcdlu			; allowing tc.dlu change?	  /45/
	beq	45$			; no				  /45/
	movb	tcdlu	,fixti2+1 	; adust setting for TC.DLU	  /45/
	dir$	#set.dlu		; issue set			  /45/
45$:	dir$	#set.chars		; set other attribs. for dialout  /45/
	call	drpprv			; drop privs			  /45/
	return				; 				  /45/



tidiar::				; Restore remote line attrib.	  /45/
	call	getprv			; get privledges		  /45/
	cmpb	savdlu+1,fixti2+1	; if TC.DLU param got changed	  /45/
	beq	50$			; no, 				  /45/
	movb	savdlu+1,fixti2+1	; yes, restore it like it was	  /45/
	dir$	#set.dlu		;      issue request		  /45/
50$:	dir$	#rest.chars		; restore remote line attributes  /45/
					; that could have been lost when  /45/
					; carrier was detected		  /45/
	call	drpprv			; drop privs			  /45/
	return				; 				  /45/


	.sbttl	find out kind of terminal

;	INQTER 12-Feb-86  14:51:00 Brian Nelson
;
;	This returns VT100 for all VT1xx and VT2xx terminals.
;	Since we  don't treat VT200's different,  why bother.
;	If TC.ANI is unknown on old RSX's, SF.GMC will simply
;	stop there,  returning only TC.TPP.  For applications
;	that REALLY need to know the terminal type,  take out
;	the check for TC.ANI. Including the TC.ANI helps when
;	Digital adds new VTxxx terminals.

	.enabl	lsb

inqter:	save	<r1,r2>			; /45/ Get the type of terminal
	clr	-(sp)			; /45/ A small buffer to use
	clr	-(sp)			; /45/ Another one
	mov	sp	,r2		; /45/ A pointer to that buffer
	movb	#TC.TTP	,@r2		; /45/ Characteristic to read
	movb	#TC.ANI	,2(r2)		; /45/ Does this one work on old RSXs
	qiow$s	#SF.GMC,#5,,,,,<r2,#4>	; /45/ Get RSX to tell us now
	bcs	90$			; /45/ Failed, return TTY
	tstb	3(r2)			; /45/ See if ANSICRT
	bne	20$			; /45/ YES, exit now with VT100
	mov	#200$	,r1		; /45/ Check for it
10$:	tstb	@r1			; /45/ End of the list
	beq	90$			; /45/ Yes, return TTY
	cmpb	(r1)+	,1(r2)		; /45/ A match ?
	bne	10$			; /45/ No, exit please
20$:	mov	#VT100	,r0		; /45/ Yes, return(VT100)
	br	100$			; /45/ Exit

90$:	clr	r0			; /45/ No match, return(TTY)
100$:	cmp	(sp)+	,(sp)+		; /45/ Pop buffer and exit
	unsave	<r2,r1>			; /45/ Pop registers and exit
	return


;	Note: If the PRO/350 is to actually be used for, say, editing
;	or if it is to use the Kermit-11 connect code's GRAY key  re-
;	mapping, then we should ALWAYS map T.BMP1 to a VT100. This is
;	a problem,  however, as the value of T.BMP1 is the same as it
;	is for T.V2XX. At least, according to the Micro-RSX doc vt2xx
;	code is 35 (8), actual task build shows T.BMP1 to be 35 also.
;	Please note the the PRO is NOT totally compatible with VT2xxs
;	TC.BMP1 is the PRO terminal type (Bit MaPped)

	.save
	.psect	$PDATA	,D
200$:	.byte	T.V100	,T.V101	,T.V102	,T.V105	,T.V125	,T.V131
	.byte	T.V132	,T.BMP1	,T.V2XX
	.byte	0
	.even
	.restore
	.dsabl	lsb


	.end