Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist2-clock - galaxy-sources/qsrnet.mac
There are 36 other files named qsrnet.mac in the archive. Click here to see a list.
	TITLE	QSRNET - NETWORK DATA BASE MANAGER
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	ALL RIGHTS RESERVED.
;
;	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 OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	QSRMAC,ORNMAC,GLXMAC
	PROLOG	(QSRNET)

	NETMAN==:0			;Maintenance edit number
	NETDEV==:36			;Development edit number
	VERSIN (NET)			;Generate edit number
	Subttl	Table of Contents

;		     Table of Contents for QSRNET
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   3
;    2. Local Definitions
;        2.1    General storage  . . . . . . . . . . . . . . .   4
;        2.2    Storage to support signon file processing  . .   5
;        2.3    Routine declarations . . . . . . . . . . . . .   6
;    3. N$INIT - ROUTINE TO INITIALIZE THE NETWORK DATA BASE M   7
;    4. N$NODE - ROUTINE TO VERIFY THAT THE NODE IS ONLINE.  .   8
;    5. Add entries to the network queue . . . . . . . . . . .   9
;    6. N$NRTE - ROUTINE TO PROCESS OPERATOR ROUTE MESSAGES  .  12
;    7. N$LPTN - CHECK FORMAT OF A LPT NAME BLOCK  . . . . . .  15
;    8. FNDRTE - FOUND A ROUTE TABLE ENTRY . . . . . . . . . .  16
;    9. RTENAM - COMPARE TWO NAMES OF LPT OBJECTS IN ROUTE TAB  17
;   10. N$RTAS - ROUTINE TO CONVERT A ROUTE TABLE ENTRY TO ASC  18
;   11. GENFRM - ROUTINE TO GENERATE 'FROM' ROUTE TABLE DESCRI  19
;   12. N$CSTN - PERFORM DEVICE ROUTINE AND DEVICE CHECKING  .  20
;   13. QOMTCH - Routine to match q entry with object  . . . .  22
;   14. N$LOCL - ROUTINE TO VERIFY THAT A NODE NAME/NUMBER IS   23
;   15. N$MTCH - SEE IF 2 REMOTE STATION ID'S ARE EQUIVALENT .  24
;   16. N$NONL / N$NOFF - IBM ONLINE/OFFLINE PROCESSING ROUTIN  25
;   17. SNDORN - ROUTINE TO SEND A NODE WENT AWAY MSG OFF TO O  29
;   18. N$CKND - Check state of node for IBM DEFINEs and SETs   30
;   19. FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIE  31
;   20. N$SACT - Set up actual IBM termination nodes . . . . .  32
;   21. GETNNM - Routine to get the next node name from signon  33
;   22. N$PORT - Routine to look for multiple devices on same   34
;   23. PURGE.DUP.OBJS - ROUTINE TO PURGE DUPLICATE OBJECTS  .  35
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

0			7-Jan-83
	Currently no edits

*****  Release 5.0 -- begin development edits  *****

10	5.1003		7-Jan-83
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

11	5.1008		18-Jan-83
	Fix the GET.NETWORK.TOPOLOGY routine to analyze the error from
the NODE JSYS and if it needs a larger argument block, get one and try
again.

12	5.1162		21-Sep-84
	Add code to handle SNA Workstation going online/off and code to
delete NAB and NOB when SNA Node is purged.

13	5.1172		22-Oct-84
	In routine N$SACT if an SNA node is redefined as a termination actual,
call N$NNET to purge and recreate the node database entry.

14	5.1183		30-Nov-84
	Get rid of GET.NETWORK.TOPOLOGY. Also, only check IBM nodes for
online and offline.

*****  Release 5 -- begin maintenance edits  *****

20	Increment maintenance edit level for GALAXY 5.

*****  Release 6.0 -- begin development edits  *****

25	6.1026		19-Oct-87
	Add support to the ROUTE command for remote printers.

26	6.1042		29-Oct-87
	Add support for the management of remote LPT objects and the 
scheduling of remote LPT objects.

27	6.1097		22-Nov-87
	Use the $QACK and $QWTO macros instead of the $ACK and $WTO
macros for sending .OMACK and .OMWTO messages.

30	6.1126		7-Dec-87
	Do not schedule a print request to a TTY: printer unless its
unit number has been specified in the print request.

31	6.1132		7-Dec-87
	When matching a QE with the source object in the route table, if
the node and object types agree and if the request has a %GENRC attribute,
then allow for a match.

32	6.1168		20-Jan-88
	Undo edit 30

33	6.1177		11-Feb-88
	Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.

34	6.1225		8-Mar-88
	Update copyright notice.

35	6.1233		5-Apr-88
	For generic print requests in which the QE matches the source object
in the route table, but the target object in the route table does not match
the current object being matched in the object queue, then do not assume that
the current object is in the route table; rather, search all the remaining
source objects in the route table that match with the QE before comparing the
QE with the current object.

36	6.1253		10-May-88
	Upon a match of a QE with a source object route table entry, first
check if the target object is .INFIN, if it is, then consider a match to
have occurred.

\   ;End of Revision History
	SUBTTL	Local Definitions -- General storage

RTEQUE:: BLOCK	1		;DEVICE ROUTING TABLE ID

TOBJ:	BLOCK	OBJ.SZ		;TEMPORARY OBJECT BLOCK TO SHUT DOWN PRINTER
				;  WHEN READER GOES DOWN IN IBMCOM

NETPTR:	BLOCK	1		;BYTE POINTER FOR $TEXT

NETBYT:	IDPB	S1,NETPTR	;$TEXT ACTION ROUTINE
	$RETT			;RETURN

NWAMSG:	$BUILD	.OHDRS+ARG.DA+OBJ.SZ
	 $SET(.MSTYP,MS.CNT,.OHDRS+ARG.DA+OBJ.SZ)
	 $SET(.MSTYP,MS.TYP,.QONWA)
	 $SET(.OARGC,,1)
	 $SET(.OHDRS+ARG.HD,AR.LEN,OBJ.SZ+1)
	 $SET(.OHDRS+ARG.HD,AR.TYP,.OROBJ)
	$EOB
	SUBTTL	Local Definitions -- Storage to support signon file processing

TOPS20<
SONDIR:	ASCIZ	/D60:/
>  ; End of TOPS20

SONFD:	XWD	5,0		;FD for signon file
TOPS10<	SIXBIT	/D60/		;Device name
	EXP	0		;File name to be added later based on node name	
	SIXBIT	/SON/		;Extension
	EXP	0		;Path
> ; End of TOPS10
TOPS20<	BLOCK	4>		;Just leave room for ascii string for filename

SONFOB:	SONFD			;FOB for signon file
	7			;Ascii file

SONFST:	BLOCK	1		;Signon file status
				;  -1 file just open or has characters
				;   0 EOL has been found
				;  +1 EOF has been found

DEFTAB:	ASCIZ	/Red/		;Table of action taken (define or redefine)
	ASCIZ	/D/
	SUBTTL	Local Definitions -- Routine declarations

	INTERN	N$INIT		;NETWORK INITIALIZATION
	INTERN	N$NODE		;CHECK FOR NODE ONLINE/OFFLINE STATUS
	INTERN	N$GNOD		;Get the node entry
	INTERN	N$NRTE		;NETWORK ROUTING ROUTINE
	INTERN	N$CSTN		;PERFORM STATION RE-ROUTING
	INTERN	N$LOCL		;VALIDATE A LOCAL NODE NAME/NUMBER
	INTERN	N$MTCH		;SEE IF 2 NODE NAME/NUMBERS ARE EQUIVALENT
	INTERN	N$NONL		;IBM NODE ONLINE PROCESSOR
	INTERN	N$NOFF		;IBM NODE OFFLINE PROCESSOR
	INTERN	N$CKND		;Routine to check if DEFINE or SET is ok
	INTERN	N$SACT		;Routine to process signon file
	INTERN	N$PORT		;ROUTINE TO CHECK FOR MULTIPLE IBM PORT/LINES
	INTERN	N$RTAS		;CONVERT A ROUTE TABLE ENTRY TO ASCIZ
	EXTERN	G$MSG		;TEXT BUFFER
	EXTERN	CHRNME		;[25]REMOTE LPT NAME COMPARATOR
	EXTERN	G$REMN		;[27]REMOTE NODE NAME WHERE MSG CAME FROM
	EXTERN	G$NEBF		;[27]REMOTE MESSAGE FLAG
SUBTTL	N$INIT - ROUTINE TO INITIALIZE THE NETWORK DATA BASE MANAGER.

N$INIT:	$CALL	I%HOST			;GET HOST NODE NAME AND NUMBER
	MOVEM	S1,G$LNAM##		;SAVE THE LOCAL NODE NAME
	MOVEM	S2,G$LNBR##		;SAVE THE LOCAL NODE NUMBER
	PUSHJ	P,N$ANET		;CREATE A NETWORK QUEUE ENTRY
	MOVE	AP,S2			;GET ENTRY ADDRESS
	MOVX	S1,NETNSV+NETONL	;GET VALID STATUS+ONLINE
	MOVEM	S1,NETSTS(AP)		;SAVE IT
	$CALL	L%CLST			;CREATE A LIST FOR DEVICE ROUTING
	MOVEM	S1,RTEQUE		;SAVE IT
	$RETT				;RETURN
SUBTTL	N$NODE	- ROUTINE TO VERIFY THAT THE NODE IS ONLINE.

	;CALL: 	S1/A SIXBIT NODE NAME OR A NODE NUMBER
	;
	;RET:	TRUE IF ONLINE, FALSE IF OFFLINE.
	;	S1/	THE NODE NBR(-10), NODE NAME(-20)
	;	S2/	THE ENTRY ADDRESS

N$NODE:	PUSHJ	P,N$GNOD		;SEE IF THE NODE EXISTS
	JUMPT	NODE.1			;FOUND IT
	PUSHJ	P,N$NNET		;OTHERWISE, ADD NODE TO THE DATA BASE

NODE.1:	SKIPN	S1,NETCOL(S2)		;GET THE NODE ID IN S1
	$RETT				;Return if no node
	MOVE	TF,NETSTS(S2)		;GET THE STATUS BITS
	TXNN	TF,NETIBM		;Is it an IBM node?
	$RETT				;No
	TXNE	TF,NETONL		;IS IT ONLINE ???
	$RETT				;Yes
	$RETF				;No

SUBTTL	N$GNOD	- Routine to try to find (not create) a node entry

	;CALL: 	S1/A SIXBIT NODE NAME OR A NODE NUMBER
	;
	;RET:	TRUE if found
	;	S1/	preserved
	;	S2/	THE ENTRY ADDRESS
	;	
	;	FALSE if not found
	;	S1/	preserved
	;	S2/	Undefined

;  This routine will try to return the collating node name if possible,
;  otherwise either will match

N$GNOD:	$SAVE	<P1>			;SAVE P1 FOR A MINUTE
	SETZ	P1,			;Clear P1
	LOAD	S2,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST LINK
GNOD.1:	JUMPE	S2,GNOD.2		;All out, finish up
	CAMN	S1,NETCOL(S2)		;Match collating?
	JRST	GNOD.3			;Yes, go finish up
	CAMN	S1,NETLOC(S2)		;Match other?
	MOVE	P1,S2			;Yes, remember it
	LOAD	S2,.QELNK(S2),QE.PTN	;GET THE POINTER TO THE NEXT NODE.
	JRST	GNOD.1			;AND TRY IT.
GNOD.2:	SKIPN	S2,P1			;If second best found, set AP and use it
	$RETF				;Did not find it
GNOD.3:	$RETT				;Did find it
SUBTTL	Add entries to the network queue


; Add an entry to the network queue. The following will happen:
;
;	1) Any duplicate node entries will be purged
;	2) Any objects started for the duplicate entries will be purged
;	3) The ASCIZ node text NAME(NBR) will be generated
;
; Call:	MOVE	S1, sixbit node name or octal node number
;	PUSHJ	P,N$NNET
;	<RETURN>
;
;		or
;
; Call:	MOVE	S1, sixbit node name
;	MOVE	S2, octal node number (or zero)
;	PUSHJ	P,N$ANET
;	<RETURN>
;
; On return, S2:= entry address
;
N$NNET::MOVE	TF,S1			;COPY ARGUMENT
	SETZB	S1,S2			;CLEAR NODE NAME AND NUMBER
	TLNE	TF,-1			;HAVE A NODE NAME?
	SKIPA	S1,TF			;YES - LOAD IT
	MOVE	S2,TF			;NO - LOAD NODE NUMBER
					;FALL INTO COMMON CODE

N$ANET::$SAVE	<P1,P2>			;SAVE
	$SAVE	<T1,T2,T3,T4>		; LOTS
	$SAVE	<AP,E,H>		;  OF ACS

	MOVE	P1,S1			;COPY NODE NAME
	MOVE	P2,S2			;COPY NODE NUMBER

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

; First want to scan for any duplicate nodes and purge them

	MOVEI	H,HDRNET##		;POINT TO THE NETWORK QUEUE
	LOAD	AP,.QHLNK(H),QH.PTF	;GET THE FIRST ENTRY IN THE NODE DB
	SKIPA				;SKIP THE FIRST TIME THROUGH
ANET.0:	LOAD	AP,.QELNK(AP),QE.PTN	;GET THE NEXT ENTRY IN THE DATA BASE
ANET.1:	JUMPE	AP,ANET.3		;Done with purge cycle
	PUSHJ	P,CMPNOD		;COMPARE NODE NAMES AND NUMBERS
	JUMPF	ANET.0			;NOT A MATCH, GET NEXT

; Here on a match, want to purge the node entry and any related objects

	LOAD	S1,.QELNK(AP),QE.PTN	;Get the next entry
	PUSH	P,S1			;and remember it
	PUSHJ	P,M$DLNK##		;DE-LINK THIS ENTRY
	MOVE	S1,NETSTS(AP)		;PICK UP THE NODE STATUS
	TXNE	S1,NETSNA		;Wit an SNA-Workstation ???
	$CALL	SNAPUR			;Yes, go purge special objects
	TXNE	S1,NETONL		;WAS IT ONLINE ???
	JRST	ANET.2			;NO - DON'T NEED TO PURGE
	MOVEM	P1,NETNAM(AP)		;SAVE NODE NAME AND NUMBER SO
	MOVEM	P2,NETNBR(AP)		;THE PURGE IS SURE TO FIND ALL OBJECTS
	PUSHJ	P,PURGE.DUP.OBJS	;PURGE THE OBJECT QUEUE

ANET.2:	POP	P,AP			;RESTORE THE NEXT ENTRY ADDRESS
	JRST	ANET.1			;Go try for some more duplicates

; Here to add the node after deleting any previous duplicates

ANET.3:	MOVEI	H,HDRNET##		;POINT TO THE NETWORK QUEUE
	LOAD	AP,.QHLNK(H),QH.PTF	;GET THE FIRST ENTRY IN THE NODE DB
	SKIPA				;SKIP THE FIRST TIME THROUGH
ANET.4:	LOAD	AP,.QELNK(AP),QE.PTN	;GET THE NEXT ENTRY IN THE DATA BASE
	SKIPN	E,AP			;Set E in case this is where we link
	JRST	ANET.5			;Add entry to end of node data base
	PUSHJ	P,SRTNOD		;Sort
	JUMPF	ANET.4			;Not here, try next

ANET.5:	PUSHJ	P,M$GFRE##		;GET A FREE CELL FOR THE ENTRY
	MOVEM	P1,NETNAM(AP)		;SAVE THE NODE NAME
	MOVEM	P2,NETNBR(AP)		;SAVE THE NODE NUMBER
	MOVX	S1,NETADD		;GET THE ADDED BITS
	MOVEM	S1,NETSTS(AP)		;SET IT
	PUSHJ	P,M$LINK##		;LINK IT IN

	PUSHJ	P,GENNOD		;GENERATE ASCIZ NAME(NBR)
	MOVE	S2,AP			;GET ENTRY ADDRESS
	POPJ	P,			;RETURN


	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

; Delete the Node Attribute Block (NAB) and Node Object Block (NOB) List
; for an SNA-Workstation

SNAPUR:	LOAD	S1,NETNAB(AP),NA.LEN	;Length of NAB
	LOAD	S2,NETNAB(AP),NA.ADR	;Address of NAB
	SKIPE	S1			;If block is allocated,
	$CALL	M%RMEM			; release it
	MOVE	S1,NETNOB(AP)		;Index of NOB list
	JUMPN	S1,L%DLST		;Delete the list and return
	$RET

; Compare the node name in P1 and the node number in P2 with
; the node name and number in the entry pointed to by AC 'AP'
;
CMPNOD:	JUMPE	P1,CMPN.1		;ONLY NODE NUMBER?
	CAME	P1,NETNAM(AP)		;NODE NAMES MATCH?
	CAMN	P1,NETNBR(AP)		;NODE NUMBERS MATCH?
	$RETT				;YES TO EITHER
	JUMPE	P2,.RETF		;ONLY NODE NAME, NOTHING ELSE TO TRY
					;Forward and try to match P2

CMPN.1:	CAME	P2,NETNAM(AP)		;NODE NAMES MATCH?
	CAMN	P2,NETNBR(AP)		;NODE NUMBERS MATCH?
	$RETT				;YES
	$RETF				;NO


; Sort node entries

SRTNOD:	
TOPS10<	MOVE	S1,P2>			;Sort on number on the 10
TOPS20<	MOVE	S1,P1>			; and name on the 20.
	JUMPE	S1,SRTN.1		;Primary key failed
	SKIPE	NETCOL(AP)		;Any value set for this node?
	CAMG	S1,NETCOL(AP)		;Key less than entry's collating value?
	$RETT				;YES - INSERT HERE
	$RETF				;NO - DON'T INSERT YET

SRTN.1:	SKIPE	NETCOL(AP)		;The primary entry value must washout
	$RETF				;Isn't - Don't insert yet
TOPS10<	MOVE	S1,P1>			;Get secondary key
TOPS20<	MOVE	S1,P2>
	SKIPE	NETLOC(AP)		;Any value set for this node?
	CAMG	S1,NETLOC(AP)		;VALUE LESS THAN ENTRY'S?
	$RETT				;YES - INSERT HERE
	$RETF				;NO - DON'T INSERT YET


; Generate ASCIZ node name and number
; NETASC(AP):= node text for most displays
; NETCLM(AP):= node text for columnized displays
;
GENNOD:	SKIPN	S1,NETCOL(AP)		;GET COLLATING
	MOVE	S1,NETLOC(AP)		;NO GOOD, TRY THE OTHER
	$TEXT	(<-1,,NETASC(AP)>,<^N/S1/^0>)
TOPS10<	MOVEI	S1,[ITEXT (<(^O/NETNBR(AP)/)>)]> ;ASSUME NODE NUMBER FOR 10
TOPS20<	MOVEI	S1,[ITEXT (<(^N/NETNBR(AP)/)>)]> ;ASSUME NAME/NUMBER FOR 20
	SKIPN	NETNBR(AP)		;CHECK
	MOVEI	S1,[ITEXT (<     >)]	;JUST A NAME
	$TEXT	(<-1,,NETCLM(AP)>,<^W6L /NETNAM(AP)/ ^I/(S1)/^0>)
	POPJ	P,			;RETURN
	SUBTTL	N$NRTE - ROUTINE TO PROCESS OPERATOR ROUTE MESSAGES

	;CALL:	M/ The Message Address
	;
	;RET:	True Always

N$NRTE:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	DOSCHD				;FORCE A SCHEDULING PASS
	MOVX	S1,.RTEFM		;GET 'FROM' OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE BLOCK ADDRESS
	SETZM	P2			;CLEAR P2
	MOVX	S1,.RTETO		;GET 'TO' OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	SKIPF				;NOT THERE,,SKIP
	MOVE	P2,S1			;SAVE THE BLOCK ADDRESS
	PUSHJ	P,NRTE.A		;VALIDATE THE 'FROM'/'TO' OBJ BLOCKS
	JUMPF	.POPJ			;[25]NO GOOD,,THATS AN ERROR
	MOVE	S1,P1			;GET THE SOURCE OBJ BLOCK ADDRESS
	PUSHJ	P,FNDRTE		;GO FIND THE ROUTE TABLE ENTRY
	JUMPF	[JUMPE P2,E$RTE##	;IF NO 'TO' OBK BLK,,THATS AN ERROR
		 JUMPN S1,NRTE.4	;ADD BEFORE THE CURRENT ENTRY
		 JRST  NRT.4A ]		;ELSE ADD AFTER THE CURRENT ENTRY
	MOVE	P3,S1			;SAVE THE ENTRY ADDRESS

	;Here to update a route table entry

	JUMPE	P2,NRTE.6		;JUMP IF DELETING THIS TABLE ENTRY
	MOVSI	S1,0(P2)		;GET SOURCE,,0
	HRRI	S1,RTEOB2(P3)		;GET SOURCE,,DESTINATION FOR BLT
	BLT	S1,RTEOB2+RFDLEN-1(P3)	;[25]COPY NEW 'TO' FIELD INTO TABLE
	JRST	NRTE.5			;AND EXIT

	;Here to add an entry to the route table

NRTE.4:	MOVE	S1,RTEQUE		;GET THE ROUTE TABLE ID
	MOVX	S2,RTELEN		;GET THE TABLE ENTRY LENGTH
	PUSHJ	P,L%CBFR		;CREATE A NEW TABLE ENTRY
	JRST	NRT.4B			;LETS MEET AT THE PASS

NRT.4A:	MOVE	S1,RTEQUE		;GET THE ROUTE TABLE ID
	MOVX	S2,RTELEN		;GET THE TABLE ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE A NEW TABLE ENTRY

NRT.4B:	SKIPT				;Did we get an entry successfully?
	PUSHJ	P,S..CCE##		;Stop if not
	MOVE	P3,S2			;SAVE THE ENTRY ADDRESS
	MOVSI	S1,0(P1)		;GET SOURCE,,0
	HRRI	S1,RTEOB1(P3)		;GET SOURCE,,DESTINATION FOR BLT
	BLT	S1,RTEOB1+RFDLEN-1(P3)	;[25]COPY NEW 'FROM' FIELD INTO TABLE
	MOVSI	S1,0(P2)		;GET SOURCE,,0
	HRRI	S1,RTEOB2(P3)		;GET SOURCE,,DESTINATION FOR BLT
	BLT	S1,RTEOB2+RFDLEN-1(P3)	;[25]COPY NEW 'TO' FIELD INTO  TABLE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

NRTE.5:	MOVE	S1,P3			;GET THE ENTRY ADDRESS
	PUSHJ	P,N$RTAS		;GEN THE ROUTE TEXT
	$QACK	( ^T/G$MSG/ ,,,.MSCOD(M)) ;SEND IT OFF
	$RETT				;RETURN

	;Here to delete a route table entry

NRTE.6:	MOVE	S1,[POINT 7,G$MSG]	;GET BYTE POINTER TO TEXT BUFFER
	MOVEM	S1,NETPTR		;AND SAVE IT
	MOVE	S1,P3			;POINT TO THE TABLE ENTRY
	PUSHJ	P,GENFRM		;GENERATE THE 'FROM' DESCRIPTION
	SETZM	S1			;GET A NULL BYTE
	PUSHJ	P,NETBYT		;MAKE THE DESCRIPTION ASCIZ
	MOVE	S1,RTEQUE		;GET THE ROUTE TABLE ID
	PUSHJ	P,L%DENT		;DELETE THE ENTRY
	$QACK	(Routing for ^T/G$MSG/ Deleted,,,.MSCOD(M)) ;TELL OPR
	$RETT				;AND RETURN

	;Here to validate the object blocks passed in the ROUTE message

	;CALL:	P1/ The 'FROM' object block address
	;	P2/ The 'TO' object block address or 0
	;
	;RET:	True if blocks are valid, False otherwise

NRTE.A:	$SAVE	<P3>			;[25]SAVE THIS AC
	MOVE	S1,OBJ.TY(P1)		;GET THE 'FROM' OBJECT TYPE
	MOVE	P3,S1			;[25]SAVE FOR LATER
	TXZ	S1,<1B0>		;CLEAR SIGN BIT
	CAXN	S1,.INFIN		;[25]IS THIS ALL DEVICES ???
	JRST	NRT.A1			;[25]YES, SKIP THE FOLLOWING
	HRRZS	S1			;[25]ISOLATE THE OBJECT TYPE
	CAXG	S1,.OTMAX		;[25]IS IT A VALID OBJECT TYPE?
	SKIPA				;SKIP IF ALL DEVICES OR GOOD OBJECT
	JRST	E$ISO##			;RETURN INVALID SOURCE OBJECT !!!
	MOVE	S1,P3			;[25]RESTORE THE OJBECT TYPE WORD
NRT.A1:	MOVEM	S1,OBJ.TY(P1)		;[25]SAVE THE OBJECT TYPE
	JUMPE	P2,NRT.A3		;[25]NO 'TO' OBJECT BLOCK,,SKIP THIS
	MOVE	S2,OBJ.TY(P2)		;GET THE 'TO' OBJECT TYPE
	MOVE	P3,S2			;[25]SAVE FOR LATER
	TXZ	S2,<1B0>		;CLEAR SIGN BIT
	CAXN	S2,.INFIN		;[25]IS THIS ALL DEVICES?
	JRST	NRT.A2			;[25]YES, SKIP THE FOLLOWING
	HRRZS	S2			;[25]ISOLATE THE OBJECT TYPE
	CAXG	S2,.OTMAX		;NO,,IS IT A VALID OBJECT TYPE ???
	SKIPA				;SKIP IF ALL DEVICES OR GOOD OBJECT
	JRST	E$IDO##			;RETURN INVALID DESTINATION OBJECT !!!
	MOVE	S2,P3			;[25]RESTORE THE OBJECT TYPE
NRT.A2:	MOVEM	S2,OBJ.TY(P2)		;[25]SAVE THE OBJECT TYPE
	HRRZS	S2			;[25]ISOLATE THE OJBECT TYPE
	LOAD	S1,OBJ.TY(P1),AR.TYP	;[25]PICK UP THE OBJECT TYPE
	CAME	S1,S2			;OBJECT TYPES MUST MATCH !!!
	JRST	E$IDO##			;NO,,RETURN INVALID DESTINATION OBJ !!

NRT.A3:	MOVE	S1,OBJ.UN(P1)		;[25]GET THE 'FROM' UNIT
	TXZ	S1,<1B0>		;CLEAR SIGN BIT
	CAXE	S1,.INFIN		;IS THIS ALL DEVICES ???
	CAXG	S1,77			;NO,,IS IT A VALID UNIT NUMBER ???
	SKIPA				;SKIP IF ALL DEVICES OR GOOD UNIT
	JRST	E$ISO##			;RETURN INVALID SOURCE OBJECT !!!

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVEM	S1,OBJ.UN(P1)		;SAVE THE OBJECT UNIT
	MOVE	S2,OBJ.TY(P1)		;GET THE 'FROM' OBJECT TYPE
	CAXN	S2,.INFIN		;IF 'ALL' DEVICES, THEN
	CAXN	S1,.INFIN		;CANNOT SPECIFY SPECIFIC UNITS 
	SKIPA				;VALID,,CONTINUE
	JRST	E$CRG##			;NO, THAT'S AN ERROR
	JUMPE	P2,NRT.A4		;NO 'TO' OBJECT BLOCK,,SKIP THIS
	MOVE	S2,OBJ.UN(P2)		;GET THE 'TO' OBJECT UNIT
	TXZ	S2,<1B0>		;CLEAR SIGN BIT
	CAXE	S2,.INFIN		;IS THIS ALL UNITS ???
	CAXG	S2,77			;NO,,IS IT A VALID UNIT NUMBER ???
	SKIPA				;SKIP IF ALL DEVICES OR GOOD UNIT
	JRST	E$IDO##			;RETURN INVALID SOURCE OBJECT !!!
	MOVEM	S2,OBJ.UN(P2)		;SAVE THE OBJECT TYPE
	CAXN	S1,.INFIN		;IF SOURCE UNIT IS 'ALL' THEN
	CAXN	S2,.INFIN		;   DESTINATION UNIT MUST BE 'ALL' !!!
	SKIPA				;VALID UNIT,,SKIP
	JRST	E$CRG##			;NO,,CAN'T ROUTE A GENERIC UNIT !!!

NRT.A4:	MOVE	S1,OBJ.ND(P1)		;GET THE 'FROM' OBJECT NODE
	CAMN	S1,[-1]			;IS IT ALL NODES ???
	TXZ	S1,<1B0>		;YES,,CLEAR SIGN BIT
	MOVEM	S1,OBJ.ND(P1)		;SAVE THE NODE NAME/NUMBER
	CAXN	S1,.INFIN		;IS THIS ALL NODES ???
	JRST	.+3			;YES,,SKIP OVER N$NODE CALL
	PUSHJ	P,N$NODE		;FIND/ADD THE NODE IN/TO OUR DATA BASE
	MOVEM	S1,OBJ.ND(P1)		;AND SAVE IT
	JUMPE	P2,NRT.A5		;NO 'TO' OBJECT BLOCK,,RETURN
	MOVE	S1,OBJ.ND(P2)		;GET THE 'TO' OBJECT NODE
	CAMN	S1,[-1]			;IS IT ALL NODES ???
	JRST	E$IDO##			;YES,,THATS AN ERROR !!!
	PUSHJ	P,N$NODE		;FIND/ADD THE NODE IN/TO OUR DATA BASE
	MOVEM	S1,OBJ.ND(P2)		;AND SAVE IT

;CHECK FOR REMOTE PRINTER NAME BLOCKS

NRT.A5:	MOVE	S1,P1			;[25]PICK UP THE OBJECT BLOCK ADDRESS
	$CALL	N$LPTN			;[25]CHECK FOR A LPT NAME BLOCK
	JUMPT	NRT.A6			;[25]A CORRECTLY FORMATTED NAME BLOCK
	SKIPL	S1			;[25]WAS AN ERROR DETECTED?
	$RET				;[25]YES, PASS ERROR ON

NRT.A6:	JUMPE	P2,.RETT		;[25]RETURN NOW IF NO 'TO' BLOCK
	MOVE	S1,P2			;[25]PICK UP THE 'TO' OBJECT BLOCK ADR
	$CALL	N$LPTN			;[25]CHECK FOR A LPT NAME BLOCK
	JUMPT	.POPJ			;[25]RETURN ON SUCCESS
	SKIPL	S1			;[25]WAS AN ERROR DETECTED?
	$RET				;[25]YES, PASS IT ON
	$RETT				;[25]NO NAME BLOCK DETECTED
	SUBTTL	N$LPTN - CHECK FORMAT OF A LPT NAME BLOCK

;**;[25]N$LPTN IS A PART OF THIS EDIT
;N$LPTN is called to determine if the object block is a remote LPT
;object block. If it is, then N$LPTN validates the format of the name
;block.
;
;Call is:       P1/Address of the first data word of a object block.

;Returns true:  The object is a remote LPT which has a correctly formatted
;               name block
;Returns false: S1/-1  The object is not a remote LPT
;               S1/0   The object is a remote LPT with an incorrectly formatted
;                      name block.

N$LPTN:	MOVE	S1,OBJ.TY(P1)		;PICK UP THE OJBECT WORD
	HRRZ	S2,S1			;ISOLATE THE OBJECT TYPE
	CAIE	S2,.OTLPT		;IS IT A LPT?
	JRST	N$LPT9			;NO, GO INDICATE SO
	TXNN	S1,.DQLPT		;IS THIS A DQS LPT?
	JRST	N$LPT2			;NO, CHECK FOR A LAT LPT
	LOAD	S1,-1(P1),AR.LEN	;PICK UP THIS BLOCK'S LENGTH
	ADDI	S1,-1(P1)		;POINT TO THE NEXT BLOCK
	LOAD	S2,ARG.HD(S1),AR.TYP	;PICK UP THE BLOCK TYPE
	CAIN	S2,.KYDQS		;IS THIS A DQS VMS QUEUE NAME?
	JRST	N$LPT1			;YES, CHECK ITS LENGTH
	$CALL	E$ISO##			;NO, THAT'S AN ERROR
	JRST	N$LPT8			;RETURN WITH AN ERROR
N$LPT1:	LOAD	S2,ARG.HD(S1),AR.LEN	;PICK UP ITS LENGTH
	CAIL	S2,2			;MUST BE AT LEAST TWO WORDS
	JRST	N$LPT7			;RETURN WITH SUCCESS
	$CALL	E$ISO##			;INVALID LENGTH
	JRST	N$LPT8			;RETURN WITH AN ERROR
N$LPT2: TXNN	S1,.LALPT		;IS THIS A LAT LPT?
	JRST	N$LPT9			;NO, INDICATE NOT A REMOTE LPT
	LOAD	S1,-1(P1),AR.LEN	;PICK UP THIS BLOCK'S LENGTH
	ADDI	S1,-1(P1)		;POINT TO THE NEXT BLOCK
	LOAD	S2,ARG.HD(S1),AR.TYP	;PICK UP THE BLOCK TYPE
	CAIN	S2,.KYSER		;IS IT A SERVICE NAME?
	JRST	N$LPT6			;YES, CHECK FOR A VALID LENGTH
	CAIN	S2,.KYPOR		;IS IT A PORT NAME?
	JRST	N$LPT6			;YES, CHECK ITS LENGTH
	$CALL	E$IDO##			;NO, THAT'S AN ERROR
	JRST	N$LPT8			;INDICATE AN ERROR
N$LPT6:	LOAD	S2,ARG.HD(S1),AR.LEN	;PICK UP ITS LENGTH
	CAIL	S2,2			;MUST BE AT LEAST TWO WORDS
N$LPT7:	$RETT				;INDICATE SUCCESS
	$CALL	E$IDO##			;INVALID LENGTH
N$LPT8:	SETZ	S1,			;INDICATE INVALID FORMAT
	$RETF				;INDICATE ERROR 
N$LPT9:	SETO	S1,			;INDICATE NOT A LPT
	$RETF				;RETURN TO CALLER
	SUBTTL	FNDRTE - FOUND A ROUTE TABLE ENTRY

	;CALL:	S1/ The source object block address
	;
	;RET:	True  S1/ The entry address if entry was found
	;	False S1/ 0  if add a new entry after current
	;	      S1/ -1 if Add a new entry before current

FNDRTE::$SAVE	<P1,P2>			;[33]SAVE THESE AC
	MOVE	P1,S1			;SAVE THE SOURCE OBJ ADDRESS
	MOVE	S1,RTEQUE		;GET THE ROUTE QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	FNDR.2			;JUMP THE FIRST TIME THROUGH

FNDR.1:	MOVE	S1,RTEQUE		;GET THE ROUTE TABLE QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
FNDR.2:	JUMPF	[SETZ S1,		;NO MORE,,LITE 'AFTER' RETURN CODE
		 $RETF ]		;AND RETURN
	MOVE	P2,S2			;SAVE THE ENTRY ADDRESS
	MOVE	S1,OBJ.ND(P1)		;GET THE SOURCE NODE NAME/NUMBER
	MOVE	S2,OBJ.ND(P2)		;GET THE OBJECT NODE NAME/NUMBER
	CAMN	S1,S2			;DO THEY MATCH ???
	JRST	FNDR.3			;YES,,CONTINUE ONWARD !!!
	CAXN	S1,.INFIN		;IS IT 'ALL' SOURCE NODES ???
	JRST	FNDR.1			;YES,,TRY NEXT ENTRY
	CAXN	S2,.INFIN		;IS IT 'ALL' ENTRY NODES ???
	JRST	[SETO S1,		;YES,,END OF THE LINE !!!
		 $RETF ]		;SO RETURN 
	PUSHJ	P,N$MTCH		;ADD NODE TO DATA BASE IF NECESSARY
	JUMPT	FNDR.3			;YES,,CONTINUE ONWARD
	MOVE	S1,OBJ.ND(P1)		;NO,,GET THE SOURCE NODE NAME/NUMBER
	CAML	S1,OBJ.ND(P2)		;STILL IN RANGE ???
	JRST	FNDR.1			;YES,,TRY NEXT ENTRY
	JRST	[SETO S1,		;NO, SET 'BEFORE' RETURN CODE
		 $RETF ]		;AND RETURN

FNDR.3:	LOAD	S1,OBJ.TY(P1),AR.TYP	;[25]GET THE SOURCE OBJECT TYPE
	LOAD	S2,OBJ.TY(P2),AR.TYP	;[25]GET OBJECT TYPE FROM TABLE ENTRY
	CAMLE	S1,S2			;[25]LESS OR MATCH ???
	JRST	FNDR.1			;NO,,TRY NEXT ENTRY
	CAME	S1,S2			;[25]DO WE MATCH ???
	JRST	[SETO S1,		;NO,,SET 'BEFORE' RETURN CODE
		 $RETF ]		;AND RETURN
	CAIE	S1,.OTLPT		;[25]IS THIS A LPT OBJECT
	JRST	FNDR.6			;[25]NO, CHECK UNITS	

	HLLZ	S1,OBJ.TY(P1)		;[25]PICK UP THE TYPE OF LPT
	ROT	S1,PRIVAL		;[25]TRANSLATE TO PRIORITY VALUE
	HLLZ	S2,OBJ.TY(P2)		;[25]PICK UP THE TYPE OF LPT
	ROT	S2,PRIVAL		;[25]TRANSLATE TO PRIORITY VALUE
	CAMGE	S1,S2			;[25]IS NEW OBJECT OF HIGHER PRIORITY?
	JRST	[SETO S1,		;[25]YES, INDICATE LINK IN BEFORE
		 $RETF ]		;[25]RETURN 
	CAME	S1,S2			;[25]IS NEW OBJECT OF LOWER PRIORITY?
	JRST	FNDR.1			;[25]YES, PICK UP THE NEXT TABLE ENTRY

;THE OBJECTS ARE BOTH LPTS OF THE SAME TYPE

	SKIPN	S1			;[25]IS THIS A LOCAL LPT?
	JRST	FNDR.6			;[25]YES, TREAT AS OTHER OBJECTS
	CAIN	S1,.CLPRI		;[25]IS THIS A CLUSTER LPT?
	JRST	FNDR.6			;[25]YES, TREAT AS OTHER OBJECTS
	CAIE	S1,.DQPRI		;[25]IS THIS A DQS LPT?
	JRST	FNDR.4			;[25]NO, IT IS A LAT LPT

;BOTH ARE DQS LPTS. CHECK THE VMS QUEUE NAMES

	$CALL	RTENAM 			;[25]COMPARE THE QUEUE NAMES
	JUMPT	FNDR.7			;[25]THE ENTRY ADDRESS HAS BEEN FOUND
	SKIPL	S1			;[25]LINK IN NOW?
	JRST	FNDR.1			;[25]NO, CHECK THE NEXT TABLE ENTRY
	$RETF				;[25]YES, INDICATE TO THE CALLER

;BOTH ARE LAT LPTS. PORTS HAVE HIGHER PRIORITY THAN SERVICES

FNDR.4:	LOAD	S1,OBJ.SZ(P1),AR.TYP	;[25]PICK UP THE NAME TYPE
	LOAD	S2,OBJ.SZ(P2),AR.TYP	;[25]PICK UP THE NAME TYPE	
	CAMN	S1,S2			;[25]ARE THEY THE SAME?
	JRST	FNDR.5			;[25]YES, CHECK FOR NAMES
	CAIE	S1,.KYPOR		;[25]PORT NAME SPECIFIED?
	JRST	FNDR.1			;[25]NO, SEARCH NEXT TABLE ENTRY
	SETO S1,			;[25]INDICATE LINK IN BEFORE
	$RETF				;[25]RETURN TO THE CALLER

;LAT PRINTERS WITH SAME TYPE (PORT AND PORT, OR SERVICE AND SERVICE)

FNDR.5:	$CALL	RTENAM			;[25]COMPARE THE NAMES
	JUMPT	FNDR.7			;[25]THE TABLE ENTRY HAS BEEN FOUND
	SKIPL	S1			;[25]LINK IN NOW?
	JRST	FNDR.1			;[25]NO, CHECK THE NEXT TABLE ENTRY
	$RETF				;[25]YES, INDICATE TO THE CALLER

FNDR.6:	MOVE	S1,OBJ.UN(P1)		;[25]GET THE SOURCE UNIT NUMBER
	CAMLE	S1,OBJ.UN(P2)		;LESS OR MATCH ???
	JRST	FNDR.1			;NO,,TRY NEXT ENTRY
	CAME	S1,OBJ.UN(P2)		;DO WE MATCH ???
	JRST	[SETOM S1		;NO,,SET 'BEFORE' RETURN CODE
		 $RETF ]		;AND RETURN
FNDR.7:	MOVE	S1,P2			;[25]GET THE ENTRY ADDRESS
	$RETT				;AND RETURN
	SUBTTL	RTENAM - COMPARE TWO NAMES OF LPT OBJECTS IN ROUTE TABLE

;**;[25]RTENAM IS A PART OF THIS EDIT
;RTENAM is called as part of determining where a remote LPT object is to
;be placed in the route table.
;
;Call is:       P1/ Address of the first word of object block
;               P2/ Address of current table entry object block
;Returns true: The names are equal
;Returns false: S1/ -1 Link in the new entry before the current entry
;               S2/  0 Continue the search

RTENAM:	MOVEI	S1,OBJ.SZ(P1)		;ADDRESS OF THE NAME BLOCK
	MOVEI	S2,OBJ.SZ(P2)		;ADDRESS OF THE NAME BLOCK
	$CALL	CHRNME##		;COMPARE THE NAMES
	JUMPT	.POPJ			;NAMES ARE EQUAL
	TXNN	S1,SC%GTR		;IS THE NEW NAME GREATER?
	JRST	RTEN.1			;NO, LINK IN BEFORE CURRENT ENTRY
	SETZ	S1,			;INDICATE TO CONTINUE SEARCH
	$RETF				;RETURN
RTEN.1:	SETO	S1,			;INIDCATE LINK IN BEFORE CURRENT ENTRY
	$RETF				;RETURN
	SUBTTL	N$RTAS - ROUTINE TO CONVERT A ROUTE TABLE ENTRY TO ASCIZ

	;CALL:	S1/ The table Entry Address
	;
	;RET:	G$MSG/ The Asciz Description


N$RTAS:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE TABLE ENTRY ADDRESS
	MOVE	S1,[POINT 7,G$MSG]	;GET A BYTE POINTER TO THE BUFFER
	MOVEM	S1,NETPTR		;SAVE IT FOR $TEXT
	MOVEI	S1,RTEOB1(P1)		;POINT TO THE 'FROM' OBJECT BLOCK
	PUSHJ	P,GENFRM		;GEN THE 'FROM' TEXT
	MOVEI	S1,RTEOB2(P1)		;POINT TO THE 'TO' OBJECT BLOCK
	PUSHJ	P,GENTOO		;GEN TO 'TO' TEXT
	$RETT				;RETURN
	SUBTTL	GENFRM - ROUTINE TO GENERATE 'FROM' ROUTE TABLE DESCRIPTIONS

	;CALL:	S1/ The Route Table Object Block Address
	;
	;RET:	G$MSG/ The Asciz Text Description

GENFRM:	$SAVE	<P1,P2,P3>		;[25]SAVE THESE AC
	MOVE	P1,S1			;SAVE THE OBJECT BLOCK ADDRESS
	MOVEI	P2,1			;DEFAULT TO ALL DEVICES
	MOVE	S1,OBJ.TY(P1)		;GET THE OBJECT TYPE
	MOVE	S2,OBJ.UN(P1)		;GET THE UNIT NUMBER
	CAXN	S1,.INFIN		;IS THIS ALL DEVICES ???
	CAXE	S2,.INFIN		;   AND ALL UNITS ???
	SKIPA				;NO TO EITHER,,SKIP
	JRST	GENF.1			;YES,,SKIP THIS
	CAXN	S2,.INFIN		;IS IT ALL UNITS ???
	MOVEI	P2,2			;YES,,GET CODE
	CAXE	S2,.INFIN		;IS IT A PARTICULAR UNIT ???
	MOVEI	P2,3			;YES,,GET CODE
	HLLZ	S1,OBJ.TY(P1)		;[25]PICK UP THE LPT TYPE
	SKIPN	S1			;[25]IS IT A REMOTE LPT?
	JRST	GENF.1			;[25]NO, CHECK FOR A NODE NAME
	LOAD	P3,OBJ.TY(P1),AR.TYP	;[25]PICK UP JUST .OTLPT
	TXNE	S1,.CLLPT		;[25]A CLUSTER LPT?
	MOVEI	P2,7			;[25]YES, PICK UP ITS OFFSET VALUE
	TXNE	S1,.DQLPT		;[25]A DQS LPT?
	MOVEI	P2,8			;[25]YES, PICK UP ITS OFFSET VALUE
	TXNN	S1,.LALPT		;[25]A LAT PRINTER?
	JRST	GENF.1			;[25]NO, PICK UP NODE NAME
	LOAD	S1,OBJ.SZ(P1),AR.TYP	;[25]PICK UP THE NAME TYPE
	MOVEI	P2,9			;[25]ASSUME IT IS A PORT
	CAIE	S1,.KYPOR		;[25]IS IT?
	MOVEI	P2,^D10			;[25]NO, IT IS A SERVICE
GENF.1:	MOVE	S1,OBJ.ND(P1)		;GET THE NODE NAME/NUMBER
	MOVEI	S2,4			;DEFAULT TO A PARTICULAR NODE
	CAXN	S1,.INFIN		;IS IT ALL NODES ???
	MOVEI	S2,5			;YES,,GET CODE
	$TEXT	(NETBYT,<^I/@RTEASC(P2)/^I/@RTEASC(S2)/^A>)
	$RETT				;RETURN

GENTOO:	$SAVE	<P1,P3>			;[25]SAVE THESE AC
	MOVE	P1,S1			;SAVE THE 'TO' OBJECT BLOCK ADDRESS
	MOVEI	S1,4			;DEFAULT TO 'TO NODE XXX'
	MOVX	S2,.INFIN		;GET 'ALL' CODE
	CAMN	S2,OBJ.TY(P1)		;[25]'ALL' OBJECTS ???
	JRST	GENT.1			;[25]YES, PLACE TEXT IN MESSAGE
	CAMN	S2,OBJ.UN(P1)		;   OR 'ALL' UNITS ???
	JRST	GENT.1			;[25]YES, PLACE TEXT IN MESSAGE
	MOVEI	S1,6			;ELSE A SPECIFIC DEVICE !!!
	HLLZ	S2,OBJ.TY(P1)		;[25]PICK UP THE LPT TYPE
	SKIPN	S2			;[25]IS IT A REMOTE LPT?
	JRST	GENT.1			;[25]NO, PLACE TEXT IN MESSAGE
	LOAD	P3,OBJ.TY(P1),AR.TYP	;[25]PICK UP JUST .OTLPT
	TXNE	S2,.CLLPT		;[25]A CLUSTER LPT?
	MOVEI	S1,^D11			;[25]YES, PICK UP ITS OFFSET VALUE
	TXNE	S2,.DQLPT		;[25]A DQS LPT?
	MOVEI	S1,^D12			;[25]YES, PICK UP ITS OFFSET VALUE
	TXNN	S2,.LALPT		;[25]A LAT PRINTER?
	JRST	GENT.1			;[25]NO, OUTPUT THE TEXT
	LOAD	S2,OBJ.SZ(P1),AR.TYP	;[25]PICK UP THE NAME TYPE
	MOVEI	S1,^D13			;[25]ASSUME IT IS A PORT
	CAIE	S2,.KYPOR		;[25]IS IT?
	MOVEI	S1,^D14			;[25]NO, IT IS A SERVICE
	
GENT.1:	$TEXT	(NETBYT,< Routed to ^I/@RTEASC(S1)/^0>) ;FINISH TEXT
	$RETT				;AND RETURN

RTEASC:	[0,,0]				;ZERO OFFSET IS INVALID
	[ITEXT(All Devices )]		;ALL DEVICES ...
	[ITEXT(All ^1/OBJ.TY(P1)/s )]	;ALL PRINTERS, ETC...
	[ITEXT(^1/OBJ.TY(P1)/ ^D/OBJ.UN(P1)/ )] ;PRINTER X ...
	[ITEXT([^N/OBJ.ND(P1)/])] 	;ON NODE XXX...
	[ITEXT(on all Nodes)]		;ON ALL NODES
	[ITEXT(^I/@RTEASC+3/^I/@RTEASC+4/)] ;...PRINTER XXX ON NODE YYY
	[ITEXT(Cluster ^1/P3/ ^D/OBJ.UN(P1)/ )] ;[25]CLUSTER LPT
	[ITEXT(DQS ^1/P3/ ^T/OBJ.SZ+1(P1)/ )] ;[25]DQS LPT
	[ITEXT(LAT ^1/P3/ PORT ^T/OBJ.SZ+1(P1)/ )] ;[25]LAT/PORT 
	[ITEXT(LAT ^1/P3/ SERVICE ^T/OBJ.SZ+1(P1)/ )] ;[25]LAT/SERVICE
	[ITEXT(^I/@RTEASC+7/ ^I/@RTEASC+4/)] 	 ;[25]CLUSTER LPT
	[ITEXT(^I/@RTEASC+8/ ^I/@RTEASC+4/)] 	 ;[25]DQS LPT
	[ITEXT(^I/@RTEASC+9/ ^I/@RTEASC+4/)]	 ;[25]LAT/PORT LPT
	[ITEXT(^I/@RTEASC+^D10/ ^I/@RTEASC+4/)] ;[25]LAT/SERVICE LPT
	SUBTTL	N$CSTN - PERFORM DEVICE ROUTINE AND DEVICE CHECKING

	;CALL:	S1/ The .QEROB Address
	;	S2/ The OBJTYP object block address OR 0
	;
	;RET:	If S2 = 0 then return through N$NODE
	;

N$CSTN:	PUSHJ	P,.SAVE4		;SAVE P1 AND P2 AND P3 AND P4
	DMOVE	P1,S1			;SAVE THE OBJ BLOCK ADDRESSES
	LOAD	S1,.ROBTY(P1),AR.TYP	;[26]GET THE OBJECT TYPE
	CAXN	S1,.OTBAT		;IS IT BATCH ???
	JRST	CSTN12			;[26]YES, JUST CHECK ATTRIBUTES
	MOVE	S1,RTEQUE		;GET THE ROUTE QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	CSTN.2			;JUMP THE FIRST TIME THROUGH

CSTN.1:	MOVE	S1,RTEQUE		;GET THE ROUTE TABLE QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
CSTN.2:	JUMPF	CSTN12			;[26]NOT THERE, CHECK DEVICE ATTRIBUTES
	MOVE	P3,S2			;SAVE THE ENTRY ADDRESS
	MOVE	S1,.ROBND(P1)		;GET THE SOURCE NODE NAME/NUMBER
	MOVE	S2,OBJ.ND(P3)		;GET THE OBJECT NODE NAME/NUMBER
	CAXN	S2,.INFIN		;IS IT 'ALL' ENTRY NODES ???
	JRST	CSTN.3			;YES,,CONTINUE ONWARD !!!
	PUSHJ	P,QOMTCH		;DO THE NODE IDS MATCH ???
	JUMPT	CSTN.3			;YES,,CONTINUE ONWARD
	MOVE	S1,.ROBND(P1)		;NO,,GET THE SOURCE NODE NAME/NUMBER
	CAML	S1,OBJ.ND(P3)		;STILL IN RANGE ???
	JRST	CSTN.1			;YES,,TRY NEXT ENTRY
	JRST	CSTN12			;[26]NOT THERE, CHECK DEVICE ATTRIBUTES

CSTN.3:	MOVE	S2,OBJ.TY(P3)		;[26]GET THE ENTRY OBJECT TYPE
	CAXN	S2,.INFIN		;[26]IS IT 'ALL' DEVICES ???
	JRST	CSTN.9			;[26]YES, CHECK THE OBJECT TYPES
CSTN.4:	LOAD	S1,.ROBTY(P1),AR.TYP	;[26]PICK UP THE SOURCE OBJECT TYPE
	LOAD	S2,OBJ.TY(P3),AR.TYP	;[26]PICK UP THE ENTRY OBJECT TYPE
	CAMLE	S1,S2			;LESS OR MATCH ???
	JRST	CSTN.1			;NO,,TRY NEXT ENTRY
	CAME	S1,S2			;DO WE MATCH ???
	JRST	CSTN12			;[26]NOT THERE, CHECK DEVICE ATTRIBUTES
	CAIE	S1,.OTLPT		;[26]IS THIS A LPT OBJECT?
	JRST	CSTN.9			;[26]NO, GO CHECK THE UNIT NUMBER
	
	HLLZ	S1,.ROBTY(P1)		;[26]PICK UP THE QE'S LPT TYPE
	ROT	S1,PRIVAL		;[26]DETERMINE ITS PRIORITY
	HLLZ	S2,OBJ.TY(P3)		;[26]PICK UP ENTRY'S LPT TYPE
	ROT	S2,PRIVAL		;[26]DETERMINE ITS PRIORITY
	CAMN	S1,S2			;[26]SAME PRIORITY?
	JRST	CSTN.7			;[26]YES, QE AND ENTRY TYPES THE SAME
	CAIE	S1,.UNPRI		;[26]IS THE QE AN UNKNOWN REMOTE TYPE?
	JRST	CSTN.5			;[26]NO, CHECK IF TYPE IS 0
	MOVE	S1,OBJ.TY(P3)		;[26]PICK UP THE ENTRY'S LPT TYPE 
	TXNN	S1,.DQLPT!.LALPT	;[26]IS IT A DQS OR LAT LPT?
	JRST	CSTN.1			;[26]NO, GO CHECK THE NEXT ENTRY
	JRST	CSTN.8			;[26]YES, CHECK IF NAMES ARE THE SAME

CSTN.5:	SKIPN	S1			;[26]REMOTE LPT TYPE SPECIFIED?
	JRST	CSTN.6			;[26]NO, MAY MATCH CLUSTER OR REMOTE
	CAML	S1,S2			;[26]IS THE QE TYPE LESS THAN ENTRY'S?
	JRST	CSTN.1			;[26]NO, GO CHECK NEXT ENTRY
	JRST	CSTN12			;[26]NOT IN THE ROUTE TABLE

CSTN.6:	TXNE	S2,.CLLPT		;[26]IS ENTRY A CLUSTER LPT TYPE?
	JRST	CSTN.9			;[26]YES, CHECK UNIT SPECIFIED
	LOAD	S1,.ROBAT(P1),RO.ATR	;[26]PICK UP QE'S ATTRIBUTES
	CAIN	S1,%PHYCL		;[26]WAS A UNIT SPECIFIED?
	JRST	CSTN.1			;[26]YES, GO CHECK NEXT ENTRY
	MOVEI	S1,ROBSIZ(P1)		;[26]WHERE TO PLACE NAME BLOCK IN QE
	HRLI	S1,OBJ.SZ(P3)		;[26]SOURCE,,DESTINATION
	MOVEI	S2,ROBSIZ+LPTNLN(P1)	;[26]FINAL DESTINATION ADDRESS + 1
	BLT	S1,-1(S2)		;[26]COPY NAME BLOCK INTO QE
	MOVE	S1,OBJ.TY(P3)		;[26]PICK UP FULL LPT TYPE
	MOVEM	S1,.ROBTY(P1)		;[26]PLACE IN THE QE
	JRST	CSTN10			;[26]CHECK IF OBJECT MATCHES ROUTED

CSTN.7:	SKIPN	S1			;[26]IS THE QE FOR A LOCAL LPT?
	JRST	CSTN.9			;[26]YES, GO CHECK THE UNIT
	TXNE	S1,.CLLPT		;[26]IS THE QE FOR A CLUSTER LPT?
	JRST	CSTN.9			;[26]YES, GO CHECK THE UNIT
	CAIE	S1,.LAPRI		;[26]IS THE QE FOR A LAT LPT?
	JRST	CSTN.8			;[26]NO, GO CHECK IF NAMES MATCH
	LOAD	S1,ROBSIZ(P1),AR.TYP	;[26]PICK UP THE QE'S NAME TYPE
	LOAD	S2,OBJ.SZ(P3),AR.TYP	;[26]PICK UP ENTRY'S NAME TYPE
	CAMN	S1,S2			;[26]ARE THEY THE SAME TYPE?
	JRST	CSTN.8			;[26]YES, SEE IF THE NAMES MATCH
	CAIN	S1,.KYPOR		;[26]IS A PORT NAME SPECIFIED?
	JRST	CSTN12			;[26]YES, NO MATCH IN THE ROUTE TABLE
	JRST	CSTN.1			;[26]NO, A CHECK THE NEXT ENTRY
CSTN.8:	HRROI	S1,ROBSIZ+ARG.DA(P1)	;[26]POINT TO THE QE PRINTER NAME
	HRROI	S2,OBJ.SZ+ARG.DA(P3)	;[26]POINT TO THE ENTRY'S PRINTER NAME
	$CALL	S%SCMP			;[26]CHECK IF THE NAMES ARE THE SAME
	TXNE	S1,SC%LSS!SC%SUP!SC%GTR ;[26]ARE THEY THE SAME?
	JRST	CSTN.1			;[26]NO, CHECK THE NEXT ENTRY
	MOVE	S1,.ROBTY(P1)		;[26]PICK UP THE QE'S FULL LPT TYPE
	TXNN	S1,.UNLPT		;[26]IS IT AN UNKNOWN REMOTE LPT TYPE?
	JRST	CSTN10			;[26]NO, CHECK FOR MATCH WITH ROUTED
	MOVE	S1,OBJ.SZ(P3)		;[26]PICK UP THE ENTRY'S NAME TYPE
	MOVEM	S1,ROBSIZ(P1)		;[26]PLACE IN THE QE
	MOVE	S1,OBJ.TY(P3)		;[26]PICK UP THE ENTRY'S FULL LPT TYPE
	MOVEM	S1,.ROBTY(P1)		;[26]PLACE IN THE QE
	JRST	CSTN10			;[26]CHECK FOR MATCH WITH ROUTED OBJ
CSTN.9:	MOVE	S1,OBJ.UN(P3)		;[26]GET THE ENTRY UNIT NUMBER
	CAXN	S1,.INFIN		;IS IT ALL UNITS ???
	JRST	CSTN10			;YES,,THEN WE MATCH ALL ATTRIBUTES
	LOAD	S1,.ROBAT(P1),RO.ATR	;GET THE REQUESTED DEVICE ATTRIBUTES
	LOAD	S2,.ROBAT(P1),RO.UNI	;GET THE REQUESTED UNIT (0 IS OK)
	CAIN	S1,%GENRC		;[31]WILL ANY UNIT DO?
	JRST	CSTN9A			;[33]YES, CHECK FOR LOG/SPOOL 
	CAXN	S1,%PHYCL		;DID HE REQUEST A SPECIFIC UNIT ???
	CAME	S2,OBJ.UN(P3)		;DOES THE UNIT MATCH ???
	SKIPA				;NO MATCH OR NOT PHYSICAL UNIT,,SKIP !
	JRST	CSTN10			;YES,,THEN CONTINUE
	CAXN	S1,%PHYCL		;DIS HE REQUEST A SPECIFIC UNIT ???
	CAML	S2,OBJ.UN(P3)		;YES,,ARE WE STILL IN RANGE ???
	JRST	CSTN.1			;YES,,TRY NEXT ENTRY
	JRST	CSTN12			;[26]NO, RETURN CHECKING ATTRIBUTES 

	;CONTINUED ON THE NEXT PAGE
	

CSTN9A:	SKIPN	G$LOGF##		;[33]SPECIFIC LOG/SPOOL REQUEST ENA?
	JRST	CSTN10			;[33]NO, GET ROUTED OBJECT BLOCK
	MOVE	S1,P1			;[33]PICK UP THE .QEROB ADDRESS
	SUBI	S1,.QEROB		;[33]FIND THE QE ADDRESS
	MOVE	S1,.QESEQ(S1)		;[33]PICK UP EXTERNAL VALUES WORD
	TXNN	S1,QE.LOG!QE.SPL	;[33]LOG/SPOOLED FILES IN REQUEST?
	JRST	CSTN10			;[33]NO, GET ROUTED OBJECT BLOCK
	SKIPN	RLSFG1(P3)		;[33]LOG/SPOOL FILE ENA FOR THIS LPT?
	JRST	CSTN.1			;[33]NO, TRY THE NEXT ENTRY

;Here to check that scheduling object matches routed object

CSTN10:	MOVEI	P4,RTEOB2(P3)		;[33]POINT TO THE ROUTED OBJECT BLOCK
	JUMPE	P2,[MOVE  S1,OBJ.ND(P4)	;[33]NO OBJECT,,GET ROUTED NODE NAME
		    PJRST N$NODE ]	;RETURN THROUGH N$NODE
	MOVE	S1,OBJ.ND(P4)		;[33]GET THE ENTRY NODE NAME/NUMBER
	MOVE	S2,OBJNOD(P2)		;GET THE OBJECT NODE NAME/NUMBER
	PUSHJ	P,N$MTCH		;DO THEY MATCH ???
	JUMPF	CST11A			;[33]NO, MAKE ONE LAST CHECK
	MOVE	S1,OBJ.TY(P4)		;[33]PICK UP THE ENTRY'S OBJECT TYPE
	CAXN	S1,.INFIN		;[36]ROUTE ALL ENTRY?
	$RETT				;[36]YES, INDICATE A MATCH
	MOVE	S2,OBJTYP(P2)		;[26]PICK UP OBJECT'S OBJECT TYPE
	CAME	S1,S2			;[26]ARE THEY THE SAME?
	JRST	CST11A			;[33]NO, MAKE ONE LAST CHECK
	TXNN	S1,.DQLPT!.LALPT	;[26]A REMOTE LPT OBJECT SPECIFIED?
	JRST	CSTN11			;[26]NO, CHECK THE UNITS
	MOVEI	S1,OBJNAM(P2)		;[26]PICK UP OBJECT'S NAME BLOCK ADR
	MOVEI	S2,OBJ.SZ(P4)		;[33]PICK UP ENTRY'S NAME BLOCK ADR
	$CALL	CHRNME##		;[26]CHECK IF THE NAMES ARE THE SAME
	$RETIT				;[35]RETURN SUCCESS ON A MATCH
	JRST	CST11A			;[35]OTHERWISE, CHECK FOR %GENRC

CSTN11:	MOVE	S1,OBJ.UN(P4)		;[33]GET THE ENTRY OBJECT UNIT
	CAXE	S1,.INFIN		;IS IT 'ALL' UNITS ???
	CAMN	S1,OBJUNI(P2)		;OR DOES IT MATCH THE OBJECT UNIT ???
	$RETT				;YES,,RETURN TRUE

CST11A:	LOAD	S1,.ROBAT(P1),RO.ATR	;[33]PICK UP THE UNIT TYPE
	CAIE	S1,%GENRC		;[33]A GENERIC UNIT REQUEST?
	$RETF				;[33]NO, INDICATE NO MATCH
	MOVEI	S1,.OTLPT		;[33]PICK UP THE LOCAL LPT TYPE
	CAME	S1,OBJ.TY(P3)		;[33]IS THE SAME AS THE SOURCE?
	$RETF				;[33]NO, INDICATE NO MATCH
	MOVE	S2,.ROBND(P1)		;[35]PICK UP QE'S NODE NAME
	CAME	S2,OBJ.ND(P3)		;[35]IS THE SAME AS THE SOURCE?
	$RETF				;[33]NO, INDICATE NO MATCH
	CAME	S1,OBJTYP(P2)		;[35]CURRENT OBJECT A LOCAL LPT?
	JRST	CSTN.1			;[35]NO, CHECK NEXT ROUTE TABLE ENTRY
	MOVE	S1,OBJ.UN(P3)		;[33]PICK UP SOURCE UNIT NUMBER
	CAMN	S1,OBJUNI(P2)		;[33]SAME AS THE CURRENT OBJECT?
	$RETF				;[33]YES, INDICATE NO MATCH
	JRST	CSTN.1			;[35]NO, CHECK NEXT ROUTE TABLE ENTRY

	;Here to check for device attributes match

CSTN12:	MOVE	S1,.ROBND(P1)		;GET DEST NODE
	JUMPE	P2,N$NODE		;NO OBJECT,,RETURN DEST NODE
	MOVE	S2,OBJNOD(P2)		;GET OBJECT NODE
	PUSHJ	P,QOMTCH		;DOES IT MATCH?
	JUMPF	.POPJ			;NO,,RETURN FAILURE
	LOAD	S1,OBJTYP(P2),AR.TYP	;[26]PICK UP OBJECT TYPE
	CAIE	S1,.OTLPT		;[26]IS IT A LPT OBJECT?
	JRST	CSTN16			;[26]NO, GO CHECK THE UNITS
	HLLZ	S2,OBJTYP(P2)		;[26]PICK UP THE TYPE OF LPT OBJECT
	HLLZ	S1,.ROBTY(P1)		;[26]PICK UP THE QE'S LPT TYPE
	SKIPN	S1			;[26]WAS A TYPE SPECIFIED?
	JRST	CSTN14			;[26]NO, IT MAY MATCH ALL TYPES
	TXNE	S1,.UNLPT		;[26]AN UNKNOWN LPT TYPE?
	JRST	CSTN13			;[26]YES, IT MAY MATCH DQS OR LAT
	TXNE	S1,.CLLPT		;[26]A CLUSTER LPT TYPE?
	JRST	CSTN15			;[26]YES, GO CHECK THE UNITS
	MOVEI	S1,ROBSIZ(P1)		;[26]PICK UP THE QE NAME BLOCK ADDRESS
	MOVEI	S2,OBJNAM(P2)		;[26]PICK UP THE OBJECT NAME BLOCK ADR
	$CALL	CHRNME##		;[26]CHECK IF THE NAMES ARE THE SAME
	$RET				;[26]RETURN WITH THE T/F INDICATOR

CSTN13:	TXNN	S2,.DQLPT!.LALPT	;[26]IS IT A REMOTE LPT OBJECT?
	$RETF				;[26]NO, INDICATE NO MATCH
	HRROI	S1,ROBSIZ+ARG.DA(P1)	;[26]PICK UP THE QE NAME BLOCK ADDRESS
	HRROI	S2,OBJNAM+ARG.DA(P2)	;[26]PICK UP THE OBJECT NAME BLOCK ADR
	$CALL	S%SCMP			;[26]CHECK IF THE NAMES ARE THE SAME
	TXNE	S1,SC%LSS!SC%SUP!SC%GTR ;[26]ARE THEY THE SAME?
	$RETF				;[26]NO, INDICATE NO MATCH
	MOVE	S1,OBJNAM(P2)		;[26]PICK UP THE NAME TYPE
	MOVEM	S1,ROBSIZ(P1)		;[26]PLACE IN THE QE NAME BLOCK HEADER
	MOVE	S1,OBJTYP(P2)		;[26]PICK UP THE FULL LPT TYPE
	MOVEM	S1,.ROBTY(P1)		;[26]PLACE IN THE QE
	$RET				;[26]PRESERVE THE TRUE FLAG

CSTN14:	SKIPN	S2			;[26]IS IT A LOCAL LPT?
	JRST	CSTN16			;[26]YES, GO CHECK THE UNITS
	TXNE	S2,.CLLPT		;[26]IS THE OBJECT A CLUSTER LPT?
	JRST	CSTN16			;[26]YES, GO CHECK THE UNITS

	LOAD	S1,.ROBAT(P1),RO.ATR	;[26]PICK UP THE QE'S ATTRIBUTES
	CAIN	S1,%PHYCL		;[26]WAS A PHYSICAL UNIT SPECIFIED?
	$RETF				;[26]YES, INDICATE NO MATCH
	MOVEI	S1,ROBSIZ(P1)		;[26]PICK UP WHERE TO PLACE NAME BLK
	HRLI	S1,OBJNAM(P2)		;[26]SOURCE,,DESTINATION
	MOVEI	S2,ROBSIZ+LPTNLN(P1)	;[26]FINAL DESTINATION ADDRESS + 1
	BLT	S1,-1(S2)		;[26]COPY THE NAME BLOCK OVER
	MOVE	S1,OBJTYP(P2)		;[26]PICK UP THE OBJECT'S FULL LPT TYPE
	MOVEM	S1,.ROBTY(P1)		;[26]PLACE IN THE QE
	$RETT				;[26]INDICATE A MATCH OCCURRED

CSTN15:	TXNN	S2,.CLLPT		;[26]IS THE OBJECT A CLUSTER LPT?
	$RETF				;[26]NO, INDICATE NO MATCH

CSTN16:	LOAD	S2,.ROBAT(P1),RO.ATR	;GET THE ATTRIBUTES
	CAXN	S2,%PHYCL		;DID HE SPECIFY PHYSICAL?
	JRST	[LOAD	S1,.ROBAT(P1),RO.UNI  	;YES, GET PHYSICAL UNIT
		 CAME	S1,OBJUNI(P2)	;DO THEY COMPARE
		 $RETF			;NO,,LOSE !!!
		 JRST CSTN17 ]		;[26]UPDATE OBJECT TYPE WORD
					;[32]Delete edit 30
	SKIPN	G$LOGF##		;[33]SPECIFIC LOG/SPOOL REQUEST ENA?
	JRST	CST16A			;[33]NO, PICK UP OBJECT SETUP STATUS
	CAXE	S2,%GENRC		;[33]GENERIC DEVICE REQUESTED?
	JRST	CST16A			;[33]NO, GET THE OBJECT SETUP STATUS
	MOVE	S1,P1			;[33]PICK UP THE .QEROB ADDRESS
	SUBI	S1,.QEROB		;[33]GET ADDRESS OF THE QE
	MOVE	S1,.QESEQ(S1)		;[33]PICK UP EXTERNAL VALUES WORD
	TXNN	S1,QE.LOG!QE.SPL	;[33]LOG/SPOOLED FILES IN REQUEST?
	JRST	CST16A			;[33]NO, PICK UP OBJECT SETUP STATUS
	LOAD	S1,OBJSC2(P2),OB2LOG	;[33]LOG/SPOOL FILES ENABLED BIT
	JUMPN	S1,CSTN17		;[33]MATCH IF LOG/SPOOL FILES ENABLED
	$RETF				;[33]INDICATE NO MATCH

CST16A:	LOAD	S1,OBJSCH(P2),OBSSUP	;[33]GET THE OBJECT SETUP STATUS BIT
	JUMPE	S1,CSTN17		;[26]NOT SETUP, UPDATE OBJ TYPE WORD
	LOAD	S1,OBJDAT(P2),RO.ATR	;YES,,GET OBJECT ATTRIBUTES
	CAMN	S1,S2			;DO THE ATTRIBUTES MATCH?
	JRST	CSTN17			;[26]YES, UPDATE OBJECT TYPE WORD
	CAXE	S2,%GENRC		;DOES USER WANT GENERIC DEVICE ???
	$RETF				;NO,,RETURN
	CAXE	S1,%LOWER		;IS DEVICE LOWER
	CAXN	S1,%UPPER		;  OR UPPER ????
	SKIPA				;[26]YES, UPDATE OBJECT TYPE WORD
	$RETF				;NO,,RETURN NO GOOD
CSTN17:	MOVE	S1,OBJTYP(P2)		;[26]PICK UP OBJECT TYPE WORD
	MOVEM	S1,.ROBTY(P1)		;[26]UPDATE THE QE OBJECT TYPE WORD
	$RETT				;[26]INDICATE SUCCESS
	SUBTTL	QOMTCH - Routine to match q entry with object

	;CALL:	S1/ Node identifier from Q entry
	;	S2/ Node name from object
	;RET:	True if match
	;	False if otherwise

QOMTCH:	CAMN	S1,S2			;Get lucky?
	$RETT				;Yes
	EXCH	S1,S2			;Flip
	PUSH	P,S2			;Save the Q entry identifier
	PUSHJ	P,N$GNOD		;Look for it
	POP	P,S1			;Get back Q entry identifier
	$RETIF				;Return if object entry not found??
	CAMN	S1,NETCOL(S2)		;Names match?
	$RETT				;Yes, win

;  Only the collating entry makes sense for T20.

TOPS10<	MOVX	TF,NETIBM		;Get the bit for IBM
	CAMN	S1,NETLOC(S2)		;Did we match other
	TXNE	TF,NETSTS(S2)		;And not IBM?
	SKIPA				;No to either
	$RETT				;Yes to both
>  ;End of TOPS10

	$RETF
	SUBTTL	N$LOCL - ROUTINE TO VERIFY THAT A NODE NAME/NUMBER IS LOCAL

	;CALL:	S1/NODE NAME or NODE NUMBER
	;
	;RET:	TRUE if S1 contains a local node name or number
	;	FALSE if s1 is not local

N$LOCL:	CAME	S1,G$LNAM##		;IS IT THE LOCAL NODE NAME ???
	CAMN	S1,G$LNBR##		;OR IS IT THE LOCAL NODE NUMBER ???
	$RETT				;YES TO EITHER,,RETURN TRUE
	$RETF				;ELSE RETURN FALSE
	SUBTTL	N$MTCH - SEE IF 2 REMOTE STATION ID'S ARE EQUIVALENT

	;CALL:	S1/ First node name/number
	;	S2/ Second node name/number
	;
	;RET:	True if they match
	;	False otherwise

N$MTCH:	CAMN	S1,S2			;YOU NEVER KNOW,,WE MIGHT GET LUCKY !!
	$RETT				;THEY'RE EQUAL,,WE WIN BIG !!!
	PUSH	P,S2			;SAVE THIS NODE NAME FOR A MINUTE
	PUSHJ	P,N$NODE		;FIND THE FIRST NAME IN OUR DATA BASE
	POP	P,S1			;RESTORE SECOND NODE NAME TO S1
	CAME	S1,NETNAM(S2)		;S2 POINTS TO FIRST NAME'S DB ENTRY
	CAMN	S1,NETNBR(S2)		;DO WE MATCH EITHER THE NODE NAME
	$RETT				;OR THE NODE NUMBER .. IF SO WE WIN !!
	$RETF				;ELSE LOSE !!!
	SUBTTL	N$NONL / N$NOFF - IBM ONLINE/OFFLINE PROCESSING ROUTINES

	;CALL:	S1/ The Node DB Entry Address
	;	S2/ The Object Block Address
	;	M/ The Response-to-Setup message address (if N$NONL)
	;
	;RET:	True Always

;  This routine is only called if the node is an IBM remote.

N$NONL:	TDZA	T1,T1			;INDICATE 'ONLINE' ENTRY POINT
N$NOFF:	SETOM	T1			;INDICATE 'OFFLINE' ENTRY POINT
	$SAVE	<P1,P2,AP>		;SAVE SOME ACS
	STKVAR	<OFLINE,NOTIFY>		;GEN STORAGE FOR OFFLINE FLAG
					; and for notify flag for telling ORION
	MOVEM	T1,OFLINE		;SAVE THE ENTRY POINT FLAG
	SETOM	NOTIFY			;No notify needed yet
	MOVE	AP,S1			;SAVE THE NODE DB ADDRESS
	MOVE	P2,S2			;SAVE THE OBJECT BLOCK ADDRESS
	SKIPE	OFLINE			;IF WE ARE OFFLINE,,THEN
	JRST	NOFF.1			;   GO PROCESS IT

;  Here if we are Online

NONL.1:

;  First check to see if already online

	LOAD	S1,NETSTS(AP),NETONL	;GET NODE ONLINE BIT
	JUMPN	S1,.RETT		;IF ONLINE,,THATS AN ERROR

;  Find if this is SNA workstation

	LOAD	S1,NETSTS(AP),NETSNA	;Is this an SNA Workstation
	JUMPN	S1,NONL.6		;Yes, skip this

;  Find if emulation online and if so, skip this magical stuff

	MOVE	S1,OBJTYP(P2)		;GET THE OBJECT TYPE
	LOAD	S2,NETSTS(AP),NT.MOD	;GET THE MODE
	CAXN	S1,.OTBAT		;Is it emulation batch stream?
	CAXE	S2,DF.EMU		;  and emulation node?
	SKIPA				;No,, continue
	JRST	NONL.6			;Yes to both, skip all this

;  Find if termination and proto and if not, just return

	CAXN	S1,.OTRDR		;Is it termination reader
	CAXE	S2,DF.PRO		;  and prototype node?
	$RETT				;No to either, error

;  Find the actual node in the data base and do some checking

	MOVE	S1,RSU.PN(M)		;Get the actual node name
	CAMN	S1,RSU.NO(M)		;Is proto and actual the same?
	JRST	[MOVE	P1,AP		;Yes, set actual pointer as proto
		JRST	NONL.2]		;Skip some of this node setup
	$CALL	N$GNOD			;Get node if there
	JUMPF	NONL.7			;Not there, error
	LOAD	TF,NETSTS(S2),NETIBM	;Get IBM bit
	JUMPE	TF,NONL.7		;Not defined IBM node, error
	LOAD	TF,NETSTS(S2),NETONL	;Get online bit
	JUMPN	TF,[$WTO(<IBM Node ^N/S1/ has signed on twice in error>)
		$RETT]			;Quit

	MOVE	P1,S2			;Remember the node data base

;  Move the same info to the actual node

	HRLZI	S1,NETSTS(AP)		;Get the source
	HRRI	S1,NETSTS(P1)		;Get the destination
	BLT	S1,NETIDN(P1)		;Make things the same

;  Now set the appropriate bits in the appropriate nodes

NONL.2:	MOVEI	S1,1
	STORE	S1,NETSTS(AP),NETPRO	;Say we are online prototype
	STORE	S1,NETSTS(P1),NETNSV	;Say we are valid online/offline
	STORE	S1,NETSTS(P1),NETONL	;Say we are online actual
	MOVEI	S1,DF.TRM		;Get termination mode
	STORE	S1,NETSTS(P1),NT.MOD	;Set it in actual
	MOVE	S1,NETCOL(AP)		;Get the proto node name
	MOVEM	S1,NETLOC(P1)		;Save it in the actual
	MOVE	S1,NETCOL(P1)		;Get the actual node name
	MOVEM	S1,NETLOC(AP)		;Save it in the proto

;  And put the reader on the actual node

	MOVEM	S1,OBJNOD(P2)		;Make the reader on the actual node
	SETZM	NOTIFY			;Want to start an OPR

;  Now start-up the line printer on the actual node

	MOVEM	S1,RSU.NO(M)		;Put actual into origional message
	MOVEI	S1,.OTLPT		;Get a printer type
	MOVEM	S1,RSU.TY(M)		;Save it into origional message
	MOVEI	S1,RSU.TY(M)		;Get address of object block
	$CALL	A$ISTA##			;Start up the printer

	EXCH	P1,AP			;Switch names
	$TEXT	(<-1,,NETASC(AP)>,<^N/NETNAM(AP)/(^N/NETNBR(AP)/)^0>)
	$TEXT	(<-1,,NETCLM(AP)>,<^W6L /NETNAM(AP)/ (^N/NETNBR(AP)/)^0>)
					;Force generation of correct
					;online node name
NONL.6:	MOVX	S1,NETONL		;GET THE NODE ONLINE BIT
	IORM	S1,NETSTS(AP)		;AND SET IT
	MOVE	P1,NETCOL(AP)		;GET SIGNED ON NODE NAME
	SETZM	T1			;MAKE SURE WE RETURN TRUE
	JRST	PASS.1			;MEET AT THE PASS

;  Here if signed-on node is not defined as IBM

NONL.7:	$QWTO	(<Prototype node ^N/RSU.NO(M)/ is being shut down>,<Node ^N/S1/ , trying to signon, is not defined as an IBM node>)
	MOVEM	S1,OBJNOD(P2)		;Change the object so it can be shutdwn
	MOVE	S1,P2			;Get the object address
	$CALL	S$SHUT##		;Shutdown the bad reader
	$RETT				;And quit
	;Here if we are Offline

NOFF.1:	MOVE	S1,OBJTYP(P2)		;Get the object type
	CAXE	S1,.OTBAT		;Is it emulation?
	JRST	NOFF.2			;No, skip this
	MOVE	P1,NETCOL(AP)		;Get the node name
	SETZ	T1,			;Remember to delete the batch stream
	JRST	NOFF.9			;Go finish up

NOFF.2:	MOVE	P1,NETSTS(AP)		;Get the status bits
	TXNN	P1,NETSNA		;Is this an SNA Workstation?
	CAXE	S1,.OTRDR		;Is it the reader?
	$RETT				;No, don't care about this one

;  Given an entry, find if it is the proto, and if so, skip most of this.
;  Otherwise, get the proto out of the node data base


	LOAD	S1,NETSTS(AP),NT.MOD	;Get the mode
	CAIN	S1,DF.PRO		;Is it the prototype only?
	JRST	NOFF.8			;Yes, just shut it down
	MOVE	S1,NETLOC(AP)		;Get the proto name
	PUSHJ	P,N$NODE		;Find it in the data base
	MOVE	P1,S2			;Remember the entry

;  Fix the node data base entries

					;P1 is the proto
					;AP is the actual
	SETZM	NETLOC(AP)		;Clear the pointer to the proto
	SETZM	NETLOC(P1)		;Clear the pointer to the actual
	SETZ	S1,			;Clear S1 for help
	CAME	AP,P1			;Are the nodes the same?
	STORE	S1,NETSTS(AP),NT.TYP	;No, clear type of actual node
	STORE	S1,NETSTS(P1),NETPRO	;Clear online proto flag
	MOVEI	S1,DF.PRO		;Get proto mode
	STORE	S1,NETSTS(P1),NT.MOD	;Set it in proto
;  Here we want to shutdown the printer if any

	MOVEI	S1,TOBJ			;Get the address of our temp obj. block
	MOVEI	S2,.OTLPT		;Get the printer object type
	MOVEM	S2,OBJ.TY(S1)		;Save it in our object block
	SETZM	OBJ.UN(S1)		;The unit number is 0
	MOVE	S2,OBJNOD(P2)		;Get the node name
	MOVEM	S2,OBJ.ND(S1)		;  and save it in our object block
	SETZ	S2,			;[26]No remote LPT name block
	PUSHJ	P,A$FOBJ##		;Get LPT entry in object queue
	JUMPF	NOFF.7			;None there, don't have to do this

	LOAD	S2,OBJSCH(S1)		;Get the sched flag word
	TXNN	S2,OBSSUP		;Is the object setup?
	JRST	NOFF.6			;No, skip the rest of this
	TXO	S2,OBSSEJ		;Light the shutdown at EOJ bit
	TXNE	S2,OBSFRR		;Is this a free running device?
	TXZ	S2,OBSBUS		;Yes, clear the busy bit
	MOVEM	S2,OBJSCH(S1)		;Save any changes
	
NOFF.6:	PUSH	P,AP			;Save this register, it gets clobbered
	PUSHJ	P,S$SHUT##		;Shut it down, in all cases
	POP	P,AP			;Restore it

NOFF.7:	SETZM	NOTIFY			;Tell ORION OPR is gone
	LOAD	S1,NETSTS(P1),NETSHT	;Get shutdown flag of proto
	SKIPE	S1			;Is it to be shutdown also?
	JRST	NOFF.8			;Yes, go do that

	MOVE	S1,NETCOL(P1)		;Get the proto name
	MOVEM	S1,OBJNOD(P2)		;Change the reader
	SETO	T1,			;Remember to keep the reader
	JRST	NOFF.9
;  Here if shutdown of proto

NOFF.8:	SETZ	T1,			;Remember to get rid of the reader

NOFF.9:	MOVE	P1,NETSTS(AP)		;Get the status bits
	TXNN	P1,NETSNA		;SNA Workstation?
	JRST	NOFF10			;No
	MOVE	S1,OBJUNI(P2)		;Yes, get the unit number
	CAIE	S1,1			;Is it the main batch stream?
	JRST	PASS.2			;No, finish up

NOFF10:	MOVE	P1,NETCOL(AP)		;Get node name to tell ORION if needed
	MOVX	S1,NETONL		;GET THE NODE ONLINE BIT
	ANDCAM	S1,NETSTS(AP)		;PUT THE NODE OFFLINE

	;Here we tell the OPR whats happening and tell ORION also.

PASS.1:	MOVEI	S1,[ASCIZ/online/]	;DEFAULT TO ONLINE
	SKIPE	OFLINE			;ARE WE OFFLINE ???
	MOVEI	S1,[ASCIZ/offline/]	;YES,,MAKE IT OFFLINE
	$QWTO(< Network Node ^T/NETASC(AP)/ is ^T/0(S1)/ >,,,<$WTFLG(WT.SJI)>)
	SKIPN	OFLINE			;NO, ARE WE OFFLINE ???
	JRST	PAS1.1			;No, skip this
	LOAD	S1,NETSTS(AP),NT.MOD	;Get the mode
	CAXE	S1,DF.PRO		;Prototype node?
	JRST	[PUSHJ P,GENNOD		;No, get regular names
		JRST PAS1.1]		;  and continue on
					;Yes, generate correct node name string
	$TEXT	(<-1,,NETASC(AP)>,<^N/NETCOL(AP)/^0>)
	$TEXT	(<-1,,NETCLM(AP)>,<^N6L /NETCOL(AP)/ ^0>)
PAS1.1:	SKIPE	NOTIFY			;Do we want to tell ORION?
	JRST	PASS.2			;NO,,EXIT
	MOVE	S1,NETPTL(AP)		;YES,,GET THE NODES PORT,,LINE NUMBER
	MOVEM	S1,NWAMSG+.OFLAG	;SAVE IT IN THE MESSAGE
	MOVX	S1,%ONLINE		;GET THE NODE ONLINE STATUS BITS
	SKIPN	OFLINE			;DID THE NODE COME ONLINE ???
	MOVEM	S1,NWAMSG+.MSFLG	;YES,,MAKE THE MESSAGE AN ONLINE MESSAGE
	MOVEM	P1,NWAMSG+.OHDRS+ARG.DA+OBJ.ND ;SAVE THE NODE NAME/NUMBER
	PUSHJ	P,SNDORN		;SEND THE MSG OFF TO ORION
	SETZM	NWAMSG+.MSFLG		;DONE,,CLEAR THE FLAG WORD
	SETZM	NWAMSG+.OFLAG		;   AND THIS ONE TOO

PASS.2:	JUMPN	T1,.RETF		;IF PROTOTYPE OFFLINE,,RETURN FALSE
	$RETT				;ELSE RETURN
	SUBTTL	SNDORN - ROUTINE TO SEND A NODE WENT AWAY MSG OFF TO ORION


SNDORN:	MOVE	S1,G$OPR##		;GET ORION'S PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS THE RECIEVERS PID
	MOVEI	S1,NWAMSG		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVEI	S1,.OHDRS+ARG.DA+OBJ.SZ	;GET THE MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVX	S1,.OTOPR		;GET THE OPR OBJECT TYPE
	STORE	S1,NWAMSG+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
	SETZM	NWAMSG+.OHDRS+ARG.DA+OBJ.UN ;ZAP ANY UNIT NUMBER
	PUSHJ	P,C$SEND##		;SEND IT OFF
	$RETT				;AND RETURN
	SUBTTL	N$CKND - Check state of node for IBM DEFINEs and SETs

	;CALL	S1/ Node name
	;	S2/ -1 if prototype and online devices are to be checked
	;	     0 if online device check need not be performed
	;
	;Ret:	True if OK.  I.E. Not online and no objects started
	;	S1/ Node name
	;	S2/ Node address or 0 if not defined
	;
	;	False if not OK. I.E. Either online or objects started
	;	S1/ Address of ITEXT error message
	;	S2/ Node address

N$CKND:	$SAVE	P1
	MOVE	P1,S2			;Remember the flag
	$CALL	N$GNOD			;Try for the node name
	JUMPF	[SETZ	S2,		;Not found, set address
		$RETT]			;Return true
	LOAD	TF,NETSTS(S2),NETONL	;Get the online bit
	JUMPN	TF,[MOVEI S1,[ITEXT(Can't perform function on a node which is online)]
		JRST	CKND.1]		;Cannot allow online
	LOAD	TF,NETSTS(S2),NETPRO	;Get the proto-actual is online
	JUMPN	TF,[MOVEI S1,[ITEXT(Can't perform function on a proto node which has an actual node started)]
		JRST	CKND.1]		;Cannot allow when proto in use
	JUMPE	P1,.RETT		;If not proto, we don't care about
					;  online devices
	$CALL	FNDDEV			;Check for objects started on node
	JUMPF	[MOVE	S1,NETCOL(S2)	;Get back the name
		$RETT]			;Return true
	MOVEI	S1,[ITEXT(Can't perform function on a node which has devices started)]
CKND.1:	$RETF
	SUBTTL	FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE

	;CALL:	S2/ The Node DB Entry Address for the Node we are looking for
	;	    (preserved)
	;
	;RET:	True - If we find a device started for the specified node
	;      False - If there are no devices started for the node


FNDDEV:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	LOAD	P1,HDROBJ+.QHLNK,QH.PTF	;GET PTR TO FIRST OBJ QUEUE ENTRY
	SKIPA				;SKIP FIRST TIME THROUGH
FNDD.0:	LOAD	P1,.QELNK(P1),QE.PTN	;GET THE NEXT OBJ ENTRY ADDRESS
	JUMPE	P1,.RETF		;NO MORE,,RETURN FALSE
	MOVE	S1,OBJNOD(P1)		;GET THE OBJECTS NODE NAME
	CAME	S1,NETNAM(S2)		;DO
	CAMN	S1,NETNBR(S2)		;  WE
	$RETT				;    MATCH ???  YES - RETURN TRUE
	JRST	FNDD.0			;NO,,CHECK NEXT OBJECT
	SUBTTL	N$SACT - Set up actual IBM termination nodes

	;Call:	S1/ Name of prototype node
	;	S2/ Address of node entry or 0 if none.

	;Ret:	True if all nodes succeeded
	;	S2/ Address of node entry

	;	False if any node failed
	;	S1/ Address of ITEXT error message if failed
	;	S2/ Any argument needed for ITEXT

N$SACT:	$SAVE	<P1,P2,P3,P4>		;Save needed ac's
					;P1 is IFN of signon file
					;P2 is char count in file
					;P3 is byte pointer into file
	STKVAR	<NODNAM,NODADD>		;NODNAM is name of proto
					;NODADD is address of node entry of
					;  proto
	MOVEM	S1,NODNAM		;Save node name till later
	MOVEM	S2,NODADD		;And address if known

;  First need to find the signon file, get the file name

TOPS10<	MOVEM	S1,SONFD+.FDNAM	>	;Just save the node name
TOPS20<	$TEXT	<-1,,SONFD+1>,<^T/SONDIR/^N/S1/.SON^0> > ;Make the ASCIZ string

	MOVX	S1,FOB.MZ		;Get the size of our FOB
	MOVEI	S2,SONFOB		;And the address of our FOB
	$CALL	F%IOPN			;Open file for input
	JUMPF	NSAC.7			;No signon file
					;  send message then quit false

	MOVE	P1,S1			;Remember the IFN
	SETZ	P2,			;Read no chars yet
	SETOM	SONFST			;Note file open

;  Now loop through the file getting the node names

NSAC.0:	$CALL	GETNNM			;Get next node name
	JUMPF	NSAC.9			;Go to return success

;  Check the node out

	SETZ	S2,			;Do not check onliness
	$CALL	N$CKND			;Go check for the actual node
	JUMPF	NSAC.8			;Give error (already in S1) and return

	MOVEI	P4,1			;Assume this is a definition
	JUMPE	S2,NSAC.1		;If not defined, go define it
	SETZM	P4			;And say this is a redefinition
	MOVE	TF,NETSTS(S2)		;Get status flags of this node
	TXNE	TF,NETSNA		;If SNA, do pruge and recreate
NSAC.1:	$CALL	N$NNET			;Add the node

;  Now want to set approp. bits in the node data base

	SETZM	NETSTS(S2)		;Clear the status word
	MOVEI	S1,1			;Get a bit
	STORE	S1,NETSTS(S2),NETIBM	;Light the IBM bit
	MOVEI	S1,DF.TRM		;Get the termination mode
	STORE	S1,NETSTS(S2),NT.MOD	;Set it

;  Tell the operator what we did

	MOVE	S1,P4			;Get the define type
	$QACK (<^T/DEFTAB(S1)/efine for Node ^T/NETASC(S2)/ Accepted>,,,.MSCOD(M))
	JRST	NSAC.0			;Go for another

NSAC.7:	SETO	S2,			;Say we want last GLXLIB error
	MOVEI	S1,[ITEXT(<Failed to open signon file - ^E/S2/>)]
	$RETF
NSAC.8:	$CALL	CLSSON			;Close the signon file
	$RETF

NSAC.9:	$CALL	CLSSON			;Close the signon file in either case
	SKIPE	S1			;Was it really ok?
	$RETF				;No
TOPS10<	SETZ	S1,			;Lie, say we have no node name
	MOVE	S2,NODNAM>		;  but have a number
TOPS20<	MOVE	S1,NODNAM		;The reverse lie for the 20
	SETZ	S2,>			;
	$CALL	N$ANET			;Add the node our way purging
					;  any previous entries

;Now need to force the node name to look correct

	$TEXT	(<-1,,NETASC(S2)>,<^N/NETCOL(S2)/^0>)
	$TEXT	(<-1,,NETCLM(S2)>,<^W6L /NETCOL(S2)/ ^0>)

	$RETT				;Return true


;  Work routine to close the signon file

CLSSON:	DMOVE	P2,S1			;Save S1,S2 a sec
	MOVE	S1,P1			;Get the IFN
	$CALL	F%REL			;Release the file
	DMOVE	S1,P2			;Get S1,S2 back
	$RET				;Just return, don't care about errors
	SUBTTL	GETNNM - Routine to get the next node name from signon file

	;  This routine should only be called by N$SACT!
	;Call:	Assumes:	P1/ IFN of signon file
	;			P2/ Char count of input
	;			P3/ Byte pointer to input

	;Ret:	True	S1/ Node name
	;	False	End of file encountered S1/ 0
	;		or error with node name or file
	;			S1/ Address of ITEXT that explains error
	;			S2/ Argument for ITEXT if needed

GETNNM:	$SAVE	<T1,T2,T3,T4>
	$CALL	EATLIN			;Get rid of the signon card
	JUMPF	[SETZ	S1,		;No more cards
		$RETF]			;Return the EOF

;  Get node name

TOPS20<	MOVE	T3,[POINT 6,T2]>	;Setup byte pointer on T20 only
	MOVEI	T4,6			;Only 6 chars allowed
	SETZ	T2,			;Start with nothing

GETN.1:	$CALL	GETCHR			;Get a character
	JUMPF	GETN.3			;Go do EOL processing

;  Do character processing

TOPS20<		;Alpha is only valid for T20 (node names) not for T10 (numbers)
	CAIL	T1,"A"			;Check for valid alpha
	CAILE	T1,"Z"
	SKIPA				;Not a letter
	JRST	GETN.2			;Add a letter
>  ;End of TOPS20

	CAIL	T1,"0"			;Check for number
TOPS20<	CAILE	T1,"9">
TOPS10<	CAILE	T1,"7">			;Must be octal on T10
	JRST	GETN.4			;Bad character

;  Add a character to the node name/number

GETN.2:
TOPS20<					;Make node name on T20
	SUBI	T1,40			;Make it sixbit
	IDPB	T1,T3			;Add it to the name
>  ; End of TOPS20
TOPS10<					;Make node number on T10
	SUBI	T1,60			;Make it a number
	IMULI	T2,10			;Shift what is already there (OCTAL)
	ADD	T2,T1			;Add it
>  ; End of TOPS10
	SOJG	T4,GETN.1		;go for more

;  Do EOL processing

GETN.3:	$CALL	EATLIN			;Finish line
	SKIPE	S1,T2			;Any name?
	$RETT				;Yes, return ok.

	MOVEI	S1,[ITEXT(<Error reading signon file, blank signon node name>)]
	$RETF				;Must have node name

;  Invalid character processing

GETN.4:	PUSH	P,T1			;Save the invalid character
	$CALL	EATLIN			;Finish line
	MOVEI	S1,[ITEXT(<Error reading signon file, invalid character -^7/S2/->)]
	POP	P,S2			;Get the invalid character back
	$RETF				;Pass error up

;  Now the work routine for checking through characters

;GETCHR gets the next character and returns it in T1.  If no more
;  characters on the line/in the file return false with T1/0.
;  P2 (number of characters) is -1 if EOF has been encountered.

GETCHR:	SKIPL	SONFST			;Everything OK?
	JRST	GTCH.3			;EOF or EOL already encountered

GTCH.1:	SOJGE	P2,GTCH.2		;Any characters?
	MOVE	S1,P1			;No, get IFN
	$CALL	F%IBUF			;Read some more
	DMOVE	P2,S1			;Save returned arguments
	JUMPT	GTCH.1			;If some characters, go get them
	MOVEI	TF,1			;Must have EOF
	MOVEM	TF,SONFST		;Remember it
	JRST	GTCH.3			;Go to EOL processing

GTCH.2:	ILDB	T1,P3			;Get next char
	CAIN	T1,11			;Map tabs
	MOVEI	T1,40			;Into spaces
	CAIN	T1,15			;Check for end
	JRST	GTCH.1			;End - but don't stop on cr
	CAIE	T1,12			;Check for linefeed
	$RETT				;No, good char
	SETZM	SONFST			;Mark EOL

GTCH.3:	SETZ	T1,			;No character
	$RETF				;Tell the caller

;EATLIN is a routine to find the end of the current line
;  It returns true if EOL, false if EOF

EATLIN:	$CALL	GETCHR			;Get the next character
	JUMPT	EATLIN			;Go get another
	SKIPE	SONFST			;Consider the state
	$RETF				;EOF
	SETOM	SONFST			;Just EOL, clear it
	$RETT
	SUBTTL	N$PORT - Routine to look for multiple devices on same port/line

	;CALL:	S1/ The node name to be checked
	;
	;RET:	S2/ Entry address of node or 0 if not defined

	;	True if there are devices on same PORT/LINE
	;	S1/ Matching node's DB address

	;	False if there are no devices on same PORT/LINE

N$PORT:	PUSHJ	P,N$NODE		;Find the node DB address
	LOAD	S1,NETSTS(S2),NETIBM	;Is it an IBM station ???
	JUMPE	S1,.RETF		;No,,then OK
	$SAVE	<P1,AP>			;Save P1 and AP
	MOVE	AP,S2			;Save the Node DB address
	LOAD	P1,HDROBJ##+.QHLNK,QH.PTF ;Get the first objectc address
	SKIPA				;Skip the first time through

PORT.1:	LOAD	P1,.QELNK(P1),QE.PTN	;Get the next object address

	JUMPN	P1,PORT.2		;Jump if not done
	MOVE	S2,AP			;Remember the node entry
	$RETF				;Tell the caller

PORT.2:	MOVE	S1,OBJNOD(P1)		;Get the node name
	PUSHJ	P,N$NODE		;Find its DB entry
	CAMN	S2,AP			;Same node ???
	JRST	PORT.1			;Yes,,try next
	LOAD	S1,NETSTS(S2),NETIBM	;Is it an IBM station ???
	JUMPE	S1,PORT.1		;No,,Try next
	LOAD	S1,NETPTL(AP),NT.PRT	;Get source port number
	LOAD	TF,NETPTL(S2),NT.PRT	;Get the previous port number
	CAME	S1,TF			;Do they match ???
	JRST	PORT.1			;No,,try next
	LOAD	S1,NETPTL(AP),NT.LIN	;Get source line number
	LOAD	TF,NETPTL(S2),NT.LIN	;Get the previous line number
	CAME	S1,TF			;Do they match ???
	JRST	PORT.1			;No,,try next
	LOAD	S1,OBJSCH(P1),OBSSTA	;Has device been started ???
	JUMPE	S1,PORT.1		;No,,try next
	MOVE	S1,S2			;Get the node DB address
	MOVE	S2,AP			;Remember the node entry
	$RETT				;And return
	SUBTTL	PURGE.DUP.OBJS - ROUTINE TO PURGE DUPLICATE OBJECTS

	;This routine is called because it is possible to start the same
	;device at the same node using both the node name and node number.
	;This works only if the node is offline, since QUASAR cannot
	;validate the Node. For example, if an operator said:
	;Start Pr 0/Node:MUMBLE and Start Pr 0/Node:10 and node MUMBLE
	;and node 10 are the same node, then you have a problem when
	;the node comes online. This routine is called when a node comes
	;online and it schedules a shutdown for the duplicate node.

	;CALL:	AP/ Node DB Address of Node which came online
	;
	;RET:	True Always

PURGE.D: LOAD	T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJECT ADDRESS
	SKIPA				;SKIP THE FIRST TIME THROUGH
PURG.1:	LOAD	T1,.QELNK(T1),QE.PTN	;GET THE NEXT OBJECT ENTRY ADDRESS
	JUMPE	T1,.RETT		;DONE,,COMPLETE NODE ONLINE PROCESSING
	MOVE	S1,OBJNOD(T1)		;GET THE OBJECTS NODE NAME/NUMBER
	CAME	S1,NETNAM(AP)		;LETS SEE IF WE MATCH
	CAMN	S1,NETNBR(AP)		;MUST TRY BOTH VALUES
	SKIPA				;YES,,CONTINUE ON
	JRST	PURG.1			;NO,,TRY NEXT OBJECT
	SKIPN	S1,NETCOL(AP)		;GET THE COLLATING HANDLE
	MOVE	S1,NETLOC(AP)		;USE THE ALTERNATE
	MOVEM	S1,OBJNOD(T1)		;SAVE THE NODE ID
	MOVX	S1,OBSIGN		;GET THE IGNORE BIT
	ANDCAM	S1,OBJSCH(T1)		;CLEAR IT UNCONDITIONALLY
	MOVE	T2,T1			;GET THE OBJECT ADDRESS

	;HAVING FOUND 1 OBJECT STARTED FOR THIS NODE,,ARE THERE ANY MORE ???

PURG.2:	LOAD	T2,.QELNK(T2),QE.PTN	;POINT TO THE NEXT OBJECT ENTRY
	JUMPE	T2,PURG.1		;NO MORE,,CONTINUE ON
	MOVE	S1,OBJNOD(T2)		;GET THIS OBJECTS NAME/NUMBER
	CAME	S1,NETNAM(AP)		;DO WE MATCH BY NAME
	CAMN	S1,NETNBR(AP)		;OR BY NUMBER ???
	SKIPA				;YES,,CHECK REST OF BLOCK
	JRST	PURG.2			;NO,,GO CHECK THE NEXT OBJECT BLOCK

	;WE FOUND ANOTHER OBJECT STARTED FOR THIS NODE,,ARE THEY FOR 
	;THE SAME DEVICE ??? IF SO, THATS A NO-NO

	MOVE	S1,OBJTYP(T1)		;GET THE FIRST OBJ'S TYPE
	CAME	S1,OBJTYP(T2)		;DO WE MATCH ???
	JRST	PURG.2			;NO,,WE'RE OK SO FAR
	MOVE	S1,OBJUNI(T1)		;GET THE FIRST OBJ'S UNIT
	CAME	S1,OBJUNI(T2)		;DO WE MATCH ???
	JRST	PURG.2			;NO,,THATS OK TOO !!!

;IF THE OBJECT CORRESPONDS TO A REMOTE PRINTER, THEN MUST ALSO CHECK
;THE NAMES

	MOVE	S1,OBJTYP(T1)		;[25]PICK UP THE OBJECT TYPE
	TXNN	S1,.DQLPT		;[25]A DQS PRINTER?
	TXNE	S1,.LALPT		;[25]NO, A LAT PRINTER?
	SKIPA				;[25]YES, PREPARE TO COMPARE NAMES
	JRST	PURG.3			;[25]NO, SO RELEASE DUPLICATE OBJECT
	MOVEI	S1,OBJNAM+1(T1)		;[25]PICK UP THE NAME ADDRESS
	MOVEI	S2,OBJNAM+1(T2)		;[25]PICK UP THE NAME ADDRES
	$CALL	CHRNME			;[25]COMPARE THE NAMES
	JUMPF	PURG.2			;[25]IF NOT THE SAME, COMPARE NEXT
PURG.3:	$SAVE	<H,AP>			;[25]SAVE 'H', AND 'AP'
	MOVEI	H,HDROBJ##		;GET OBJECT HEADER ADDRESS
	MOVE	AP,T2			;GET THE DUPLICATES ADDRESS
	PUSHJ	P,M$RFRE##		;DELETE THE DUPLICATE OBJECT
	$RETT				;CANT HAVE MORE THEN 2 DUPLICATE OBJECTS
	END