Trailing-Edge
-
PDP-10 Archives
-
BB-KL11M-BM_1990
-
galsrc/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==:40 ;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.
***** Release 6.0 -- begin maintenance edits *****
37 6.1289 29-Nov-89
Declare location G$NULA as external. This location is used by the
Q$xxx macros.
40 6.1318 3-Jun-90
Add support for alias printers.
\ ;End of Revision History
;Global Definitions
$GDATA RTEQUE,1 ;[40]Make device routing table ID
;global
SUBTTL Local Definitions -- General storage
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
;**;[37]At EXTERN G$NEBF add 1 line JCR 11/29/89
EXTERN G$NULA ;[37]Required by the $Qxxx macros
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
;**;[40]At NRT.4B:+4L replace 4 lines with 6 lines PPM 6/3/90
BLT S1,RTEOB1+RFDLEN-2(P3) ;[40]Copy new 'FROM' field into table
;[40] but don't include LOG/SPOOL word
MOVSI S1,0(P2) ;[40]Get source,,0
HRRI S1,RTEOB2(P3) ;[40]Get source,,destination for BLT
BLT S1,RTEOB2+RFDLEN-2(P3) ;[40]Copy new 'TO' field into table
;[40] but don't include LOG/SPOOL word
;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
;**;[40]At GENF.1:+3L replace 1 line with 4 lines PMM 6/3/90
SKIPN S1,OBJ.AK(P1) ;[40]Is there an alias?
$TEXT (NETBYT,<^I/@RTEASC(P2)/^I/@RTEASC(S2)/^A>) ;[40]No
SKIPE S1 ;[40]Is there an alias
$TEXT (NETBYT,<^I/@RTEAKA(P2)/^I/@RTEAKA(S2)/^A>) ;[40]Yes
$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
;**;[40]At GENT.1:+0L replace 1 line with 4 lines PMM 6/3/90
GENT.1: SKIPN S2,OBJ.AK(P1) ;[40]Is there an alias name?
$TEXT (NETBYT,< Routed to ^I/@RTEASC(S1)/^0>) ;[40]No, finish text
SKIPE S2 ;[40]Is there an alias name?
$TEXT (NETBYT,< Routed to ^I/@RTEAKA(S1)/^0>) ;[40]Yes, finish it
$RETT ;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
;**;[40]After table RTEASC add table RTEAKA PMM 6/3/90
RTEAKA: [0,,0] ;[40]Zero offset is invalid
[ITEXT(^1/OBJ.TY(P1)/ ^D/OBJ.UN(P1)/)] ;[40]
[0,,0] ;[40]Zero offset is invalid
[ITEXT(^1/OBJ.TY(P1)/ ^D/OBJ.UN(P1)/)] ;[40]
[ITEXT([^N/OBJ.ND(P1)/] (Alias:^W/OBJ.AK(P1)/))] ;[40]On NODE X(Alias)
[0,,0] ;[40]Zero offset is invalid
[ITEXT(^I/@RTEAKA+1/^I/@RTEAKA+4/)] ;[40]PRINTER XXX ON NODE YYY
[ITEXT(Cluster ^1/P3/ ^D/OBJ.UN(P1)/)] ;[40]CLUSTER LPT
[ITEXT(DQS ^1/P3/ ^T/OBJ.SZ+1(P1)/)] ;[40]DQS LPT
[ITEXT(LAT ^1/P3/ PORT ^T/OBJ.SZ+1(P1)/)] ;[40]LAT/PORT
[ITEXT(LAT ^1/P3/ SERVICE ^T/OBJ.SZ+1(P1)/)] ;[40]LAT/SERVICE
[ITEXT(^I/@RTEAKA+7/ ^I/@RTEAKA+4/)] ;[40]CLUSTER LPT
[ITEXT(^I/@RTEAKA+8/ ^I/@RTEAKA+4/)] ;[40]DQS LPT
[ITEXT(^I/@RTEAKA+9/ ^I/@RTEAKA+4/)] ;[40]LAT/PORT LPT
[ITEXT(^I/@RTEAKA+^D10/ ^I/@RTEAKA+4/)] ;[40]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