Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
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,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
; 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 WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,ORNMAC,GLXMAC
PROLOG (QSRNET)
NETMAN==:1 ;Maintenance edit number
NETDEV==:14 ;Development edit number
VERSIN (NET) ;Generate edit number
SUBTTL Table of Contents
; Table of Contents for QSRNET
;
;
; Section Page
; 1. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 3
; 4. Local Definitions
; 4.1. General storage . . . . . . . . . . . . . . . 4
; 4.2. Symbols . . . . . . . . . . . . . . . . . . . 4
; 4.3. Storage to support signon file processing . . 5
; 4.4. Routine declarations. . . . . . . . . . . . . 6
; 5. N$INIT - ROUTINE TO INITIALIZE THE NETWORK DATA BASE MANAGER. 7
; 8. N$NODE . . . . . . . . . . . . . . . . . . . . . . . . 12
; 9. N$GNOD . . . . . . . . . . . . . . . . . . . . . . . . 12
; 10. Add entries to the network queue . . . . . . . . . . . 13
; 11. N$NRTE - ROUTINE TO PROCESS OPERATOR ROUTE MESSAGES. . 16
; 12. FNDRTE - FOUND A ROUTE TABLE ENTRY . . . . . . . . . . 19
; 13. N$RTAS - ROUTINE TO CONVERT A ROUTE TABLE ENTRY TO ASCIZ 20
; 14. GENFRM - ROUTINE TO GENERATE 'FROM' ROUTE TABLE DESCRIPTIONS 21
; 15. N$CSTN - PERFORM DEVICE ROUTINE AND DEVICE CHECKING. . 22
; 16. QOMTCH - Routine to match q entry with object. . . . . 24
; 17. N$LOCL - ROUTINE TO VERIFY THAT A NODE NAME/NUMBER IS LOCAL 25
; 18. N$MTCH - SEE IF 2 REMOTE STATION ID'S ARE EQUIVALENT . 26
; 19. N$NONL / N$NOFF - IBM ONLINE/OFFLINE PROCESSING ROUTINES 27
; 20. SNDORN - ROUTINE TO SEND A NODE WENT AWAY MSG OFF TO ORION 31
; 21. N$CKND - Check state of node for IBM DEFINEs and SETs. 32
; 22. FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE 33
; 23. N$SACT - Set up actual IBM termination nodes . . . . . 34
; 24. GETNNM - Routine to get the next node name from signon file 35
; 25. N$PORT - Routine to look for multiple devices on same port/line 36
; 27. PURGE.DUP.OBJS - ROUTINE TO PURGE DUPLICATE OBJECTS. . 39
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.
\ ;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
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 .RETF ;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 AFTER 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
NRTE.3: 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+OBJ.SZ-1(P3) ;COPY NEW 'TO' FIELD INTO ROUTE 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+OBJ.SZ-1(P3) ;COPY NEW 'FROM' FIELD INTO ROUTE TABLE
MOVSI S1,0(P2) ;GET SOURCE,,0
HRRI S1,RTEOB2(P3) ;GET SOURCE,,DESTINATION FOR BLT
BLT S1,RTEOB2+OBJ.SZ-1(P3) ;COPY NEW 'TO' FIELD INTO ROUTE 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
$ACK ( ^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
$ACK (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: MOVE S1,OBJ.TY(P1) ;GET THE 'FROM' OBJECT TYPE
TXZ S1,<1B0> ;CLEAR SIGN BIT
CAXE S1,.INFIN ;IS THIS ALL DEVICES ???
CAXG S1,.OTMAX ;NO,,IS IT A VALID OBJECT TYPE ???
SKIPA ;SKIP IF ALL DEVICES OR GOOD OBJECT
JRST E$ISO## ;RETURN INVALID SOURCE OBJECT !!!
MOVEM S1,OBJ.TY(P1) ;SAVE THE OBJECT TYPE
JUMPE P2,NRT.A1 ;NO 'TO' OBJECT BLOCK,,SKIP THIS
MOVE S2,OBJ.TY(P2) ;GET THE 'TO' OBJECT TYPE
TXZ S2,<1B0> ;CLEAR SIGN BIT
CAXE S2,.INFIN ;IS THIS ALL DEVICES ???
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 !!!
MOVEM S2,OBJ.TY(P2) ;SAVE THE OBJECT TYPE
CAME S1,S2 ;OBJECT TYPES MUST MATCH !!!
JRST E$IDO## ;NO,,RETURN INVALID DESTINATION OBJ !!
NRT.A1: MOVE S1,OBJ.UN(P1) ;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 ; CAN SPECIFY SPECIFIC UNITS !!!
SKIPA ;VALID,,CONTINUE
JRST E$CRG## ;NO,,THATS AN ERROR
JUMPE P2,NRT.A2 ;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 IA '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.A2: 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,.RETT ;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
$RETT ;RETURN
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: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
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 [SETZM 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 [SETOM S1 ;YES,,END OF THE LINE !!!
$RETF ] ;SO RETURN
PUSHJ P,N$MTCH ;DO THE NODE IDS MATCH ???
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 [SETOM S1 ;NO,,SET 'AFTER' RETURN CODE
$RETF ] ;AND RETURN
FNDR.3: MOVE S1,OBJ.TY(P1) ;GET THE SOURCE OBJECT TYPE
CAMLE S1,OBJ.TY(P2) ;LESS OR MATCH ???
JRST FNDR.1 ;NO,,TRY NEXT ENTRY
CAME S1,OBJ.TY(P2) ;DO WE MATCH ???
JRST [SETOM S1 ;NO,,SET 'AFTER' RETURN CODE
$RETF ] ;AND RETURN
MOVE S1,OBJ.UN(P1) ;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 'AFTER' RETURN CODE
$RETF ] ;AND RETURN
MOVE S1,P2 ;GET THE ENTRY ADDRESS
$RETT ;AND 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: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
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
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: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE 'TO' OBJECT BLOCK ADDRESS
MOVEI S1,4 ;DEFAULT TO 'TO NODE XXX'
MOVX S2,.INFIN ;GET 'ALL' CODE
CAME S2,OBJ.TY(P1) ;'ALL' OBJECTS ???
CAMN S2,OBJ.UN(P1) ; OR 'ALL' UNITS ???
SKIPA ;YES TO EITHER,,SKIP
MOVEI S1,6 ;ELSE A SPECIFIC DEVICE !!!
$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
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
MOVE S1,.ROBTY(P1) ;GET THE OBJECT TYPE
CAXN S1,.OTBAT ;IS IT BATCH ???
JRST CSTN.4 ;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 CSTN.4 ;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 CSTN.4 ;NOT THERE,,CHECK DEVICE ATTRIBUTES
CSTN.3: MOVE S1,.ROBTY(P1) ;GET THE SOURCE OBJECT TYPE
MOVE S2,OBJ.TY(P3) ;GET THE ENTRY OBJECT TYPE
CAXN S2,.INFIN ;IS IT 'ALL' DEVICES ???
MOVE S1,S2 ;YES,,MAKE SOURCE OBJ TYPE MATCH !!
CAMLE S1,S2 ;LESS OR MATCH ???
JRST CSTN.1 ;NO,,TRY NEXT ENTRY
CAME S1,S2 ;DO WE MATCH ???
JRST CSTN.4 ;NOT THERE,,CHECK DEVICE ATTRIBUTES
MOVE S1,OBJ.UN(P3) ;GET THE ENTRY UNIT NUMBER
CAXN S1,.INFIN ;IS IT ALL UNITS ???
JRST CST.3A ;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)
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 CST.3A ;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 CSTN.4 ;NO,,RETURN CHECKING ATTRIBUTES AGAIN
;CONTINUED ON THE NEXT PAGE
;Here to check that scheduling object matches routed object
CST.3A: MOVEI P3,RTEOB2(P3) ;POINT TO THE ROUTED OBJECT BLOCK
JUMPE P2,[MOVE S1,OBJ.ND(P3) ;NO OBJECT,,GET ROUTED NODE NAME
PJRST N$NODE ] ;RETURN THROUGH N$NODE
MOVE S1,OBJ.ND(P3) ;GET THE ENTRY NODE NAME/NUMBER
MOVE S2,OBJNOD(P2) ;GET THE OBJECT NODE NAME/NUMBER
PUSHJ P,N$MTCH ;DO THEY MATCH ???
$RETIF ;No, object does not match route dest.
MOVE S1,OBJ.UN(P3) ;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
$RETF ;No, object does not match route dest.
;Here to check for device attributes match
CSTN.4: 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 .RETF ;NO,,RETURN FAILURE
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 !!!
$RETT ] ;WIN IF A MATCH !!!
LOAD S1,OBJSCH(P2),OBSSUP ;GET THE OBJECT SETUP STATUS BIT
JUMPE S1,.RETT ;NOT SETUP,,RETURN
LOAD S1,OBJDAT(P2),RO.ATR ;YES,,GET OBJECT ATTRIBUTES
CAMN S1,S2 ;DO THE ATTRIBUTES MATCH?
$RETT ;YES,,RETURN OK
CAXE S2,%GENRC ;DOES USER WANT GENERIC DEVICE ???
$RETF ;NO,,RETURN
CAXE S1,%LOWER ;IS DEVICE LOWER
CAXN S1,%UPPER ; OR UPPER ????
$RETT ;YES,,HE WINS
$RETF ;NO,,RETURN NO GOOD
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: $WTO (<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
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
$WTO(< 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
$ACK (<^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 !!!
$SAVE <H,AP> ;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