Google
 

Trailing-Edge - PDP-10 Archives - tops10_integ_tools_v4_10jan-86 - 70,6067/tell10/dotell.mac
There are 4 other files named dotell.mac in the archive. Click here to see a list.
	SEARCH	MACROS,ACTSYM
	$TITLE	DOTELL,<DECnet TELL Command Processor>,MAIN,600000
	SUBTTL	L.E.Snyder 16-Dec-1983

;
;	This program is a passive DECnet task (object 198) that waits
;	for a connect from somewhere. It uses the connect block data to
;	log in a subjob, then reads a line of data from the DECnet connection
;	and sends it to the subjob for execution, returning all output from
;	the subjob to the network link.
;

TELVER==	000000,,000004		;(4)

	LOC	137
	EXP	TELVER
	RELOC

	EXTERN	FAO,PAGFND,SETBUF

COMMENT &

	Edit history

[1]	29-Dec-83	Initial version. Most preliminary bug fixes made
			within the first month or so are included in this.

[2]	07-Mar-84	Correct some timing problems that occurred when the
			state of the DECnet link changed while base level
			was executing its loop. If the link disappeared, it
			was possible for an NSP. UUO to that link to fail if
			it was executed before loop level detected the change
			in the state of the link. Make NSP. UUO read and write
			failures abort the link (TLDUMP).

[3]	24-May-84	Instead of issuing any needed passive connect
			after doing all the loop stuff, check first thing
			after a wake and issue the request immediately.

[4]	27-May-84	There is still a window where no passive connect
			has been issued, so keep two outstanding at all times.
			This shrinks the window to almost nothing.

& ; End comment
	SUBTTL	Internal Equivalences

;
;	Memory allocation for DOTELL.....
;
;	Addresses	Size/K		Purpose
;	000000-377777	128		Impure data storage (not all used)
;	400000-477777	32		Pages for Subjob Data Pages
;					 (created as needed)
;	600000-677777	32		Pure code
;

IFNDEF	FTDBUG,<FTDBUG==0>		;For debugging code
STKSIZ==	500			;Size of the PDL
PAGSIZ==	1000			;Size of a page (fixed, obviously)
SDPBEG==	400			;First page for Subjob Data Pages
SDPMAX==	^D64			;Limited to number of extended I/O chns
					; Note that we have address space 
					;  available for a total of 128 SDP's
TELOBJ==	^D198			;Object type
LGNWAT==	^D60*^D60*^D3		;Number of jiffies to wait for login
					; Give it three minutes for slow systems
MAXTIM==	^D1*^D60*^D60		;Jiffies to wait for job
					; If we can't do it in one minute, it's
					;  too involved to do with TELL!
MAXMIC==	^D10*^D60*^D60		;We'll wait 10 minutes for MIC jobs
					; since they can do lots of things...
CMDWAT==	^D60*^D3		;Wait 3 seconds after LOGIN completes
					; before checking on him
ACTSLP==	^D1000*5		;Five second sleeps when active
					; since sometimes we miss a WAKE
					;  on PTY activity for some reason...
USRCHN==	1			;I/O Channel for USERS.TXT
USRWAT==	^D30*^D60*^D60		;Time to wait between USERS.TXT reads
					; We will update it every 30 minutes
CR==		15			;ASCII value of a carriage return
LF==		12			;ASCII value of a line feed
TAB==		11			;ASCII value of a TAB
CWOUTS==	2			;Keep this many passive connects issued

;
;	Format of a Subjob Data Page (SDP)
;
	PHASE	0
SD.STS:	BLOCK	1			;Status of this network/PTY pair
	SS.ACT==1B0			;Link is active (we have received
					; a connect from a remote process
					; and are doing something with the PTY)
					;NOTE - we do not flag that a passive
					;connect is outstanding, since the very
					;presence of this SDP attests to that.
	SS.LGN==1B1			;We are in the process of logging in
	SS.OUT==1B2			;Output should now go out to the network
	SS.CHG==1B3			;The DECnet state has changed
	SS.PAR==1B4			;Partial buffer output
	SS.ABO==1B5			;We are aborting a link
	SS.BLK==1B6			;A blank line was sent last
	SS.INT==1B7			;We are processing internal commands
	SS.STA==77B35			;Current state of link
SD.LNK:	BLOCK	1			;Pointer to next SDP
SD.TIM:	BLOCK	1			;For timing operations
SD.PPN:	BLOCK	1			;Remember PPN here
SD.PTR:	BLOCK	1			;Pointer for output data
SD.CTR:	BLOCK	1			;Counter for output data
SD.CHR:	BLOCK	1			;Hold character here
SD.FLP:	BLOCK	.FONBF+1		;Block for FILOP OPEN of PTY
					;(Later converted to OUT argument)
SD.IBF:	BLOCK	.BFCTR+1		;Input buffer ring header for PTY
SD.OBF:	BLOCK	.BFCTR+1		;Output buffer ring header for PTY
SD.NSP:	BLOCK	.NSAA3+1		;Arg block for NSP. UUO
SD.CBK:	BLOCK	.NSCUD+1		;Connect block for DECnet
SD.CND:	BLOCK	1+<6/4>+1		;String block for node name
SD.CDD:	BLOCK	.NSDPN+1		;Process pointer for destination
SD.CUS:	BLOCK	1+<^D39/4>+1		;String block for user ID
SD.CPW:	BLOCK	1+<^D39/4>+1		;Ditto for password
SD.CAC:	BLOCK	1+<^D39/4>+1		;Ditto for Account string
SD.CUD:	BLOCK	1+<^D16/4>+1		;Ditto for user data
	PAGBFS==PAGSIZ-.		;Rest of page is buffers....
	NSPBFS==<PAGBFS/2>		;Half of that is for DECnet...
	PTYBFS==<<PAGBFS/2>/2>		;Half of other half is for PTY
SD.NBF:	BLOCK	NSPBFS			;Half is for DECnet...
SD.IPT:	BLOCK	PTYBFS			;Half of other half is PTY input
SD.OPT:	BLOCK	PTYBFS			;Other half of this half is for PTY output
	DEPHASE				;Back to wherever...

;
;	The macro to tell the operator when something has gone wrong
;
DEFINE	TELOPR (STRING),<
	PUSHJ	SP,@[OPRTYP		;Go here
		     [ASCIZ	~STRING~]];String is here
>;End TELOPR
	SUBTTL	Low Segment Stuff

	RELOCL			;Go to low seg
LOWBEG==.
STACK:	BLOCK	STKSIZ		;The stack
FIRST:	BLOCK	1		;Address of first SDP
CONTOT:	BLOCK	1		;Count of connects so far
MYJOB:	BLOCK	1		;My job number
VECTOR:	BLOCK	.PSVIS+1	;Vector block
QUEBLK:	BLOCK	12		;Block for QUEUE UUO
RSPBLK:	BLOCK	20		;Response block
TRMBLK:	BLOCK	3		;For TRMOPs
	OPRLIN==TRMBLK+1
CURSDP:	BLOCK	1		;Current SDP
USRBUF:	BLOCK	1		;Address of where USERS.TXT stuff is kept
USRSIZ:	BLOCK	1		;Size of USERS.TXT file
USRTIM:	BLOCK	1		;System uptime in jiffies when USERS.TXT
				; was last read...
STRDTM:	BLOCK	<^D18/5>+1	;ASCII date/time of startup
LOWEND==.-1
	SUBTTL	Back To High Segment

	RELOCH
;
;	Prototype QUEUE block for password validation
;
PROQUE:
	QF.RSP!.QUMAE		;Function, we want response
	0			;Reserved
	20,,RSPBLK		;Size and address of response block
	QA.IMM!1B17!.QBAFN	;Want to talk to ACTDAE
	UGACC$			;Tell that to the system
	QA.IMM!1B17!.UGTYP	;We want verification
	UG.VER			;Tell that to the system
	QA.IMM!1B17!.UGPPN	;Now for PPN
QPPNOF==.-PROQUE
	0			;PPN goes here
	QA.IMM!1B17!.UGPSW	;For password
QPSWOF==.-PROQUE
	0			;Password goes here
QUELEN==.-PROQUE
;
;	Table of month names
;
DEFINE	M(STRING),<
	POINT 7,[ASCIZ ~STRING~]
>;End define M
MONTAB:
	M	<-Jan->
	M	<-Feb->
	M	<-Mar->
	M	<-Apr->
	M	<-May->
	M	<-Jun->
	M	<-Jul->
	M	<-Aug->
	M	<-Sep->
	M	<-Oct->
	M	<-Nov->
	M	<-Dec->
	SUBTTL	Here For Character Output from FAO
	ENTRY	PUTCHR

;
;	The Formatted Ascii Output routines (FAO) call PUTCHR to
;	actually put the translated character to wherever it should
;	go, be that the terminal or elsewhere. Our version of PUTCHR
;	will merely type the character on the controlling terminal if
;	the location CURSDP is zero. If CURSDP is non-zero, it is assumed
;	to be the address of an SDP that has a PTY open and ready to go,
;	and PUTCHR will send the character down to the PTY, not to the
;	controlling terminal.
;
$ENTRY	PUTCHR,<%GARB,%CHAR>
	MOVE	T1,@%CHAR		;Get character from FAO
	SKIPN	R7,CURSDP		;Get current SDP address, if any
	JRST	[OUTCHR	T1		;No SDP, just type it
		 $RETRN]		;And return
	PUSHJ	SP,PTYOUT		;Output it to PTY
	$RETRN				;All done!
	SUBTTL	Startup Code

START:
	JFCL				;CCL entry is meaningless
	RESET				;Clear the world
	MOVE	SP,[IOWD STKSIZ,STACK]	;Set up the PDL
	MOVE	PF,SP			;Set up previous frame pointer
	MOVE	CF,SP			;Set up current frame pointer
	MOVE	CG,SP			;Set up current global pointer
	PUSH	SP,[SIXBIT /.MAIN./]	;Remember name of this
	$CALL	DOTELL			;Call the main routine
	MONRT.				;Stop nice
	EXIT				;Then for real
	SUBTTL	DOTELL - The Main Code

$ENTRY	DOTELL

;
;	First, clear out the low seg stuff
;
	SETZM	LOWBEG			;Clear out low segment
	MOVE	T1,[LOWBEG,,LOWBEG+1]	;...
	BLT	T1,LOWEND-1		;Bye bye data!
;
;	Now fix up an ASCIZ string of when we started
;
	TIMER	R1,			;Get time of day
	DATE	R7,			;Get date
	IDIVI	R1,^D60			;Make into seconds
	IDIVI	R1,^D60			;Make into minutes, remainder is seconds
	MOVE	R3,R2			;Copy seconds into R3
	IDIVI	R1,^D60			;R1 is hours, R2 mins, R3 secs
	MOVE	R6,[POINT 7,STRDTM]	;Make pointer to date/time string
	PUSHJ	SP,DECTWO		;Put in hours
	MOVEI	T1,":"			;Get a colon
	IDPB	T1,R6			;Store
	MOVE	R1,R2			;Get minutes
	PUSHJ	SP,DECTWO		;Store
	MOVEI	T1,":"
	IDPB	T1,R6			;Store a colon
	MOVE	R1,R3			;Get seconds
	PUSHJ	SP,DECTWO		;Store
	MOVEI	T1," "			;Get a space
	IDPB	T1,R6			;Store
	MOVE	R1,R7			;Get date
	IDIVI	R1,^D31			;Divide by days per month
	MOVEI	R4,1(R2)		;Get date
	IDIVI	R1,^D12			;Divide by months per year
	MOVEI	R3,^D64(R1)		;Store year here
	MOVE	R1,R4			;Get date
	PUSHJ	SP,DECTWO		;Store
	MOVE	R2,MONTAB(R2)		;Get month name
MONCOP:
	ILDB	T1,R2			;Get a byte
	JUMPE	T1,MONDON		;Done
	IDPB	T1,R6
	JRST	MONCOP			;Do for all
MONDON:
	MOVE	R1,R3			;Get year
	PUSHJ	SP,DECTWO		;Store
	MOVEI	T1,0			;End with a null
	IDPB	T1,R6			;...
;
;	Now set up USERS.TXT...
;
	$CALL	SETUSR			;Read in USERS.TXT
;
;	Now set up the PSI system
;
	MOVEI	T1,VECTOR		;Get address of vector block
	PIINI.	T1,			;And do it
	 JRST	PIIFLD			;Very fatal - no such animal!
	MOVEI	T1,NSPINT		;Get address of interrupt routine
	MOVEM	T1,.PSVNP+VECTOR	;Store here
	MOVX	R1,.PCNSP		;Get reason code
	SETZB	R2,R3			;Nothing here
	MOVX	T1,PS.FON+PS.FAC+R1	;Set up for the call
	PISYS.	T1,			;Do it
	 JRST	PSYFLD			;Hiss
	PJOB	T1,			;Get my job number
	MOVEM	T1,MYJOB		;Store for later...
IFE	FTDBUG,< ;If not debugging, use OPR for messages and detach
	MOVX	T1,%CNOPR		;Get name of OPR terminal
	GETTAB	T1,			;...
	 $ERROR				;Cannot happen
	IONDX.	T1,			;Get this
	 $ERROR				;Also can't happen
	MOVEM	T1,OPRLIN		;Remember here for messages to OPR
	OUTSTR	[ASCIZ	/
[DTLDET - DOTELL detaching]

./]
	HRROI	T1,0			;Bye bye
	ATTACH	T1,			;...
	 OUTSTR	[ASCIZ	/
?DTLCDT - Could not DETACH from terminal
/]
>;End IFE FTDBUG
IFN	FTDBUG,< ;If debugging, use my terminal for msgs and don't detach
	SETO	T1,			;Get my line
	TRMNO.	T1,			;...
	 $ERROR				;Can't happen
	MOVEM	T1,OPRLIN		;Store
	OUTSTR	[ASCIZ	/
[DOTELL initialized]
/]
	TELOPR	<Test of error reporting code>
>;End IFN FTDBUG
	SUBTTL	The Main Loop...

;
;	In this loop we scan through the SDP's, looking for something to
;	do. When done, we HIBER, waiting for a WAKE, either from an NSP
;	interrupt or PTY activity.
;
;	We are looking for a state change on a line. If the DECnet state
;	has changed, we dispatch to the correct routine to handle it. If
;	the state hasn't changed and we are active, check to see if the PTY
;	has typed something to be sent over the network, or see if it's time
;	to log the subjob off and close down the connection.
;
;	Since the activities performed in this loop can cause the link which
;	was previous idle, waiting for a connect, to go active, we also check
;	for and remember if there is a link in CW state. If there is no connect
;	wait outstanding after we have been through the loop we create a new
;	SDP and issue a passive connect request.
;
;[3]	Since any activities done in this loop cannot cause an active
;	link to go idle, let's check RIGHT NOW and issue a passive request
;	so the window when we don't have one issued is as small as
;	possible...
;
TLLOOP:
	SETZ	R6,			;Clear a counter
	SKIPN	R7,FIRST		;Get address of first SDP, if any
	 JRST	NEWONE			;None, go make one
TLLCHI:
	LDB	T1,[POINT 6,SD.STS(R7),35];Get state of the link
	CAIN	T1,.NSSCW		;In connect wait state?
	ADDI	R6,1			;Yes, count it
	SKIPE	R7,SD.LNK(R7)		;Get next SDP addr, if any
	JRST	TLLCHI			;Got one, go on
	CAIGE	R6,CWOUTS		;Do we have enough issued?
	JRST	NEWONE			;No, go do it
	SETZ	R6,			;We'll set this to # idle links
	SKIPN	R7,FIRST		;Get address of first SDP
	 JRST	NEWONE			;None, so this is first time through
					; Go create an SDP and enter passive
TLOOP1:
	MOVX	T1,SS.CHG		;Get the "state has changed" bit...
	TDNN	T1,SD.STS(R7)		;Has the state changed?
					; (Interrupt level sets this bit)
	JRST	TLCPTY			;No, check out PTY activity
	ANDCAM	T1,SD.STS(R7)		;Clear the bit...
	LDB	T1,[POINT 6,SD.STS(R7),35];Get state of the link
IFN	FTDBUG,<
	MOVE	R5,T1			;Copy the state code
	$CALL	FAO,<<[ASCIZ "!/[State for SDP !O changed to !O]!/"]>,R7,R5>
	MOVE	T1,R5			;Get state back
>;End IFN FTDBUG
	CAIN	T1,.NSSCW		;Still connect wait?
	JRST	TLCPTY			;Yes, ignore the interrupt
	CAIN	T1,.NSSCR		;Have we received a connect request?
	JRST	TLCONN			;Yes, go process...
	CAIN	T1,.NSSRN		;Do we have a running link now?
	JRST	TLLRUN			;Yes, go handle that
	CAIN	T1,.NSSDS		;Have we sent a disconnect?
	JRST	TLNEXT			;Yes, ignore it, wait for confirm
	CAIN	T1,.NSSDC		;Disconnect confirmed?
	JRST	TLDISC			;Yes, clean up the mess
;
;	If any other state, we are confused, give up
;
	JRST	TLDUMP			;Kill the whole thing
;
;	We come here from lotsa places - here we pick next SDP, if any
;	 and do it all again.
;
TLNEXT:
	LDB	T1,[POINT 6,SD.STS(R7),35];Get state of this link
	CAIN	T1,.NSSCW		;Connect wait?
	ADDI	R6,1			;Yes, remember that
	SKIPE	R7,SD.LNK(R7)		;Get next one...
	JRST	TLOOP1			;And go on
	CAIL	R6,CWOUTS		;Do we have enough idle links?
	JRST	TLHIBR			;Yes, go to sleep
;
;	Here when we don't have enough passive connects request outstanding.
;	We will always keep CWOUTS out there, so we should always be ready
;	to talk to a remote system.
;
NEWONE:
	MOVEI	R1,SDPBEG		;Get first page for SDP's
	MOVEI	R2,SDPBEG+SDPMAX-1	;Get last valid page for them
	$CALL	PAGFND,<R1,R2,<[1]>,R7>	;Get a page of memory for SDP
	JUMPN	RS,[TELOPR	<%DTLSLE - No SDP's left>
		    JRST	TLHIBR]	;Go and sleep
;
;	Now we have the page, set everything up
;
	LSH	R7,^D9			;Convert into an address
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[New SDP created at !O]!/"]>,R7>
>;End IFN FTDBUG
;
;	Set up arg block for NSP. UUO
;
	MOVEI	T1,SD.CBK(R7)		;Get address of connect block
	MOVEM	T1,SD.NSP+.NSAA1(R7)	;Place here
	MOVE	T1,[.NSFEP,,.NSAA1+1]	;Get function,,length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store here
;
;	Set up the connect block
;
	MOVEI	T1,.NSCUD+1		;Get size of a connect block
	MOVEM	T1,SD.CBK+.NSCNL(R7)	;Store in connect block
	MOVEI	T1,SD.CND(R7)		;Get address of node name block
	MOVEM	T1,SD.CBK+.NSCND(R7)	;Store in connect block
	SETZM	SD.CBK+.NSCSD(R7)	;No need for source process block
	MOVEI	T1,SD.CDD(R7)		;Get address of destination process blk
	MOVEM	T1,SD.CBK+.NSCDD(R7)	;Store in connect block
	MOVEI	T1,SD.CUS(R7)		;Get user ID block address
	MOVEM	T1,SD.CBK+.NSCUS(R7)	;Store in connect block
	MOVEI	T1,SD.CPW(R7)		;Get address of password block
	MOVEM	T1,SD.CBK+.NSCPW(R7)	;Store in connect block
	MOVEI	T1,SD.CAC(R7)		;Get address of account block
	MOVEM	T1,SD.CBK+.NSCAC(R7)	;Store in connect block
	MOVEI	T1,SD.CUD(R7)		;Get user data address
	MOVEM	T1,SD.CBK+.NSCUD(R7)	;Store in connect block
;
;	Set up sizes of string blocks
;
	MOVEI	T1,1+<6/4>+1		;Get size of string block for node name
	MOVEM	T1,SD.CND(R7)		;Store here
	MOVEI	T1,1+<^D39/4>+1		;Max bytes for three fields
	MOVEM	T1,SD.CUS(R7)		;Store in user ID field
	MOVEM	T1,SD.CPW(R7)		;Password field
	MOVEM	T1,SD.CAC(R7)		;And account string field
	MOVEI	T1,1+<^D16/4>+1		;Max bytes for user data
	MOVEM	T1,SD.CUD(R7)		;Store in string
;
;	Now the destination process block (which is us)
;
	MOVEI	T1,.NSDPN+1		;Size of the block
	MOVEM	T1,SD.CDD+.NSDFL(R7)	;Store in process block
	MOVEI	T1,0			;Format type of 0 (no mnemonic defined!)
	MOVEM	T1,SD.CDD+.NSDFM(R7)	;Store in block
	MOVEI	T1,TELOBJ		;Get object type
	MOVEM	T1,SD.CDD+.NSDOB(R7)	;Store in object type field
	SETZM	SD.CDD+.NSDPP(R7)	;Make sure PPN field is clear
	SETZM	SD.CDD+.NSDPN(R7)	;And process name, too
;
;	Now do the enter passive
;
	MOVEI	T1,SD.NSP(R7)		;Get address of the block for the UUO
	NSP.	T1,			; ++ ENTER PASSIVE
	 JSP	T2,NSPFLD		;Failed!
	SKIPN	R5,FIRST		;Get first one (if any)
	 JRST	[MOVEM	R7,FIRST	;No first, so this isi t!
		 JRST	TLHIB0]		;And go on
TLFNDL:
	MOVE	R4,R5			;Copy address
	SKIPE	R5,SD.LNK(R5)		;Get next one (if any)
	JRST	TLFNDL			;There is, move along
	MOVEM	R7,SD.LNK(R4)		;Store it for later reference
TLHIB0:
	MOVE	T1,[.NSFPI,,.NSAA1+1]	;Get function code, length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store in arg block
	MOVEI	T1,-1			;Set all reason bits
	MOVEM	T1,SD.NSP+.NSAA1(R7)	;Store
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ SET PSI REASON MASK
	 JSP	T2,NSPFLD		;Whoa!
TLHIBR:
	SETZ	T1,			;Assume infinite hiber...
	SKIPN	R7,FIRST		;Get first SDP address..
	JRST	TLHIB2			;None go to sleep
	MOVX	T2,SS.ACT		;Get active bit
TLHIB1:
	TDNE	T2,SD.STS(R7)		;Is this one active?
	JRST	[MOVX	T1,ACTSLP	;Yes, get sleep time for active
		 JRST	TLHIB2]		;And go on
	SKIPE	R7,SD.LNK(R7)		;Get next one, if any
	JRST	TLHIB1			;Loop on
TLHIB2:
	TXO	T1,HB.RPT!HB.RWJ	;Wake on PTY activity, only me
	HIBER	T1,			;Snxxkxx
	 $ERROR				;Horrible!
	$CALL	SETUSR			;Reread USERS.TXT if necessary
	JRST	TLLOOP			;Do it all again!
TLCPTY:
	MOVX	T1,SS.ACT		;Get active bit
	TDNN	T1,SD.STS(R7)		;Is this link active?
	JRST	TLNEXT			;No, go on
	LDB	T1,[POINT 6,SD.STS(R7),35];Get state of link
	CAIE	T1,.NSSDS		;Disconnect sent?
	CAIN	T1,.NSSDC		;Or confirmed?
	JRST	TLNEXT			;Yes, forget it
	HLRZ	T1,SD.FLP+.FOFNC(R7)	;Get channel number for PTY
	ANDI	T1,777			;Make reasonable!
	JOBSTS	T1,			;Check it out
	 JRST	TLGONE			;Job has disappeared
	MOVX	T2,SS.LGN		;Are we logging in?
	TDNN	T2,SD.STS(R7)		;???
	JRST	NOTLGI			;No, go on
	TXNE	T1,JB.ULI		;Is job logged in?
	JRST	TLCPLI			;Yes, go on
	MOVE	T2,SD.TIM(R7)		;Get time LOGIN started...
	MOVX	T1,%CVUPT		;Get uptime
	GETTAB	T1,			;...
	 $ERROR				;Cannot happen
	SUB	T1,T2			;Get difference
	CAML	T1,[LGNWAT]		;Have we waited long enough?
	 JRST	TLDUMP			;Yes, dump it
	PUSHJ	SP,CLRPTI		;Clear input buffer
	JRST	TLNEXT			;And go on
TLCPLI:
	TXNE	T1,JB.UDI		;Waiting for something?
	JRST	TLCPMN			;Yes, go on
	PUSHJ	SP,CLRPTI		;Clear input buffer
	JRST	TLNEXT			;And go on
TLCPMN:
	MOVEI	T1,"C"-100		;Get a control-C
	PUSHJ	SP,PTYOUT		;Output some
	PUSHJ	SP,PTYOUT		; to force the job
;	PUSHJ	SP,PTYOUT		;  to monitor level
	PUSHJ	SP,PTYFLS		;Flush it
	MOVX	T1,SS.LGN		;Get logging in bit
	ANDCAM	T1,SD.STS(R7)		;Clear it
	MOVX	T1,SS.OUT		;Get output bit
	IORM	T1,SD.STS(R7)		;And set it
;
;	We are now logged in and ready...
;	Read the data from the remote node and shoot it down to the PTY
;
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Subjob for SDP !O now logged in]!/"]>,R7>
>;End IFN FTDBUG
DOREAD:
	MOVE	T1,[.NSFDR,,.NSAA2+1]	;Set up function,,length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Put it in NSP block
	MOVEI	T1,<NSPBFS*5>		;Get max bytes we can handle
	MOVEM	T1,SD.NSP+.NSAA1(R7)	;Store in NSP block
	MOVEI	T1,SD.NBF(R7)		;Get buffer address
	HRLI	T1,(POINT 7,0)		;Convert into ASCII pointer
	MOVEM	T1,SD.NSP+.NSAA2(R7)	;Store in block
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ RECEIVE NORMAL DATA
	 JRST	 TLDUMP			;Oops, link disappeared!
	MOVEI	R1,<NSPBFS*5>		;Get bytes in buffer
	SUB	R1,SD.NSP+.NSAA1(R7)	;Minues bytes left....
	JUMPE	R1,NOBYTE		;None, check this out!
	MOVEI	R2,SD.NBF(R7)		;Get address of buffer
	HRLI	R2,(POINT 7,0)		;Make into a pointer
	SETZB	R4,R5			;Clear some flags
SNDCHR:
	ILDB	T1,R2			;Get a byte
	JUMPE	T1,SNDCHR		;Ignore nulls
	CAIN	T1," "			;Space?
	JUMPE	R5,SNDCH1		;Still leading spaces...
	SETO	R5,			;Non-space seen
	CAIGE	T1," "
	SETO	R4,			;Flag control char seen
	PUSHJ	SP,PTYOUT		;Output it
SNDCH1:
	SOJG	R1,SNDCHR		;Loop for all
	JUMPN	R4,NOBYTE		;OK, go on
	MOVEI	T1,CR			;Get a CR
	PUSHJ	SP,PTYOUT		;Output it
	MOVEI	T1,LF			;and a line feed
	PUSHJ	SP,PTYOUT		;output it
	PUSHJ	SP,PTYFLS		;Flush it
NOBYTE:
	MOVE	T1,SD.NSP+.NSAFN(R7)	;Get flags word
	TXNN	T1,NS.EOM		;End of message?
	JRST	DOREAD			;No, go on
	MOVX	T1,%CVUPT		;Get uptime
	GETTAB	T1,			;...
	 $ERROR				;No can happen
	MOVEM	T1,SD.TIM(R7)		;Store as time we waited for output
	MOVEI	T1,SD.NBF(R7)		;Get buffer address
	HRLI	T1,(POINT 7,0)		;Make into byte pointer
	MOVEM	T1,SD.PTR(R7)		;Store
	MOVEI	T1,NSPBFS*5		;Get number of bytes allowed
	MOVEM	T1,SD.CTR(R7)		;Store
	JRST	TLNEXT			;And move along, move along
NOTLGI:
	PUSH	SP,T1			;Preserve JOBSTS info
	PUSHJ	SP,PTYCPY		;Copy stuff into output buffer
	 JRST	TLDUMP			;Oops, link disappeared!
	MOVX	T1,%CVUPT		;Get uptime
	GETTAB	T1,			;...
	 $ERROR				;Can't happen
	SUB	T1,SD.TIM(R7)		;Count how long since LOGIN completed
	CAIG	T1,CMDWAT		;Long enough to start checking on him?
	JRST	[POP	SP,T1		;Restore this
		 JRST	TLNEXT]		;And go on
	POP	SP,T1			;Get these bits back
	TXNN	T1,JB.UML		;At monitor level?
	JRST	TLTIME			;No, see if we've done enough!
;
;	Job is at monitor, check MIC status
;
	LDB	R2,[POINT 9,T1,35]	;Get job number
	TRMNO.	R2,			;Get TTY UDX for that job
	 JRST	TLDONE			;OK, kill it
	MOVX	R1,.TOGMS		;Get MIC status word
	MOVE	T2,[2,,R1]		;Set it up
	TRMOP.	T2,			;Get it
	 JRST	TLDONE			;Not under MIC control - go on
;	JRST	TLTIME			;MIC owns us - wait a while
TLTIME:
	MOVX	T2,%CVUPT		;Reget uptime
	GETTAB	T2,			;...
	 $ERROR				;No can happen
	SUB	T2,SD.TIM(R7)		;How long since LOGIN completed?
	CAIGE	T2,MAXTIM		;Too much time?
	JRST	TLNEXT			;No, go on
	LDB	R2,[POINT 9,T1,35]	;Get job number
	TRMNO.	R2,			;Get its UDX
	 JRST	TLDONE			;None, skip it
	MOVX	R1,.TOGMS		;Get MIC status
	MOVE	T2,[2,,R1]		;Prepare for UUO
	TRMOP.	T2,			;Get MIC status...
	 JRST	TLDONE			;MIC doesn't own us - quit now
	MOVX	T2,%CVUPT		;Reget uptime counter
	GETTAB	T2,			;...
	 $ERROR				;Impossible!
	SUB	T2,SD.TIM(R7)		;Compute jiffies since LOGIN completed..
	CAIGE	T2,MAXMIC		;Max time for MIC jobs up?
	 JRST	TLNEXT			;No, let 'er run
TLDONE:
	HLRZ	T1,SD.FLP+.FOFNC(R7)	;Get channel
	ANDI	T1,777			;Make reasonable
	JOBSTS	T1,			;Check it out
	 SETZ	T1,			;Clear on error
	MOVX	T2,SS.PAR		;Get partial buffer to go bit
	TDNN	T2,SD.STS(R7)		;If there is still some stuff...
	TXNE	T1,JB.UOA		; or if the PTY still has output...
	 CAIA				;  move along and continue outputting
	JRST	TLABOR			;Otherwise, stop all this stuff
	PUSHJ	SP,PTYCPY		;Just in case there's any left
	 JRST	TLDUMP			;Oops, link went away!
	JRST	TLNEXT			;And go on
TLABOR:
	MOVX	T1,SS.ACT		;Get active bit
	TDNN	T1,SD.STS(R7)		;Quitting before we started?
	JRST	TLDISC			;Yes, punt the whole thing
	PUSHJ	SP,CLRPTI		;Flush this stuff
	MOVEI	T1,"C"-100		;Get a control-C
	PUSHJ	SP,PTYOUT		;Output one
	PUSHJ	SP,PTYOUT		;..,.two
	PUSHJ	SP,PTYOUT		;...and three for safety
	PUSHJ	SP,PTYFLS		;Flush it
	MOVEM	R7,CURSDP
	$CALL	FAO,<<[ASCIZ	"K/N!/"]>>
	SETZM	CURSDP
	PUSHJ	SP,PTYFLS		;Flush that
KNWAIT:
	HLRZ	T1,SD.FLP+.FOFNC(R7)	;Get channel...
	JOBSTS	T1,			;Get its status
	 JRST	TLGONE			;Job has gone away
	TXNN	T1,JB.ULI		;Is job still logged in?
	 JRST	TLGONE			;Not logged in, went bye bye
	MOVEI	T1,1			;Wait a second
	SLEEP	T1,			;...
	JRST	KNWAIT			;Loop on
TLGONE:
	MOVX	T1,SS.ACT!SS.OUT	;Get active and output bits
	ANDCAM	T1,SD.STS(R7)		;Clear 'em so we don't try again
	MOVEI	T1,.FOCLS		;Get close function
	HRRM	T1,SD.FLP+.FOFNC(R7)	;Store
	MOVEI	T1,SD.FLP(R7)		;Get address of block
	HRLI	T1,1			;Just one word
	FILOP.	T1,			;Do it!
	 JFCL				;Ho hum
	MOVEI	T1,.FOREL		;Get RELEASE function
	HRRM	T1,SD.FLP+.FOFNC(R7)	;Store here
	MOVEI	T1,SD.FLP(R7)		;Get address of block
	HRLI	T1,1			;Size of it
	FILOP.	T1,			;Do it
	 $ERROR				;This MUST work!
	MOVX	T1,SS.ABO		;Did we abort this guy?
	TDNE	T1,SD.STS(R7)		;???
	JRST	TLDISC			;Yes, skip this
TLLFIN:
	MOVE	T1,[.NSFSD,,.NSACH+1]	;Get function,,length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store in NSP. block
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ SYNCHRONOUS DISCONNECT
	 JRST	TLDUMP			;Oops, failed, abort if possible
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Subjob for SDP !O logged out]!/"]>,R7>
>;End IFN FTDBUG
	JRST	TLNEXT			;Wait for next one
	SUBTTL	TLCONN - Here When Connect Is Received

;
;	Here when he receive a connect request. Get the user ID and
;	password from the connect data and verify them by calling
;	the accounting daemon. If they're OK, accept the connect.
;	If not, reject it.
;
TLCONN:
	MOVE	T1,[.NSFRI,,.NSAA1+1]	;Get function,,size
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Put it in NSP block
	MOVEI	T1,SD.CBK(R7)		;Get address of connect block
	MOVEM	T1,SD.NSP+.NSAA1(R7)	;Store
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ READ CONNECT DATA
	 JRST	TLDUMP			;Failed, link must have disappeared
	HLRZ	R3,SD.CUS(R7)		;Get length of User-ID
	JUMPE	R3,TLCREJ		;Boo, reject it!
	MOVE	T1,[PROQUE,,QUEBLK]	;Set up prototype block
	BLT	T1,QUEBLK+QUELEN-1	;Copy it
	MOVEI	R2,SD.CUS+1(R7)		;Point to the data
	HRLI	R2,(POINT 8,0)		;Make into a pointer
	$CALL	CHKINT,<R2,R3>		;See if special user name
	JUMPE	RS,[	SETZ	R6,	;No PPN
			MOVX	T1,SS.INT;Get special interal bit
			IORM	T1,SD.STS(R7);Set it
			JRST	TLCN5A]	;And go on
	$CALL	CHKUSR,<R2,R3,R6>	;See if it's in USERS.TXT
	 JUMPE	RS,TLCN5A		;It is, use THAT PPN
	SETZB	R5,R6			;Put current number in R5, PPN in R6
TLCON2:
	SOJL	R3,TLCON5		;Done here
	ILDB	T1,R2			;Get a byte
	ANDI	T1,177			;Just seven bits
	CAIN	T1,"["			;Open bracket?
	JRST	TLCON2			;Yes, ignore it
	CAIE	T1,","			;Comma?
	CAIN	T1,"/"			;Or slash?
	JRST	TLCON4			;Yes, go on
	CAIL	T1,"0"			;Legal octal digit?
	CAILE	T1,"7"			;???
	 JRST	TLCREJ			;Reject the connect
	SUBI	T1,"0"			;Make binary
	IMULI	R5,10			;Up this
	ADD	R5,T1			;Get this
	JRST	TLCON2			;Go on
TLCON4:
	HRLZ	R6,R5			;Copy Proj number
	SETZ	R5,			;And get ready for programmer
TLCN4A:
	SOJL	R3,TLCON5		;Done
	ILDB	T1,R2			;Get a byte
	ANDI	T1,177			;Getjust seven bits
	CAIN	T1,"]"			;End?
	JRST	TLCON5			;Yes
	CAIL	T1,"0"			;Legal
	CAILE	T1,"7"			;???
	 JRST	TLCON5			;Yes, end it
	SUBI	T1,"0"			;make binary
	IMULI	R5,10			;Times radix
	ADD	R5,T1			;Getthis
	JRST	TLCN4A			;and go on
TLCON5:
	HRR	R6,R5			;Get programmer
TLCN5A:
	MOVEM	R6,QUEBLK+QPPNOF	;Store
	MOVEM	R6,SD.PPN(R7)		;Save here, too
	SETZ	R6,			;Clear this
	MOVE	R5,[POINT 6,R6]		;Point to it
	HLRZ	R3,SD.CPW(R7)		;Get length of password string
	MOVEI	R2,SD.CPW+1(R7)		;Point to the data
	HRLI	R2,(POINT 8,0)		;Make into byte pointer
TLCON6:
	SOJL	R3,TLCON7		;Done here
	ILDB	T1,R2			;Get a byte
	ANDI	T1,177			;Make seven bits
	CAIL	T1,"a"			;Upper case?
	SUBI	T1,40			;No, make it
	SUBI	T1,40			;make sixbit
	TRNN	R6,77			;Don't overfill
	IDPB	T1,R5			;Store
	JRST	TLCON6			;Loop on
TLCON7:
	MOVX	T1,SS.INT		;Get interal bit
	TDNN	T1,SD.STS(R7)		;Set?
	JRST	TLCN7A			;No, go on
	CAME	R6,[SIXBIT /INTERN/]	;Correct password?
	JRST	TLCREJ			;No, forget it
	JRST	SKPQUU			;Go on, forget verification
TLCN7A:
	PUSHJ	SP,ENCODE		;Encode that password
	MOVEM	R6,QUEBLK+QPSWOF	;Store
	CAMN	R6,[430101,,063361]	;Special bizarre value?
	JRST	SKPQUU			;Yes, skip this part
	MOVE	T1,[QUELEN,,QUEBLK]	;Get length,,blck address
	QUEUE.	T1,			;Find out if all is well
	 JRST	TLCREJ			;Nope, reject the request
SKPQUU:
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Connect for SDP !O accepted]!/"]>,R7>
>;End IFN FTDBUG
;
;	Here we have verified the user-ID and password, accept the
;	connect request
;
	MOVE	T1,[.NSFAC,,.NSACH+1]	;Function,,length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store it
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ ACCEPT CONNECT
	 JRST	TLDUMP			;Oops, done already!
	JRST	TLNEXT			;Go process the next one
TLCREJ:
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Connect for SDP !O rejected]!/"]>,R7>
>;End IFN FTDBUG
	MOVE	T1,[.NSFRJ,,.NSACH+1]	;Function,,length
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ REJECT CONNECT
	 JRST	TLDUMP			;Oops, gone already!
;
;	At this point, our channel is closed, etc., so just toss this
;	guy out and let somebody else take over.
;
TLDISC:
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Deleting SDP at !O]!/"]>,R7>
>;End IFN FTDBUG
	MOVE	T1,[.NSFRL,,.NSACH+1]	;Set up to release channel
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Put int block
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ RELEASE CHANNEL
	 JFCL				;Ignore errors
	SKIPN	R4,FIRST		;Get first SDP
	 $ERROR				;Gotta have one!
	CAME	R4,R7			;Are we the first one?
	JRST	TLCRJ1			;No, go on
	MOVE	R4,SD.LNK(R7)		;Get the next one
	MOVEM	R4,FIRST		;Save as the first one
	JRST	TLCRJ2			;And delete this guy
TLCRJ1:
	SKIPN	SD.LNK(R4)		;At end of list?
	$ERROR				;Yes, cannot be!
	CAME	R7,SD.LNK(R4)		;Is this us?
	JRST	[MOVE	R4,SD.LNK(R4)	;No, so get next one
		 JRST	TLCRJ1]		;And go on
	MOVE	R5,SD.LNK(R7)		;Get next one after us
	MOVEM	R5,SD.LNK(R4)		;And make it next one after previous
TLCRJ2:
	LSH	R7,-^D9			;Convert into page address
	MOVEI	R6,1			;just one arg
	MOVE	T1,[.PAGCD,,R6]	;Point at it
	TXO	R7,PA.GAF		;Set bit to zap it!
	PAGE.	T1,			;Zap it
	 PUSHJ	SP,PAGFLD		;Failed!
	MOVE	R7,R4			;Copy previous address to get next one
	SKIPN	FIRST			;Did we delete the one and only?
	JRST	NEWONE			;Yes, build a new one
	JRST	TLNEXT			;Do the next one
	SUBTTL	TLLRUN - Here When We Enter RUN State

;
;	Here when we enter the RUNNING state. We will now LOGIN a 
;	subjob for this link and wait for it before sending the data
;	from the network link.
;
TLLRUN:
	MOVX	T1,SS.ACT		;Get active bit
	TDNE	T1,SD.STS(R7)		;Set?
	JRST	TLNEXT			;Yes, forget this!
	MOVX	T1,SS.INT		;Processing internal commands?
	TDNN	T1,SD.STS(R7)		;???
	JRST	TLLRNX			;No, go on
	$CALL	TLLINT,<R7>		;Yes, go process commands
	JRST	TLLFIN			;All done here!
TLLRNX:
	AOS	CONTOT			;Count this one
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Link established, logging in job for SDP !O]!/"]>,R7>
>;End IFN FTDBUG
	MOVX	T1,FO.ASC!.FOSAU	;Get mode
	MOVEM	T1,SD.FLP+.FOFNC(R7)	;Store in FILOP block
	MOVX	T1,.IOASC		;Get mode
	MOVEM	T1,SD.FLP+.FOIOS(R7)	;Store
	MOVSI	T1,'PTY'		;Get device name
	MOVEM	T1,SD.FLP+.FODEV(R7)	;Store
	HRLI	T1,SD.OBF(R7)		;Get output buffer address
	HRRI	T1,SD.IBF(R7)		;Get same for input
	MOVEM	T1,SD.FLP+.FOBRH(R7)	;Store
	SETZM	SD.FLP+.FONBF(R7)	;Defaults here
	MOVEI	T1,SD.FLP(R7)		;Get address of arg block
	HRLI	T1,.FONBF+1		;Get size of it
	FILOP.	T1,			;OPEN it
 	 JRST	PTYOPF			;Oops!
	MOVEI	R1,SD.FLP+.FOIOS(R7)	;Get address of "open" block
	MOVEI	R2,SD.OPT(R7)		;Get address of output buffer
	HRLI	R2,PTYBFS		;GEt size of it in LH
	MOVEI	R3,SD.IPT(R7)		;Get input buffer address
	HRLI	R3,PTYBFS		;Get size
	$CALL	SETBUF,<@R1,R2,R3>	;Set up buffer rings
	SKIPE	RS			;OK?
	 $ERROR				;Whoa!
	MOVEM	R7,CURSDP		;Save this
	HLRZ	R1,SD.PPN(R7)		;Get project number
	HRRZ	R2,SD.PPN(R7)		;And programmer number
	$CALL	FAO,<<[ASCIZ "LOGIN !O,!O!/"]>,R1,R2>
	SETZM	CURSDP
	PUSHJ	SP,PTYFLS		;Flush it out
	MOVX	T1,SS.ACT!SS.LGN	;Remember active and logging in
	IORM	T1,SD.STS(R7)		;...
	MOVX	T1,%CVUPT		;Get uptime
	GETTAB	T1,			;...
	 $ERROR				;Can't happen
	MOVEM	T1,SD.TIM(R7)		;Store for later
	JRST	TLNEXT			;And go on
	SUBTTL	TLDUMP - Here To Abort A Link

;
;	Here when we are confused. Either we have detected a link state
;	that we don't know how to deal with or an NSP. UUO to read or
;	write data to the network failed, implying that the link has gone
;	sour on us.
;
TLDUMP:
IFN	FTDBUG,<
	$CALL	FAO,<<[ASCIZ "!/[Aborting link for SDP !O]!/"]>,R7>
>;End IFN FTDBUG
	MOVE	T1,[.NSFAB,,.NSACH+1]	;Set up to abort the link
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Remember this
	MOVEI	T1,SD.NSP(R7)		;Get address of it
	NSP.	T1,			; ++ ABORT LINK
	 JFCL				;No message, since link is probably
					; already gone...
	MOVX	T1,SS.ABO		;Flag we aborted the link
	IORM	T1,SD.STS(R7)		;...
	JRST	TLABOR			;Go and end it all
	SUBTTL	TLLINT - Here to process internal info messages

$ENTRY	TLLINT,<%SDP>
	MOVE	R7,@%SDP		;Get SDP address
	MOVEI	R2,SD.NBF(R7)		;Get address of network buffer
	HRLI	R2,(POINT 7,0)		;Make into a byte pointer
	MOVEI	T1,<NSPBFS*5>		;Get max chars to store
	MOVEM	T1,SD.CTR(R7)		;Store
	MOVE	R1,[POINT 7,[ASCIZ /
DOTELL has processed /]]
	PUSHJ	SP,TLLINX		;Output the string
	SKIPN	R3,CONTOT		;Get total number of connections
	JRST	[MOVEI	T1,"0"		;Say zero
		 PUSHJ	SP,TLLCHR	;Output it
		 JRST	TLLIN3]		;All done
	SETZ	R5,			;Clear this register
TLLIN1:
	JUMPLE	R3,TLLIN2		;Done here
	IDIVI	R3,^D10			;Divide by radix
	ADDI	R4,"0"			;Make remainder an ASCII digit
	PUSH	SP,R4			;And save it
	AOJA	R5,TLLIN1		;Loop for all
TLLIN2:
	SOJL	R5,TLLIN3		;Done here
	POP	SP,T1			;Get the digit back
	PUSHJ	SP,TLLCHR		;Output it
	JRST	TLLIN2			;Go on
TLLIN3:
	MOVE	R1,[POINT 7,[ASCIZ / connect/]]
	PUSHJ	SP,TLLINX		;output that
	MOVEI	T1,"s"			;Get plural ending
	MOVE	T2,CONTOT		;Get totals
	CAIE	T2,1			;just one?
	PUSHJ	SP,TLLCHR		;No, output it
	MOVE	R1,[POINT 7,[ASCIZ / since startup at /]]
	PUSHJ	SP,TLLINX		;Output it
	MOVE	R1,[POINT 7,STRDTM]	;Now output startup date and time
	PUSHJ	SP,TLLINX		;Do it
TLLINS:
	PUSHJ	SP,NSPFLS		;Output it
	 JRST	TLLIND			;Oops! The link disappeared
	 SKIPA				;Can't send it, wait
	JRST	TLLIND			;Done
	MOVEI	T1,1
	SLEEP	T1,
	JRST	TLLINS			;Loop on
TLLIND:
	$RETRN				;All is well, return
TLLINX:
	ILDB	T1,R1			;Get a byte
	JUMPE	T1,[POPJ SP,]		;Return on null
	PUSHJ	SP,TLLCHR		;output it
	JRST	TLLINX			;And loop on
TLLCHR:
	SOSL	SD.CTR(R7)		;Count this character
	IDPB	T1,R2			;Store
	POPJ	SP,			;Return
	SUBTTL	CHKINT - Here to check for special internal name

$ENTRY	CHKINT,<%PTR,%SIZE>

	MOVE	R1,@%PTR		;Get pointer
	MOVE	R2,@%SIZE		;Get size
	CAIE	R2,^D10			;Correct number of bytes?
	JRST	CHKINE			;No, error
	MOVE	R3,[POINT 7,[ASCIZ /*INTERNAL*/]];Special name is this
CHKIN0:
	ILDB	T2,R3			;Get a byte
	JUMPE	T2,CHKIN1		;A match!
	ILDB	T1,R1			;Geta byte
	CAIL	T1,141			;OK?
	SUBI	T1,40			;No make upper case
	CAMN	T1,T2			;Same?
	JRST	CHKIN0			;No, go on
CHKINE:
	$RETRN	<[-1]>			;Done, no match
CHKIN1:
	$RETRN				;Done, we have a match
	SUBTTL	SETUSR and CHKUSR - Here For USERS.TXT Stuff

;
;	These routines allow a user on the DEC-10 to give a name to his
;	PPN on the -10 for compatibility with other systems that used
;	named directories. The name to PPN translation is stored in a file
;	called SYS:USERS.TXT[1,4]. We will reread this file about every half
;	hour to catch any updates to that file.
;
;	Here to read SYS:USERS.TXT into core.
;
$ENTRY	SETUSR

	SKIPN	USRTIM			;First time around?
	JRST	SETUS1			;Yes, go read the file
	MOVX	T1,%CVUPT		;Get uptime
	GETTAB	T1,			;...
	 $ERROR				;must be there!
	SUB	T1,USRTIM		;Get difference
	CAIGE	T1,USRWAT		;Have we exceeded wait time?
	$RETRN				;No, just return
SETUS1:
	MOVX	R1,.IODMP		;Get dump mode
	MOVSI	R2,'SYS'		;Get device name
	SETZ	R3,			;Nothing here
	OPEN	USRCHN,R1		;OPEN the device
	 JRST	SETUER			;OPEN failed, forget it
	MOVE	R1,['USERS ']		;Get file name
	MOVSI	R2,'TXT'		;...
	SETZB	R3,R4			;Defaults here
	LOOKUP	USRCHN,R1		;Find the file
	 JRST	SETUER			;Can't get it, forget it
	HLRE	R5,R4			;Get length of file in words
	JUMPL	R5,SETUS2		;Negative, number of words
	IMULI	R5,200			;It was blocks, make it words
	SKIPA				;And don't negate
SETUS2:
	MOVMS	R5			;Make positive
	SKIPN	R6,USRBUF		;Get previous address, if any
	HRRZ	R6,.JBFF		;If none, get this
	MOVEM	R6,USRBUF		;Store as address
	MOVEM	R5,USRSIZ		;Remember this
	ADD	R6,R5			;Get top address needed
	CAMG	R6,.JBREL		;Do we have the room?
	JRST	SETUS3			;Yes, just move along
	CORE	R6,			;Get it
	 JRST	SETUER			;Can't do it, go on
SETUS3:
	MOVE	R6,USRBUF		;Get address of buffer
	SUBI	R6,1			;Less one
	MOVN	T1,R5			;Get -length
	HRL	R6,T1			;Get here
	SETZ	R7,			;End ths list here
	IN	USRCHN,R6		;Read in the file
	 SKIPA				;OK?
	JRST	SETUER			;No, forget it
	MOVX	T1,%CVUPT		;Get current time
	GETTAB	T1,			;...
	 $ERROR				;no can hjappen
	MOVEM	T1,USRTIM		;Save
	CLOSE	USRCHN,			;End nice
	RELEAS	USRCHN,			;...
	$RETRN				;All done!
SETUER:
	MOVEI	T1,USRCHN		;Get channel
	RESDV.	T1,			;Clear it
	 JFCL				;Forget that
	SKIPE	T1,USRBUF		;Get this
	HRRM	T1,.JBFF		;Reset this
	SETZM	USRBUF			;No file
	SETZM	USRSIZ			;No size
	$RETRN				;All done

;
;	Here to see if user ID is something we can convert into a PPN
;
$ENTRY	CHKUSR,<%PTR,%LEN,%PPN>

	SKIPN	R1,USRBUF		;Get address of where stuff is
	 JRST	CHKERT			;No stuff, return non-zeo RS
	HRLI	R1,(POINT 7,0)		;Make pointer to data
	MOVE	R7,USRSIZ		;Get size in words
	IMULI	R7,5			;Get size in bytes
CHKUS1:
	SETZB	R5,R6			;Put number in R5, PPN in R6
CHKUS2:
	SOJL	R7,CHKERT		;EOF, done
	ILDB	T1,R1			;Get a byte
	CAIE	T1,"["			;Start of PPN?
	JRST	CHKUS2			;No find it
CHKUS3:
	SOJL	R7,CHKERT		;Done here
	ILDB	T1,R1			;Get another byte
	CAIL	T1,"0"			;Legal number?
	CAILE	T1,"7"			;???
	 JRST	CHKUS4			;No, check it out
	IMULI	R5,10			;Multiply by radix
	SUBI	T1,"0"			;Make binary
	ADD	R5,T1			;Get it
	JRST	CHKUS3			;And go on
CHKUS4:
	JUMPN	R6,CHKUS5		;last number here
	CAIE	T1,","			;Comma?
	JRST	CHKEOL			;No, kill this line and start again
	HRLZ	R6,R5			;Copy this number
	SETZ	R5,			;and get another number
	JRST	CHKUS3			;And get next one
CHKUS5:
	HRR	R6,R5			;Get RH of PPN
CHKU5A:
	SOJL	R7,CHKERT		;Done at EOF
	ILDB	T1,R1			;Get a byte
	CAIN	T1,LF			;Line feed?
	JRST	CHKUS1			;Yes, start all over
	CAIE	T1,","			;Comma?
	JRST	CHKU5A			;No, find it
	MOVE	R2,@%PTR		;Get pointer to data
	MOVE	R3,@%LEN		;And length of string
CHKUS6:
	SOJL	R7,CHKERT		;Done here
	ILDB	T1,R1			;Get byte from file
	CAIN	T1,CR			;CR?
	JRST	CHKUS6			;Yes, ignore
	CAIN	T1,LF			;LF?
	SETZ	T1,			;Yes, assume end of line
	SOJL	R3,CHKUS7		;Done here
	JUMPE	T1,CHKUS1		;Oops, too long!
	ILDB	T2,R2			;And one from user
	ANDI	T1,177			;Make seven bits
	ANDI	T2,177			;...
	CAIL	T1,"a"			;Lower case?
	SUBI	T1,40			;Yes, make upper
	CAIL	T2,"a"			;Same for other one
	SUBI	T2,40			;...
	CAMN	T1,T2			;Same?
	JRST	CHKUS6			;Yes, all done!
CHKEOL:
	SOJL	R7,CHKERT		;Done here
	ILDB	T1,R1			;Get a byte
	CAIE	T1,LF			;LF?
	JRST	CHKEOL			;no, find one
	JRST	CHKUS1			;and go on
CHKUS7:
	MOVEM	R6,@%PPN		;Store PPN
	$RETRN				;Return with zero RS
CHKERT:
	SETO	RS,			;Flag error
	$RETRN	<RS>			;Return with it
	SUBTTL	NSPINT - Here On NSP Interrupt

;
;	Here when the system interrupts us to let us know that something
;	on a DECnet channel has changed. We determine which SDP this
;	interrupt is meant for by comparing the channel number on the
;	status word of the interrupt with the channel number in each
;	SDP. We always update the entire status word (.NSACH) for this
;	link, plus set a flag in the status word if the link state has
;	changed so top level knows to do something.
;
NSPINT:
	PUSH	SP,R1			;Save some ACs
	PUSH	SP,R2			;...
	PUSH	SP,R3			;...
	PUSH	SP,R4			;...
	HRRZ	R4,VECTOR+.PSVIS	;Get channel number
	MOVE	R1,FIRST		;Get address of first SDP
NSPIN1:
	HRRZ	R2,SD.NSP+.NSACH(R1)	;Get channel for this guy
	CAMN	R2,R4			;OK?
	JRST	NSPIN2			;Yes, so go handle it
	SKIPN	R1,SD.LNK(R1)		;Still more?
	JRST	NSPINE			;No, just return
	JRST	NSPIN1			;Loop on
NSPIN2:
	LDB	R3,[POINT 6,SD.STS(R1),35];Get the state we knew before
	HLLZ	R2,VECTOR+.PSVIS	;Get status of channel
	HLLM	R2,SD.NSP+.NSACH(R1)	;Store new state
	LDB	R2,[POINT 6,VECTOR+.PSVIS,17];Get state
IFN	FTDBUG,<
	PUSH	SP,CURSDP		;Save this...
	SETZM	CURSDP			;...
	$CALL	FAO,<<[ASCIZ "!/[Interrupt for SDP !O shows state of !O]!/"]>,R1,R2>
	POP	SP,CURSDP		;Restore that
>;End IFN FTDBUG
	CAMN	R2,R3			;Same?
	JRST	NSPINW			;Yes, just wake me up
	MOVX	R3,SS.CHG		;Get changed bit
	IORM	R3,SD.STS(R1)		;Flag as changed
	DPB	R2,[POINT 6,SD.STS(R1),35];And store new "last" state
NSPINW:
	MOVE	R2,MYJOB		;Get my job number
	WAKE	R2,			;Wake me up
	 JFCL				;Ho hum
NSPINE:
	POP	SP,R4			;Restore registers
	POP	SP,R3			;...
	POP	SP,R2			;...
	POP	SP,R1			;...
	DEBRK.				;Goodbye
	 JFCL				;WhaAAAA?
	$ERROR				;Can never happen
	SUBTTL	PTYCPY - Here To Output Stuff

;
;	Subroutine PTYCPY
;
;	This routine takes output from the PTY and sends it through
;	the DECnet link.
;
;	Input arguments:
;
;	 R7 = Address of SDP
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 Skip return - All available PTY output has been sent or network
;			can't hold any more.
;
;	 Non-skip return - Link has disappeared (NSP. to output data failed).
;
PTYCPY:
	MOVX	T2,SS.PAR		;Partial buffer left to output?
	TDNN	T2,SD.STS(R7)		;???
	JRST	PTYCP0			;no, go on
	PUSHJ	SP,NSPFLS		;OK?
	 POPJ	SP,			;Link gone, no skip return
	 JRST	PTYPJ1			;Can't do I/O, skip return
	MOVX	T2,SS.PAR		;Reget partial buffer bit
	TDNE	T2,SD.STS(R7)		;Did we clear it?
	 JRST	PTYPJ1			;No, wait some more
PTYCP0:
	MOVX	T1,NS.NDR		;Ready to go?
	TDNN	T1,SD.NSP+.NSACH(R7)	;???
	 JRST	 PTYPJ1			;No, forget it
	SKIPE	T1,SD.CHR(R7)		;Any hold character?
	 JRST	[SETZM	SD.CHR(R7)	;Yes, clear it out
		 JRST	PTYCPZ]		;And go on
	PUSHJ	SP,PTYCHR		;Get a character from PTY
	 JRST	PTYPJ1			;All done
	JUMPE	T1,PTYCPY		;Ignore nulls
PTYCPZ:
	CAIE	T1,CR			;Don't send these
	CAIN	T1,LF			;...
	JRST	PTYCPX			;...
	SOSG	SD.CTR(R7)		;Room for it?
	 JRST	FLSBUF			;Flush it out
PTYCPA:
	IDPB	T1,SD.PTR(R7)		;Store the byte
PTYCPX:
	CAIE	T1,TAB			;Ignore tab's
	CAIN	T1,CR			;Ignore CR's
	JRST	PTYCPY			;Just go on
	CAIL	T1,40			;Less than a space
	JRST	PTYCPY			;No, keep on going
	PUSHJ	SP,NSPFLS		;Flush buffer
	 POPJ	SP,			;Oops, just return - link gone
	 JRST	PTYPJ1			;No data can be moved, skip return
	JRST	PTYCPY			;And keep going
FLSBUF:
	PUSHJ	SP,NSPFLS		;output it
	 POPJ	SP,			;Woops! Link is gone, just return
	 JRST	FLSBF1			;Failed, cannot output buffer
	MOVX	T2,SS.PAR		;Get partial bit
	TDNN	T2,SD.STS(R7)		;Is it set?
	JRST	PTYCPA			;No, go on
FLSBF1:
	MOVEM	T1,SD.CHR(R7)		;Save for later...
PTYPJ1:
	AOS	(SP)			;Skip return
	POPJ	SP,			;Return
;
;	Subroutine NSPFLS - Send current DECnet buffer out on the network
;
;	Input arguments:
;
;	 R7 = Address of SDP for this link
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 Double skip - All is well, the data was sent, ready for more.
;
;	 Single skip - Network not ready for any more data.
;
;	 No skip - Link disappeared - NSP. UUO failed.
;
NSPFLS:
	PUSH	SP,T1			;Save T1
	MOVX	T1,NS.NDR		;Get normal data may be sent bit
	TDNN	T1,SD.NSP+.NSACH(R7)	;Is it set?
	JRST	[POP	SP,T1		;Restore T1
		 AOS	(SP)		;Skip one
		 POPJ	SP,]		;And return
	MOVX	T1,SS.PAR		;doing a partial buffer?
	TDNE	T1,SD.STS(R7)		;???
	JRST	NSPFL0			;Yes, skip this
	MOVEI	T1,SD.NBF(R7)		;Get address of buffer
	HRLI	T1,(POINT 7,0)		;Make into pointer
	MOVEM	T1,SD.NSP+.NSAA2(R7)	;Store
	MOVEI	T1,<NSPBFS*5>		;Get max chars
	SUB	T1,SD.CTR(R7)		;Get how many we store
	MOVEM	T1,SD.NSP+.NSAA1(R7)	;Store
	JUMPE	T1,[	MOVX	T2,SS.BLK	;Get blank line bit
			TDNE	T2,SD.STS(R7)	;Was last line blank?
			JRST	NSPFL3		;Yes, forget it
			IORM	T2,SD.STS(R7)	;Remember that this line's blank
			JRST	NSPFL0]		;And go on
	MOVX	T2,SS.BLK		;Get blank line bit
	ANDCAM	T2,SD.STS(R7)		;Clear it, since this line's not blank
	CAIE	T1,1			;Did we have just one char?
	JRST	NSPFL0			;No, go on
	MOVE	T1,SD.NSP+.NSAA2(R7)	;Get pointer
	ILDB	T1,T1			;Get a byte
	CAIN	T1,"."			;Was it a dot EOL?
	JRST	NSPFL3			;Yes, ignore it
NSPFL0:
	MOVE	T1,[.NSFDS,,.NSAA2+1]	;Set up control stuff
	TXO	T1,NS.EOM		;A whole message here
	MOVEM	T1,SD.NSP+.NSAFN(R7)	;Store
IFN	FTDBUG,<
	SKIPG	.JBCST			;Want to see it?
	JRST	NSPFL1			;No
	MOVE	T2,SD.NSP+.NSAA2(R7)	;Get byte pointer
	MOVE	T1,SD.NSP+.NSAA1(R7)	;Get count
NSPDSX:
	ILDB	R0,T2			;Get it
	OUTCHR	R0			;Type it
	SOJG	T1,NSPDSX		;Loop on
	OUTSTR	[ASCIZ	/
/]
NSPFL1:
>;End IFN FTDBUG
	MOVEI	T1,SD.NSP(R7)		;Get address of block
	NSP.	T1,			; ++ SEND NORMAL DATA
	 JRST	[POP	SP,T1		;Restore T1
		 POPJ	SP,]		;And no skip return at all
	SKIPE	SD.NSP+.NSAA1(R7)	;Did we output it all?
	JRST	NSPFL2			;No, go handle that
NSPFL3:
	MOVEI	T1,SD.NBF(R7)		;Get buffer address
	HRLI	T1,(POINT 7,0)		;Make into a pointer
	MOVEM	T1,SD.PTR(R7)		;Store
	MOVEI	T1,NSPBFS*5		;Get max chars
	MOVEM	T1,SD.CTR(R7)		;Store it
	MOVX	T1,SS.PAR		;Get partial buffer to output bit
	ANDCAM	T1,SD.STS(R7)		;and flag all is well
	POP	SP,T1			;Restore T1
	AOS	(SP)			;And skip
	AOS	(SP)			;Skip TWICE
	POPJ	SP,			;and return
NSPFL2:
	MOVX	T1,SS.PAR		;Get partial buffer left bit
	IORM	T1,SD.STS(R7)		;Set it, so we will output this first
	POP	SP,T1			;Restore T1
	AOS	(SP)			;Skip return
	AOS	(SP)			;Skip twice
	POPJ	SP,			;and return
	SUBTTL	Small PTY Routines

;
;	PTYOUT - Routine to send a character to the PTY
;
;	Input arguments:
;
;	 R7 = address of current SDP
;
;	 T1 = character to output
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 Fatal TELOPR if two FILOP. OUTs fail to PTY (via PTYFLS).
;
PTYOUT:
	SOSG	SD.OBF+.BFCTR(R7)	;Room?
	PUSHJ	SP,PTYFLS		;No, flush buffer
	IDPB	T1,SD.OBF+.BFPTR(R7)	;Store the byte
IFN	FTDBUG,<
	SKIPL	.JBCST			;Anything there?
	POPJ	SP,			;Return
	PUSH	SP,T1			;Save REAL character...
	CAIN	T1,33			;ALT?
	MOVEI	T1,"$"			;Yes, output this
	CAIE	T1,CR
	CAIN	T1,LF
	SKIPA
	CAIL	T1," "			;Control range?
	JRST	[OUTCHR	T1		;no, just type it
		 POP	SP,T1		;Restore this
		 POPJ	SP,]		;And return
	OUTCHR	["^"]			;First this...
	ADDI	T1,100			;Make into a real character
	OUTCHR	T1			;Output it
	POP	SP,T1			;Restore this
>;End IFN FTDBUG
	POPJ	SP,			;and return


;
;	Subroutine PTYFLS - Flush current PTY buffer
;
;	Input arguments:
;
;	 R7 = current SDP address
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 Fatal TELOPR if two outs to PTY fail.
;
PTYFLS:
	PUSH	SP,T1			;Save the character
	PUSH	SP,T2			;Save this one, too
	SETZ	T2,			;Clear this register
PTYFL0:
	MOVEI	T1,.FOOUT		;Get function
	HRRM	T1,SD.FLP+.FOFNC(R7)	;Set the function
	MOVEI	T1,SD.FLP(R7)		;Get address
	HRLI	T1,1			;Get length
	FILOP.	T1,			;Output it
	 JRST	[JUMPN	T2,FLPERR	;Report error second time around
		 SETO	T2,		;Flag that we've been here
		 PUSHJ	SP,CLRPTI	;Clear all input....
		 JRST	PTYFL0]		;And try it again
	POP	SP,T2			;Restore this AC
	POP	SP,T1			;Get character back
	POPJ	SP,			;Return
FLPERR:
	MOVEI	T1,5			;Do it five times
FLPER1:
	TELOPR	<Output to PTY failed - call systems group>
	MOVEI	T2,3
	SLEEP	T2,			;Wait three seconds
	SOJG	T1,FLPER1		;Tell operator again and again
	MONRT.				;Stop...
	POP	SP,T2			;Restore ACs
	POP	SP,T1			;...
	JRST	PTYFLS			;And try again

;
;	Subroutine PTYCHR - Get a character from PTY
;
;	Input arguments:
;
;	 R7 = current SDP address
;
;	Output arguments:
;
;	 T1 = Character received from PTY
;
;	Errors:
;
;	 Skip return - got a good character in T1
;
;	 Non-skip return - No more characters out there
;
PTYCHR:
	SOSGE	SD.IBF+.BFCTR(R7)	;Any characters?
	JRST	CLRPT1			;No, make sure
	ILDB	T1,SD.IBF+.BFPTR(R7)	;Pretend we got it
	AOS	(SP)			;Skip return
	SKIPL	.JBCST			;Special flag on?
	POPJ	SP,			;...
	PUSH	SP,T1			;Save T1
	CAIN	T1,33			;Alt?
	MOVEI	T1,"$"			;Yes, make dollar sign
	CAIE	T1,CR
	CAIN	T1,LF
	SKIPA
	CAIL	T1," "			;OK?
	JRST	[OUTCHR	T1		;Yes, type it
		 POP	SP,T1		;Get it back
		 POPJ	SP,]		;And return
	OUTCHR	["^"]			;Make control
	ADDI	T1,100			;Make a printing char
	OUTCHR	T1			;Type it
	POP	SP,T1			;Restore this
	POPJ	SP,			;return
CLRPT1:
	PUSH	SP,T1			;Save an AC
	MOVEI	T1,.FOINP		;Get IN function
	HRRM	T1,SD.FLP(R7)		;Remember in FILOP. BLOCK
	MOVEI	T1,SD.FLP(R7)		;Get address of it
	HRLI	T1,1			;Just one word
	FILOP.	T1,			;Do it
	 JRST	[POP	SP,T1		;Restore T1
		 POPJ	SP,]		;And return
	POP	SP,T1			;Restore T1
	SKIPE	SD.IBF+.BFCTR(R7)	;Anything there?
	JRST	PTYCHR			;Yes, go handle it
	POPJ	SP,			;no, return

;
;	Subroutine CLRPTI - Clear out PTY input buffer
;
;	Input arguments:
;
;	 R7 = current SDP address
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 None
;
CLRPTI:
	PUSH	SP,T1			;Save T1
	PUSHJ	SP,PTYCHR		;Get a character
	 JRST	[POP	SP,T1		;Restore T1
		 POPJ	SP,]		;Return
	JRST	CLRPTI+1		;Loop on

;
;	Subroutine ENCODE - Subroutine to encode DEC-10 password
;
;	Input arguments:
;
;	 R6 = Sixbit password to be encoded
;
;	Output arguments:
;
;	 R6 = Encoded password
;
;	Errors:
;
;	 None
;
ENCODE:
	PUSH	SP,R1		;Save some ACs
	PUSH	SP,R2		;...
	PUSH	SP,R3		;...
	PUSH	SP,R4		;...
	MOVE	R2,R6		;Copy the password
	MOVE	R1,R2		;...
	HRRZ	R4,SD.PPN(R7)	;Get RH of PPN
	IDIVI	R2,(R4)		;Divide into password
	MOVM	R3,R3		;Get abs(remainder)
	MOVE	R4,R3		;Copy for a loop counter
FOO:	MUL	R1,R1		;Square the password
	ROTC	R1,^D18		;Get middle 36 bits of result
	JUMPN	R1,.+2		;make sure non-zero
	MOVE	R1,R2		;If zero, pick up password again
	SOJG	R4,FOO		;Do this a random number of times
	XOR	R1,R6		;munge it still more
	IDIVI	R3,^D35		;Divide loop counter
	ROT	R1,1(R4)	;Rotate R1 by remainder
	MOVEM	R1,R6		;remember it
	POP	SP,R4		;Restore ACs
	POP	SP,R3		;...
	POP	SP,R2		;...
	POP	SP,R1		;...
	POPJ	SP,		;Return
	SUBTTL	Here For Store Date Integers

DECTWO:
	PUSH	SP,R1			;Store these
	PUSH	SP,R2			;...
	IDIVI	R1,^D10			;Get low order digit into R2
	ADDI	R2,60			;Make ASCII
	ADDI	R1,60
	IDPB	R1,R6			;Store high order
	IDPB	R2,R6			;Then low order
	POP	SP,R2
	POP	SP,R1
	POPJ	SP,			;Return
	SUBTTL Here on Errors

NSPFLD:
	TELOPR	<NSP. UUO failed>
	EXIT
PAGFLD:
	TELOPR	<PAGE. UUO failed>
	EXIT
PIIFLD:
	TELOPR	<PIINI. UUO failed>
	EXIT
PSYFLD:
	TELOPR	<PISYS. UUO failed>
	EXIT
PTYOPF:
	TELOPR	<PTY OPEN failed>
	EXIT
	SUBTTL	TELOPR - Here To Send a Line to the Operator

;
;	Subroutine OPRTYP - come here from TELOPR macro
;
;	Input arguments:
;
;	 (SP) = address of location +1 of address of literal block, the
;		second word of which is the address of an ASCIZ string.
;
;	Output arguments:
;
;	 None
;
;	Errors:
;
;	 None
;
OPRTYP:
	PUSH	SP,R1			;Save Some regs
	PUSH	SP,R2			;...
	HRRZ	R1,-2(SP)		;Get return address
	SUBI	R1,1			;Back up
	HRRZ	R1,(R1)			;Get address of literal
	MOVE	R1,1(R1)		;Get address of ASCIZ string
	MOVX	R2,.TOOUS		;Get code to output an ASCIZ string
	MOVEM	R2,TRMBLK		;Store
	MOVEI	R2,TOPSTR		;Get addressof first part
	MOVEM	R2,TRMBLK+2		;Store
	MOVE	R2,[3,,TRMBLK]		;Set up the call
	TRMOP.	R2,			;Do it
	 JFCL				;Oh well
	MOVEM	R1,TRMBLK+2		;Store this one
	MOVE	R2,[3,,TRMBLK]		;Do it again
	TRMOP.	R2,			;...
	 JFCL				;Forget errors
	POP	SP,R2			;Restore these
	POP	SP,R1			;...
	POPJ	SP,			;Bye
TOPSTR:
	BYTE	(7) 7,7,7,7,7
	ASCIZ	/?Error from DOTELL - /
	END	START