Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
networ.mac
There are 9 other files named networ.mac in the archive. Click here to see a list.
TITLE NETWORK: Program to list the nodes in a network
SUBTTL S. Sullivan
.TEXT \/SYMSEG:HIGH/LOCALS\ ;[19]
COMMENT/
COPYRIGHT (C) 1979,1980 BY
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
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.
/
SUBTTL Edit history
;[1] Add the /TYPE: switch to determine a node by it's type
;[2] Fix the core freeing code in CLRDAT to not zero DDT when loaded
;[3] Fix the BLT in CLRDAT so it does not initalize MATCH to -1
;[4] Fix the .ISCAN call so indirect files are illegal if logged out
;[5] Make sure the user can't get into a "*" mode if not logged in
;[6] Take care of the way the NODE. UUO error returns easier now
;[7] Make CONC use .ISLGI in SCAN to be consistant in checking if logged in
;[8] We saved the temps too early in the OFLINE routine
;[9] Make sure that we are able to recover from a node in a "funny" state
;[10] Buffer TTY output to reduce monitor overhead
;[11] Change "NODE" in output to "Node"
;[12] Change the HOST switch to be HOSTESS to be monitor compatable
;[13] Make the program Reenterable by setting up .JBREN
;[14] Change the way TRMOP. errors are handled and fix
; miscellaneous bugs.
;[15] Make a zero low segment. Remove EXPs and replace with BLOCK.
;[16] Don't allow "*" mode if not logged in...only can do when we
; get control because SCAN has a matching bug, before we get it.
;[17] Add a reset instruction because the dispatch through RUNAME
; or RUNAMC in COMCON or the RUN/R command will not do a
; reset unless the program is gotten from DSK. This means
; that if the sharable dormant high seg was there and there
; was no low seg an address check was the result.
;[18] Fix OFLINE and correct other error recovery problems
;[19] Add the /TOPOLOGY,/COST, and /SORT switches and fix some
; more small bugs including a stack phase problem when we
; used the default case (null node name).
SUBTTL Constants, symbols, and registers
SEARCH UUOSYM,JOBDAT,MACTEN,SCNMAC
.REQUE REL:SCAN.REL
.REQUE REL:HELPER.REL
TWOSEG ;So the program will have two segments
;** Define the version word
CUSTVR==0 ;Customer version
DECVER==1 ;DEC version
DECMVR==0 ;DEC minor version
DECEVR==^D19 ;DEC edit number
NETVER=CUSTVR*1B2+DECVER*1B11+DECMVR*1B17+DECEVR
LOC 137
NETVER
;** Set up .JBINT for interupt trapping
LOC 134 ;Set PC at .JBINT and
EXP INTBLK## ;make it point to our interupt block
;[13] ** Set up .JBREN to allow users to "Reenter" the program
LOC 124 ;[13] Set PC at .JBREN
EXP START+1 ;[13] Use the run start address
RELOC 400000 ;Set back to the high segment
;REGISTER DEFINITIONS
T1=1 ;Temps
T2=2
T3=3
T4=4
P1=5 ;Save registers
P2=6
P3=7 ;For passing arguments to SCAN
P4=10
T5=11
T6=12
T7=13
CN=14 ;Current node we are processing
L1=15 ;First loop counter
L2=16 ;Second loop counter
P=17 ;Stack pointer
SUBTTL Start up and initalization code
START:: TDZA P,P ;[19]Run start
MOVEI P,1 ;CCL start
MOVEM P,OFFSET## ;Save starting offset for Scan
MOVE P,[PSIZ##,,PDL##] ;Set up the stack
RESET ;[17] RESET to prevent address checks
PUSHJ P,CLRDAT ;Clear the data base...
PUSHJ P,ISCN ;Initalize Scan
MOVE T1,OUTCON## ;[10] Get the output control word
TLZ T1,MO.CHR## ;[10] Set the character mode bit
MOVEM T1,OUTCON## ;[10] And store it
SETZ T1, ;[10] Clear our character buffer out
PUSHJ P,OUTC ;[10] and output it
JRST TSCN ;and use Scan to scan a line
;** Routine to reset the data areas
CLRDAT: HLRZ T1,.JBSA ;[2] Reduce our core back to small
CORE T1, ;as we should be.
JFCL ;We don't care
MOVE T2,OFFSET## ;Save our start address offset
MOVE T1,[STDAT##,,STDAT##+1] ;Get the start and end of impure data
SETZM STDAT## ;Zero the first word
BLT T1,ENDAT## ;to the last word
SETOM FIRSW## ;Set the first location of the
MOVE T1,[FIRSW##,,FIRSW##+1] ;Switch block to -1, then
BLT T1,LASTSW##-1 ;[3] BLT to the last one
;*All switchs must be initalized
;to -1 or Scan won't work right
MOVE T1,[INT##,,INTBLK##] ;[15] initalize interupt control block
BLT T1,INTYPE##-1 ;[15] from data in the high seg
MOVEI T1,.TOWID ;Set up the argument block for TTY width
MOVEM T1,TTWID## ;So we can find his TTY's width
MOVEI T1,MAXNOD##+1 ;The max number of nodes we can handle
MOVEM T1,NODNUM## ;So we can build tables of nodes
ADDI T1,2 ;Fix the value for the
MOVEM T1,NDLEN## ;.NDNDB function of the NODE. UUO
MOVEM T2,OFFSET## ;Restore the offset
POPJ P, ;Done...return
;** Here when we have specified nodes
CCLST: MOVN L1,NODCNT## ;Set up counter for the MAIN loop
HRL L1,L1 ;as an AOBJN counter
HRRI L1,NODCNT##+1 ;With the RH pointing to node list
JRST LOOP ;Do the MAIN loop
;** Here when we have no nodes specified
RUNST:: PUSHJ P,NETAB ;[19] Set up the network tables
RUNST1: ;[19] Enter here for default case
;[19] because the list of nodes is
;[19] already set up and sorted as s
;[19] necessary
MOVN L1,NODNUM## ;Set up counter for the MAIN loop
HRL L1,L1 ;as an AOBJN counter
HRRI L1,NODNUM##+1 ;With the RH pointing to node list
MOVEI T1,1 ;Our default
SKIPGE BRIEWD## ;Did he specify /BRIEF or /NOBRIEF?
MOVEM T1,BRIEWD## ;No, assume /BRIEF on default
;Fall into MAIN loop
SUBTTL Main program loop
;** Here for either the default or non-default case
LOOP: MOVE CN,(L1) ;Get the current node number
PUSHJ P,BLDNDB ;Build a copy of the node's NDB
PUSHJ P,SELECT ;Does node meet switch constraints?
PUSHJ P,PRINFO ;Yes, Print selected info
AOBJN L1,LOOP ;Increment and loop till done
LOOP0: SKIPN MATCH## ;Did we have any matches?
PUSHJ P,NOMAT ;No, Tell user if constraints too tight
LOOP1: SKIPE OFFSET## ;[19] Did we CCL start?
JRST FINISH ;[10] No, exit and flush buffers
PUSHJ P,.ISLGI## ;[16] Are we logged in?
JRST FINISH ;[16] No, exit and flush buffers
PUSHJ P,CRLFH ;No, type a <CR><LF>
MOVE T1,OUTCON## ;[10] Get the output control word
TLZ T1,MO.CHR## ;[10] Set the character mode bit
MOVEM T1,OUTCON## ;[10] And store it
SETZ T1, ;[10] Clear our character buffer out
PUSHJ P,OUTC ;[10] and output it
PUSHJ P,CLRDAT ;and clear the data area
JRST TSCN ;and look for another line of input
SUBTTL Build tables of network information
;** Here to build our network tables, this is our snapshot of the network
NETAB: MOVE T1,[-1] ;Set to get our UDX in the data base
TRMNO. T1, ;Can we get it?
PUSHJ P,TRMOER ;No, TRMNO. error, tell the user and die
MOVEM T1,UDX## ;Yes, save it in TRMOP. argument block
MOVE P1,NODBIN## ;Point to table for node numbers
MOVE P2,[XWD .NDNLS##,NODNUM##] ;Set up ac for NODE. UUO
NODE. P2, ;Can we get the table of node numbers?
PUSHJ P,NODERR ;No, tell user why and die
MOVEM P2,NODNUM ;Stash the number of nodes in network
MOVN P2,P2 ;Negate the number of nodes
HRL P2,P2 ;Make it an AOBJN counter
HRRI P2,NODBIN## ;Point RH to table of node numbers
SKIPLE SORTWD## ;[19] Should we sort the network?
PUSHJ P,NETSRT ;[19] Yes, call the bubble sort
MOVEI P3,2 ;[19] Get the argument block length
NETAB1: MOVE P4,(P2) ;[19] Get a node number
MOVE P1,[XWD .NDRNN,P3] ;Set up P1 for NODE. UUO
NODE. P1, ;Can we change number to sixbit name?
SETZ P1, ;[6] No, make it a zero name and wing it
MOVEM P1,MAXNOD##(P2) ;Yes, stash in ajacent table of names
AOBJN P2,NETAB1 ;[19] Loop till done
POPJ P, ;Return
;[19] Here to sort the node numbers gotten above
;[19] P2=AOBJN pointer to table of node numbers
;[19] T1=Count of exchanges in this pass of table of node numbers
;[19] T2=Working copy of the AOBJN pointer in P2
;[19] T3=The register used for comparisons and exchanges
NETSRT: PUSH P,P2 ;[19] Save the AOBJN pointer for a bit
AOBJP P2,NETSR4 ;[19] N elements means N-1 compares
NETSR1: SETZ T1, ;[19] Clear the count of exchanges
MOVE T2,P2 ;[19] Get a copy of tha AOBJN pointer
NETSR2: MOVE T3,-1(T2) ;[19] Get value of the node before here
CAMLE T3,(T2) ;[19] and compare it with this one
JRST [EXCH T3,(T2) ;[19] If they are out of order,
EXCH T3,-1(T2) ;[19] then exchange them
AOJA T1,NETSR3] ;[19] and count the exchanges
NETSR3: AOBJN T2,NETSR2 ;[19] Loop over all comparisons
JUMPN T1,NETSR1 ;[19] Repeat if there were any exchanges
NETSR4: POP P,P2 ;[19] Restore p2. we are done
POPJ P, ;[19] Done, return
SUBTTL Copy the current nodes NDB
;** Here to build a copy of the node's NDB in our space
BLDNDB: HRRZM CN,NNM## ;Stash node number
HRRZM CN,CURNOD## ;Again for NODE. UUO
MOVEI T1,2 ;Set up the field number
MOVEM T1,FLDNUM## ;for the NODE. UUO
MOVE T2,CN ;[19] Get the current node #
MOVE T3,[.NDRNN,,T1] ;[19] Set up the AC
NODE. T3, ;[19] Try to get the name
JRST OFLINE ;[19] Oops, node in a funny state
MOVEM T3,SNM## ;[19] Stash it
MOVE T1,[.NDNDB##,,NDLEN##] ;[19] Set up the ac
AOS FLDNUM## ;Point to next field in NDB
NODE. T1, ;Get next info?
JRST OFLINE ;No, investigate
MOVE T3,[DATBLK##,,SID##] ;Yes, set up to BLT software ID
BLT T3,DAT## ;to our NDB copy
AOS FLDNUM## ;Point to software date field
NODE. T1, ;Get more info?
JRST OFLINE ;No, investigate
MOVE T3,[DATBLK##,,DAT##] ;Yes, set up to BLT date
BLT T3,LMA## ;to our NDB copy
AOS FLDNUM## ;Point to next field
MOVE L2,[-10,,LMA##] ;make loop counter for one word fields
BLDND1: NODE. T1, ;Get the info?
JRST OFLINE ;No, investigate
MOVE T2,DATBLK## ;Yes, move it to
MOVEM T2,(L2) ;our NDB copy
AOS FLDNUM## ;Increment to point to next field
AOBJN L2,BLDND1 ;Loop till done
NODE. T1, ;Get the topology table?
JRST OFLINE ;No, investigate
MOVE T3,[DATBLK##,,TOP##] ;Yes, copy topology table
BLT T3,CNF## ;to our NDB copy
AOS T3,FLDNUM## ;Point to the configuration field
NODE. T1, ;Can we get it?
JRST OFLINE ;No, investigate
MOVE T3,[DATBLK##,,CNF##] ;Yes, BLT it to
BLT T3,ENDB## ;our NDB copy
POPJ P, ;Return
;** Here to decide whether or not to print a node. The decision is
; based on the selection of /<device-name> switches.
; A skip return is taken if the node is not to be printed.
SELECT: MOVE T1,[-NDEV##,,MCRWD##] ;Make a AOBJN pointer to switch words
SELEC0: SKIPGE (T1) ;Is this switch selected?
JRST SELEC3 ;No, ok so far
MOVE T2,[-NDEV##,,CNF##] ;AOBJN pointer to the configuration info
SELEC1: SKIPN (T2) ;Is configuration word zero?
JRST SELEC2 ;Yes, see if a /NO<device> switch
HLRZ T3,(T2) ;Get the object type
ADDI T3,MCRWD## ;Make the address of the switch work
CAIE T3,(T1) ;Are the addresses the same?
AOBJN T2,SELEC1 ;No, loop till found or NDEV
SKIPE (T1) ;Is it a /<device> switch?
JRST SELEC3 ;Yes, Ok so far
JRST SELEC4 ;No, don't print this node
SELEC2: SKIPG (T1) ;Is it a /<device> switch?
JRST SELEC3 ;No, Ok so far
SELEC4: AOS (P) ;We don't want to print so skip return
POPJ P, ;...
SELEC3: AOBJN T1,SELEC0 ;Loop through all switches
SETO T1, ;[1] Make T1 -1
CAMN T1,TYPWD## ;[1] Did we specify /TYPE:?
JRST SELEC5 ;[1] No, don't check it
MOVE T1,TYPWD## ;[1] Get the type we are looking for
MOVEI T2,SID## ;[1] Point to the software ID
PUSHJ P,ASCSIX ;[1] See if it matches
JRST SELEC4 ;[1] No match, skip return
SELEC5: AOS MATCH## ;Count the number of matches
POPJ P, ;We want to print this node, just return
;[1] ** Routine to compare the first six characters of an ASCIZ string
;[1] with the SIXBIT value it T1
;[1]
;[1] call: T1=SIXBIT/value/
;[1] T2=[ASCIZ/string/]
;[1] PUSHJ P,ASCSIX
;[1] <no match> ;First six chars of string converted to sixbit in T2
;[1] <match>
ASCSIX::PUSHJ P,.PSH4T## ;[1] Save the temps
MOVE T1,[-6,,-6] ;[1] Set up an AOBJN pointer
SETZB T4,TEMP## ;[1] Clear temps where necessary
HLL T2,[POINT 7,0] ;[1] Byte pointer for the asciz string
MOVE T3,[POINT 6,TEMP##] ;[1] Byte pointer for sixbit conversion
ASCSI1: ILDB T4,T2 ;[1] Get a byte from the string
SUBI T4," " ;[1] Make SIXBIT
JUMPLE T4,ASCEOS ;[1] Is the character a space?
IDPB T4,T3 ;[1] Place into the save byte
AOBJN T1,ASCSI1 ;[1] Loop about 6 times
ASCEOS: PUSHJ P,.POP4T## ;[1] Restore the temps
CAMN T1,TEMP## ;[1] Is it the same??
AOS (P) ;[1] Yes, do the skip return
CAME T1,TEMP## ;[1] Did we match?
MOVE T2,TEMP## ;[1] No, copy what we had to T2
POPJ P, ;[1] Return
SUBTTL Output routines
;** Here to print the information about a node.
; This routine dispatches according to the switches selected:
; /SILENCE, /FAST, /BRIEF, /WIDTH, /TOPOLOGY
;
; destroys many registers
PRINFO: AOS MATCH## ;If here we must have had a match
SKIPLE SILWD## ;/SILENCE?
POPJ P, ;Yes, Just return...errors only!
MOVE T4,WIDWD## ;See if they said /WIDTH:nn
MOVEM T4,CARWID## ;Stash it just in case
JUMPG T4,PRINF1 ;Yes, don't get the TTY width
MOVE T4,[XWD 3,TTWID##] ;Set up to get the TTY width
TRMOP. T4, ;Try for it
MOVEI T4,DEFWID## ;[14] Error, use the default width!
MOVEM T4,CARWID## ;Save for other routines
PRINF1: SKIPLE TOPWD## ;If /TOPOLOGY was specified
JRST PRTOPO ; then go print it
SKIPG FASWD## ;/NOFAST or default?
PUSHJ P,PFIRST ;Yes, print the first line
SKIPLE FASWD## ;/FAST?
PUSHJ P,SHOLST ;Yes, do a short list
SKIPG FASWD## ;/FAST?
JRST PRINF2 ;No, /BRIEF is the default
SKIPE BRIEWD## ;Did he say /BRIEF?
JRST PRINF3 ;Yes, don't print configuration
PRINF2: SKIPG BRIEWD## ;Here if /NOFAST or default
PUSHJ P,PCONF ;No, print the configuration
PRINF3: POPJ P, ;Return to loop
;** Here to print the first line in the default format
;
PFIRST: PUSHJ P,CRLFH ;Lead off with a <CR><LF>
MOVEI T1,[ASCIZ/Node /] ;[11] Print the lead word
PUSHJ P,.TSTRG## ;...
PUSHJ P,.TTABC## ;Print a <tab>
MOVE T1,SNM## ;Get the sixbit node name
PUSHJ P,.TSIXN## ;and print it
PUSHJ P,.TTABC## ;followed by a <tab>
MOVEI T1,"(" ;Get a <left-paren>
PUSHJ P,.TCHAR## ;and print it
MOVE T1,NNM## ;Get out node number
PUSHJ P,.TOCTW## ;and print it in octal
MOVEI T1,")" ;Get a <right-paren>
PUSHJ P,.TCHAR## ;and print it
PUSHJ P,.TTABC## ;followed by a <tab>
MOVEI T1,^D28 ;This is our horizontal position
MOVEM T1,HPOS## ;so set it
MOVEI T1,SID## ;Point at the software ID (asciz)
PUSHJ P,KILBLK ;And kill leading blanks
PUSHJ P,TCARE ;and print it carefully
PUSHJ P,.TTABC## ;followed by a <tab>
MOVEI T1,DAT## ;Point to the software date (asciz)
PUSHJ P,TCARE ;and print it carefully
POPJ P, ;Return
;[19] Here to print topology information for a node
;[19] P1 points to topo, p2 = count
PRTOPO: PUSHJ P,CRLFH ;[19] Lead off with a <CR><LF>
SETZ P2, ;[19] Clear the count of chars printed
MOVEI T1,[ASCIZ/Node /] ;[19] Lead off with "node<tab>"
PUSHJ P,.TSTRG## ;[19] ...
MOVE T1,SNM## ;[19] Get the name
PUSHJ P,.TSIXN## ;[19] and print it
PUSHJ P,.TTABC## ;[19] Print a <TAB>
MOVEI T1,"(" ;[19] Get an open paren
PUSHJ P,.TCHAR## ;[19] and print it
MOVE T1,NNM## ;[19] Get the node's number
PUSHJ P,.TOCTW## ;[19] and print it
MOVEI T1,")" ;[19] Finally, get the close paren
PUSHJ P,.TCHAR## ;[19] and print it
PUSHJ P,.TTABC## ;[19] Print another <TAB>
MOVEI P2,30 ;[19] 3 <TAB>s bring us to col # ^D24
MOVEM P2,HPOS## ;[19] Save our horizontal position
;[19] Set up to output the topology information
MOVEI P1,TOP## ;[19] Get the address of the topology
SKIPN (P1) ;[19] and if there aren't any
JRST [MOVEI T1,[ASCIZ \None\];[19] neighbors, then
PJRST TCARE] ;[19] tell the user
JRST PRTOP3 ;[19] Skip the ","<TAB> the first time
;[19] Here to type a comma in the correct place
PRTOP2: MOVEI T1,[ASCIZ/, /] ;[19] Point to ","<TAB>
CAME P2,10 ;[19] No ","<TAB> if we called CRLFH
PUSHJ P,TCARE ;[19] type it
;[19] Here to print the neighbor's node number
PRTOP3: MOVE P2,HPOS## ;[19] Get the horizontal position
HRRZ T1,(P1) ;[19] Get the neighbors node number
PUSHJ P,FLATSO ;[19] Account for the size
PUSHJ P,.TOCTW## ;[19] and print it in octal
SKIPE COSTWD## ;[19] Should we print the link costs?
PUSHJ P,PRCOST ;[19] Print the link costs
SKIPE 1(P1) ;[19] See if there are any more entrys
AOJA P1,PRTOP2 ;[19] and if so, go process them
SKIPN BRIEWD## ;[19] Check for configuration typeout
PUSHJ P,PCONF ;[19] Yes, do the configuration
POPJ P, ;[19] No more neighbors to process
;[19] Here to print the link costs
PRCOST: HLRZ T1,(P1) ;[19] Get the link's cost
PUSHJ P,FLATSD ;[19] Account for the size
ADDI P2,2 ;[19] Allow for the ")" & "("
MOVE T1,P2 ;[19] Save P2
SUB T1,HPOS## ;[19] Get the length of the string
CAML P2,CARWID## ;[19] exceeded the carrage width?
PUSHJ P,CRLFH ;[19] Yes, <CRLF> now
ADDM T1,HPOS## ;[19] add the length of the string
MOVE P2,HPOS## ;[19] Restore the horizontal postion
MOVEI T1,"(" ;[19] Get an open paren
PUSHJ P,.TCHAR## ;[19] and print it
HLRZ T1,(P1) ;[19] Get the link's cost
PUSHJ P,.TDECW## ;[19] and print it in decimal
MOVEI T1,")" ;[19] Finish off the entry
PUSHJ P,.TCHAR## ;[19] with a close paren
POPJ P, ;[19] and return
;[19] Routines to count (in P2) the number of chars used in the printed
;[19] representation of the item in T1.
FLATSN: PUSH P,T1 ;[19] Here for counting names
MOVEM P2,HPOS## ;[19] Save the horizontal position
FLATN1: SKIPE T1 ;[19] If we haven't zeroed the whole wd
JRST [LSH T1,6 ;[19] yet, then shift the name
AOJA P2,FLATN1] ;[19] and count it
CAML P2,CARWID## ;[19] Can this fit??
PUSHJ P,CRLFH ;[19] Too big to fit, <CRLF> now
MOVE P2,HPOS## ;[19] Restore the local count
POP P,T1 ;[19] Restore the name
POPJ P, ;[19] and return
FLATSO: PUSH P,T1 ;[19] Here for octal numbers
MOVEM P2,HPOS## ;[19] Save the horizontal position
SKIPE T1 ;[19] Worry about a zero
FLATO1: SKIPE T1 ;[19] if we're not done yet
JRST [LSH T1,-3 ;[19] divide the number by 8
AOJA P2,FLATO1] ;[19] and count the digit
CAML P2,CARWID## ;[19] Can this fit??
PUSHJ P,CRLFH ;[19] Too big to fit, <CRLF> now
MOVE P2,HPOS## ;[19] Restore the local count
POP P,T1 ;[19] restore the number
POPJ P, ;[19] and return
FLATSD: PUSH P,T1 ;[19] Here for decimal numbers
SKIPE T1 ;[19] Make sure zero counts 1
FLATD1: SKIPE T1 ;[19] If there are still more digits
JRST [IDIVI T1,5+5 ;[19] divide by 10
AOJA P2,FLATD1] ;[19] and count the char
MOVEM P2,HPOS## ;[19] Save the horizontal position
POP P,T1 ;[19] Restore the number
POPJ P, ;[19] and return
;** Here to print the configuration information
PCONF: PUSHJ P,CRLFH ;print a <CR><LF>
MOVE P1,[XWD -20,CNF##] ;Make a AOBJN pointer
PUSHJ P,.TTABC## ;Type a <tab>
MOVEI T5,10 ;and set up horizontal position
PCONF1: SKIPN (P1) ;Any more devices?
JRST PCONF2 ;No, all done
HLRZ T1,(P1) ;Yes, get the configuration word
MOVE T1,CTAB##(T1) ;and the asciz name string
PUSHJ P,.TSTRG## ;and print it
HRRZ T1,(P1) ;Get how many
PCONF3: IDIVI T1,10 ;and find the number of digits
ADDI T5,1 ;add one to the horizontal position
JUMPG T1,PCONF3 ;loop till we have counted all digits
HRRZ T1,(P1) ;Get how many, again
PUSHJ P,.TDECW## ;and print it this time
MOVEI T1,"]" ;Get a <left bracket>
PUSHJ P,.TCHAR## ;and print it
PUSHJ P,.TSPAC## ;followed by a space
ADDI T5,6 ;Add number of characters in the:
;device name [3]
;brackets [2]
;<space> [1]
;to the horizontal position
PUSH P,T5 ;save T5
ADDI T5,11 ;Add the max expected for the
;next device
CAML T5,T4 ;Do we exceed the TTY's width?
JRST PCONF4 ;Yes, do a <CR><LF>
POP P,T5 ;No, restore T5 and
AOBJN P1,PCONF1 ;loop till done
PCONF2: SKIPLE FASWD## ;Did he type /FAST?
PUSHJ P,CRLFH ;No, do a <CR><LF>
POPJ P, ;return
PCONF4: SKIPG 1(P1) ;any more devices?
JRST PCONF5 ;Yes, loop back
PUSHJ P,CRLFH ;Type a <CR><LF>
PUSHJ P,.TTABC## ;and a <tab>
PCONF5: POP P,T5 ;then restore T5
MOVEI T5,10 ;Reset the horizontal position counter
AOBJN P1,PCONF1 ;and loop back
;** routine to produce a listing of nodes in the network
; by name and number only on one or two lines
SHOLST: SKIPN FIRSTL## ;Is this the first spec?
PUSHJ P,CRLFH ;Yes, do a <CR><LF>
AOS FIRSTL## ;Count the number of specs we do
MOVEI T1,"," ;In case we need a comma
SKIPE HPOS## ;Did we just type a <CR><LF>
PUSHJ P,.TCHAR## ;No, type a comma
SKIPE HPOS## ;Did we just do a <CR><LF>
AOS HPOS## ;No, typed a "," so increment position
MOVE T1,CARWID## ;Get the width of our TTY
SUBI T1,^D12 ;Allow for our worst case
SUB T1,HPOS## ;Do we have enough room on the line?
JUMPG T1,SHOLS1 ;...
SETZM HPOS## ;No, Reset our position
PUSHJ P,CRLFH ;No, do a <CR><LF>
SHOLS1: MOVE T1,SNM## ;Get the sixbit node name
PUSHJ P,HOSIX ;Keep track of our horizontal position
PUSHJ P,.TSIXN## ;Type the name
MOVEI T1,"(" ;Type a left paren
PUSHJ P,.TCHAR## ;...
MOVEI T3,2 ;# of punctuation characters
HRRZ T1,NNM## ;Type the node number
SHOLS2: IDIVI T1,10 ;Get the number of digits
AOS T3 ;Add one to count and see if more
JUMPG T1,SHOLS2 ;Loop till count exausted
ADDM T3,HPOS## ;Adjust the horisontal position
HRRZ T1,NNM## ;Get the node number again
PUSHJ P,.TOCTW## ;in octal...
MOVEI T1,")" ;Followed by a right paren
PUSHJ P,.TCHAR## ;...
POPJ P, ;Return
;** Routine to keep track of the horizontal position of the
; cursor on the tty when printing sixbit words from T1
;
;preserves all registers
HOSIX: PUSHJ P,.PSH4T## ;Save the temps...
SETZ T2, ;Zero T2 in case 6 chars in T1
MOVE T3,[POINT 6,T1] ;Point at the sixbit word
HOSIX1: ILDB T4,T3 ;Get a byte
AOS HPOS## ;No, count over 1 space
JUMPN T4,HOSIX1 ;Is it zero?
HOSIX2: PUSHJ P,.POP4T## ;No, restore the temps
POPJ P, ;Return
;** Here to do a carrage return/ line feed sequence
; and set HPOS (our horizontal position) to zero
CRLFH: SETZM HPOS## ;Set the horizontal position back to
;the left margin
PJRST .TCRLF## ;And do a real <CR><LF>
;** Here to kill leading blanks or tabs from a string pointed to by T1
; Returns with T1 pointing to the start of the new string
; * destroys P3
KILBLK: PUSHJ P,.PSH4T## ;Save the temps
HLL T1,[POINT 7,0] ;Make T1 a byte pointer
MOVE T3,T1 ;Copy it
KILBL1: ILDB T2,T1 ;Load a byte
CAIN T2,40 ;Is it a <blank>
JRST KILBL1 ;Loop til we find a non-blank character
CAMN T1,T3 ;Are the byte pointers different?
JRST KILBL4 ;No, return to the caller
KILBL2: IDPB T2,T3 ;Deposit the current byte
ILDB T2,T1 ;Get another byte
JUMPN T2,KILBL2 ;Loop until zero byte
IDPB T2,T3 ;and deposit it
KILBL4: PUSHJ P,.POP4T## ;Restore the temps
POPJ P, ;and return
;** here to type a asciz string without exceeding the page width
; (if possible).
TCARE: PUSHJ P,.PSH4T## ;Save the temps
MOVEI T3,0 ;Clear T3
HLL T1,[POINT 7,0] ;Make a byte pointer
TCARE1: ILDB T2,T1 ;Get the first byte
CAIN T2," " ;Is this a <tab>
PUSHJ P,CARTAB ;Yes, handle it
AOS T3 ;Increment the string length
JUMPN T2,TCARE1 ;Loop till the end of the string
SOS T3 ;Correct for the Off By One error
ADD T3,HPOS## ;Add this to our horizontal position
CAMLE T3,CARWID## ;Is this less than the width?
JRST TCARE4 ;No, reset and <CR><LF>
MOVEM T3,HPOS## ;Yes, Save the horizontal position
TCARE3: PUSHJ P,.POP4T## ;and restore the temps
PJRST .TSTRG## ;Type the string and return
TCARE4: SUB T3,HPOS## ;Get the length of the string back
CAMLE T3,CARWID## ;Will it ever fit
JFCL ;No, Punt! til we think of
;something better
ADDI T3,10 ;Followed by <CR><LF> with a <tab>
PUSHJ P,CRLFH ;Do a <CR><LF>
PUSHJ P,.TTABC## ;Do a <tab>
MOVEM T3,HPOS## ;Reset horizontal position
JRST TCARE3 ;And return to the user
;** Here to handle typing a <tab> with our horizontal position counter
CARTAB: PUSH P,T4 ;Save T3
PUSH P,T3 ;and T4
ADDI T3,10 ;A <tab> is 8 (decimal) spaces
IDIVI T3,10 ;So what we really want is
POP P,T3 ;MOD 8 added to T3
ADD T3,T4 ;So do it
SOS T3 ;Off by one trick again
POP P,T4 ;Restore T4
POPJ P, ;Return
SUBTTL Routines to interface to Scan
;[10] ** Routine to finish I/O and exit
;[10]
FINISH: MOVE T1,OUTCON## ;[10] Get the output control word
TLO T1,MO.CHR## ;[10] Bit to go into character mode
MOVEM T1,OUTCON## ;[10] Set in output control word
SETZ T1, ;[10] Clear T1 to be a Null
PUSHJ P,OUTC ;[10] Output the rest of the buffer
JRST .MONRT## ;[10] And exit gracefully
;[10] ** Routine to buffer tty output
;[10] Called by SCAN and placed in character mode for prompt
;[10] The character is in T1
OUTC:: SKIPL OUTCON## ;[10] If bit 0 is set then line mode
JRST OUTLST ;[10] If char mode output the buffer
SOSGE NCHAR## ;[10] Decrement the character count
JRST OUTLST ;[10] Output it to the TTY
IDPB T1,BUFFP## ;[10] Deposit character in the buffer
POPJ P, ;[10] Return
OUTLST: IDPB T1,BUFFP## ;[10] Store the last character
SETZ T1, ;[10] Zero character next
IDPB T1,BUFFP## ;[10] To make the string ASCIZ
OUTSTR BUFFER## ;[10] Output the buffer
MOVE T1,[POINT 7,BUFFER] ;[10] Reset the buffer pointer
MOVEM T1,BUFFP## ;[10] ...
MOVEI T1,BUFSIZ## ;[10] Reset the character count
MOVEM T1,NCHAR## ;[10] ...
POPJ P, ;[10] Return to SCAN
;** Here from Scan to allocate space for Scan blocks as node or file specs
; IALLO increments number of specs on the input side of the "="
; OALLO increments the number of specs on the output side of the "="
;
; Scan will try to BLT the info into the right spot
IALLO:: AOS INFIL## ;Add one to the number of input specs
SKIPA ;If here always skip OUTFIL increment
OALLO:: AOS OUTFIL## ;Add one to the number of output specs
MOVE T1,NUMBLK## ;Get the number of blocks so far
IMULI T1,BLKSIZ## ;Get the amount of core this takes
ADDI T1,BLKSIZ##+SBLKS## ;And add one more block & address
CAMG T1,.JBREL ;Do we already have enough core?
JRST OALLO1 ;Yes, We already have enough
PUSH P,T1 ;No, Save T1 around CORE UUO
CAILE T1,MAXCOR## ;Are we still smaller than max allowed
JRST ALOCER ;No, tell user
ADDI T1,BLKSIZ## ;Add block size
ANDI T1,777000 ;Mask to pages
ADDI T1,1000 ;And add one
CORE T1, ;...
JRST ALOCER ;Allocation error, tell user
PUSHJ P,.TCRLF## ;Do a <CR><LF>
MOVEI T1,"[" ;Type a <left bracket>
PUSHJ P,.TCHAR## ;...
MOVE T1,.JBREL ;Get how much we got now
ANDI T1,777000 ;Mask to pages
ADDI T1,2000 ;And add one
PUSHJ P,.TCORW## ;Type how much core we are using
MOVEI T1,[ASCIZ/ core]/] ;Tell him it's core
PUSHJ P,.TSTRG## ;...
POP P,T1 ;Ok, Restore T1
OALLO1: MOVEI T2,BLKSIZ## ;a pointer and a block size
SUB T1,T2 ;Backup one block length
AOS NUMBLK## ;add one to the count of
;Scan blocks allocated
POPJ P, ;Return to Scan
;** Here to initalize Scan with .ISCAN
; called from the startup code
ISCN: MOVE T2,[ISLEN##,,ISBLK##] ;.ISCAN argument block if logged in
PUSHJ P,.ISLGI## ;[4] Are we logged in?
MOVE T2,[ISLEN##,,ISBLO##] ;[4] .ISCAN argument block if logged out
MOVE T1,T2 ;[4] Put the argument into T2
PJRST .ISCAN## ;Call .ISCAN
;** Here to do the Traditional Scanner .TSCAN
; called from the startup code
TSCN: MOVE T1,[TSLEN##,,TSBLK##] ;.TSCAN argument block
PUSHJ P,.TSCAN## ;Scan a line of input
MOVE T1,[OSLEN##,,OSBLK##] ;.OSCAN argument block
PUSHJ P,.OSCAN## ;Check SWITCH.INI[,]
MOVE T1,OUTCON## ;[10] Get the output control word
TLO T1,MO.CHR## ;[10] Set output mode to string mode
MOVEM T1,OUTCON## ;[10] And store it
SKIPN NUMBLK## ;Do we have Scan blocks to process?
JRST RUNST ;No, take default start
PUSHJ P,NETAB ;[19] Build network tables
SUBTTL Dissect the Scan blocks
;** Routine to get a node-spec out of a Scan block
;
; If the spec is "wild" do a search of node names for winners
; If not "wild" use the NODE. UUO to figure out who we want
; Then (in either case) insert the proper entries into the
; selection table
; Finally jump to the main loop to tell the user about what we already know
DISECT: MOVN T3,NUMBLK## ;Number of Scan Blocks
HRL T3,T3 ;Make an AOBJN pointer
HRRI T3,SBLKS## ;Point to the first Scan block
DISEC1: MOVE T1,.FXMOD(T3) ;Get the modifier word
TDNN T1,[FX.NDV] ;Did he type a device?
JRST SPECER ;Yes, tell him
TDNN T1,[FX.NUL] ;Did he type an extension?
JRST SPECER ;Yes, tell him
TDNE T1,[FX.DIR] ;Did he type a P,PN?
JRST SPECER ;Yes, tell him
MOVE T1,.FXNAM(T3) ;Get the name
SKIPE OFFSET## ;Run start?
JUMPE T1,WILDS2 ;Yes, keep prompting
SKIPN T2,.FXNAM(T3) ;Is the name null?
PUSHJ P,DEFCAS ;See if the default case
SETO T1, ;Make a mask for the mask
ANDCM T1,.FXNMM(T3) ;And out the mask
JUMPN T1,WILDS ;Yes, handle wildcarding
MOVEI T1,2 ;No, set up an argument block
MOVE P4,[.NDRNN,,T1] ;and an ac
DISEC4: NODE. P4, ;Use NODE. UUO to check node
JRST NONOD ;Error, tell user node is no good
TLNE P4,777777 ;Is what we have a name?
JRST [MOVE T2,P4 ;Yes, reset the argument block
MOVE P4,[.NDRNN,,T1] ;Set ac back up
JRST DISEC4] ;Make it a node number
MOVN T1,NODNUM## ;Here when we have a number
HRL T1,T1 ;Swap halves and make into
HRRI T1,NODBIN## ;an AOBJN counter
DISEC3: HRRZ T2,(T1) ;Get RH
CAME P4,T2 ;A match?
AOBJN T1,DISEC3 ;No, loop till match or EOT
CAME P4,T2 ;Match or EOT?
JRST DISEC5 ;EOT, handle it
SETOM (T1) ;Make a flag entry in memory
HRRM P4,(T1) ;Put the entry back in the table
AOS NODNUM## ;[19] Count this in the total too
JRST WILDS2 ;Jrst to the next Scan block
DISEC5: AOS NODNUM## ;EOT but, node is there
HRLI P4,777777 ;Insert into table and flag
MOVEM P4,(T1) ;...
JRST WILDS2 ;Do the next one
;** Here for a wildcard node name
WILDS: SETZM WMATCH## ;Clear the match flag
AND T2,.FXNMM(T3) ;Mask the name
MOVN T4,NODNUM## ;Set up the max number of nodes
HRL T4,T4 ;Put it in LH of T4
HRRI T4,NODNAM## ;and point to their names
WILDS1: MOVE T1,(T4) ;Get a node
AND T1,.FXNMM(T3) ;Mask it's name
CAME T1,T2 ;A match?
AOBJN T4,WILDS1 ;No, loop
CAMN T1,T2 ;Really a match or the end of list
PUSHJ P,INSERT ;Yes, a match, enter in table
AOBJN T4,WILDS1 ;No, EOT, loop through all nodes
MOVE T1,WMATCH## ;Get the flag word
JUMPE T1,NOWILD ;If we didn't get a match
WILDS2: ADDI T3,BLKSIZ##-1 ;Add size of the block to the pointer
AOBJN T3,DISEC1 ;Loop until all the blocks are checked
;** Here to generate a list of nodes to look at
GLIST: MOVN T1,NODNUM## ;Get the negative number of nodes
HRL T1,T1 ;and make it an AOBJN pointer
HRRI T1,NODBIN## ;Into the table
MOVEI T2,NODLST## ;Point to the list we are making
SETZB T2,NODCNT## ;and clear the count
GLIST1: SKIPL (T1) ;Is this entry flagged?
JRST GLIST2 ;No, skip the insertion
HRRZ T3,(T1) ;Yes, get it
AOS T2 ;Add one to the count
AOS NODCNT## ;Add one to the number to process
MOVEM T3,NODCNT##(T2) ;and put it into the new table
GLIST2: AOBJN T1,GLIST1 ;Loop till done
SKIPE NODCNT## ;Did we flag any?
JRST CCLST ;Yes, do the CCL start
JRST LOOP1 ;No, nothing to print, try again
;** Here to see of null name is the only one
; specified
DEFCAS: MOVE T2,NUMBLK## ;Get the number of blocks
CAIG T2,1 ;More than 1 Scan block?
JRST [POP P,(P) ;[19] Reset the stack
JRST RUNST1] ;[19] For the default list
SETZ T2, ;Make sure T2 gets zeroed again
POPJ P, ;Yes, return
;** Here to flag a node to be listed
; Here from wilds when we have a match
INSERT: SETOM WMATCH## ;Flag the match
PUSHJ P,.PSH4T## ;Save the temps
HRRZ T4,T4 ;Clear the LH of T4
SUBI T4,NODNAM## ;Get the index into the table
ADDI T4,NODBIN## ;and make a pointer to the new list
MOVEI T3,777777 ;Get the flag
HRLM T3,(T4) ;and place it in the list
PUSHJ P,.POP4T## ;Restore the temps
POPJ P, ;Return
SUBTTL Error message handling routines
;** Here when we run out of Scan block storage.
; tell the user once and continue, ignoring any more specs
ALOCER: SKIPE SBMCNT## ;Sure to only tell him once!
JRST ALOCE1 ;Don't count errors unless we print them
MOVE T1,NFECNT## ;How many non-fatal errors did we have?
CAILE T1,MAXNFE## ;Did we have too many?
JRST NFEERR ;Yes, tell the user and die
AOS NFECNT## ;No, count the error
ALOCE1: POP P,T1 ;Restore T1
PUSHJ P,.PSH4T## ;Save the temps
MOVE T1,['NWKSBE'] ;Yes, tell the user
MOVE T2,["%",,[ASCIZ/Scan Blocks used up. Node spec ignored/]]
SETZB T3,T4 ;Clear for Scan
SKIPN SBMCNT## ;Sure to only tell him once!
PUSHJ P,.ERMSG## ;Yes, print the error
PUSHJ P,.POP4T## ;Restore the temps
MOVEI T2,1 ;Clear size and destination
MOVEI T1,TEMP## ;Fake it in the temp space
AOS SBMCNT## ;Keep track of how many times here
POPJ P, ;Return
;** Debug routine to help figure out what has gone wrong
;Here on a TRMNO. error
TRMOER: PUSHJ P,.PSH4T## ;Save the temps
MOVE T1,['NWKTUE'] ;The prefix
MOVE T2,["?",,[ASCIZ/TRMNO. UUO error at PC/]]
PUSHJ P,.ERMSG## ;[18] Print the error message
HRRZ T3,-4(P) ;[18] Get the PC
SUBI T3,2 ;[18] Backup to the UUO
PUSHJ P,.TOCTW## ;[18] Type the address of the error
PUSHJ P,.POP4T## ;Restore temps in case of dump
JRST FINISH ;[10] and die
;** Debug routine to help figure out what has gone wrong
;Here on a GETTAB error
GTABER: PUSHJ P,.PSH4T## ;Save the temps
MOVE T1,['NWKGUE'] ;The prefix
MOVE T2,["?",,[ASCIZ/GETTAB UUO error at PC/]]
PUSHJ P,.ERMSG## ;[18] Print the error message
HRRZ T3,-4(P) ;[18] Get the PC
SUBI T3,2 ;[18] Backup to the UUO
PUSHJ P,.TOCTW## ;[18] Type the address of the error
PUSHJ P,.POP4T## ;Restore the temps in case of dump
JRST FINISH ;[10] and die
;** Debug routine to help figure out what has gone wrong
;Here on a NODE. UUO error
NODERR: PUSHJ P,.PSH4T## ;Save the temps
MOVE T4,[34,,11] ;Is the monitor 7.00 or later?
GETTAB T4, ;...
PUSHJ P,GTABER ;[18] GETTAB error? tell user and die
LSH T4,-6 ;Right justify monitor version
ANDI T4,777 ;and mask out other stuff
CAIGE T4,700 ;7.00 or later?
JRST OLDMON ;No, tell user and die
MOVE T1,['NWKNUE'] ;Yes, the prefix
MOVE T2,["?",,[ASCIZ/NODE UUO error at PC/]]
PUSHJ P,.ERMSG## ;[18] Print the error message
HRRZ T3,-4(P) ;[18] Get the PC
SUBI T3,2 ;[18] Backup to the UUO
PUSHJ P,.TOCTW## ;[18] Type the address of the error
PUSHJ P,.POP4T## ;Restore the temps in case of dump
JRST FINISH ;[10] and die
OLDMON: MOVE T1,['NWKMTO'] ;The prefix
MOVE T2,["?",,[ASCIZ/Monitor too old. Must be 7.00 or later/]]
PUSHJ P,.ERMSG## ;Print the error message
PUSHJ P,.POP4T## ;Restore in case of dump
JRST FINISH ;[10] and die
;** Here when no node can meet the constraints set by the device
; switches set by the user
; Only prints if no other message has been typed
; uses T1-T4
NOMAT: MOVE T1,NFECNT## ;How many non-fatal errors did we have?
CAILE T1,MAXNFE## ;Did we have too many?
JRST NFEERR ;Yes, tell the user and die
AOS NFECNT## ;No, count the error
MOVE T1,['NWKNNM'] ;The prefix
MOVE T2,["%",,[ASCIZ/No Nodes meet constraints/]]
SETZB T3,T4 ;Zero these for Scan
PUSHJ P,.ERMSG## ;Print the error message
POPJ P, ;Return
;** Here when we lose in a wildcard search
NOWILD: MOVE T2,.FXNAM(T3) ;Put node-spec as user typed it in T2
;and fall into 'no node in network
;routine
;** Here when we have to tell the user about a no-match situation.
; Can come here from wild failure (above) or non-wild failure (DISECT)
NONOD: SKIPN ERRWD## ;Do we want to print no-node errors?
JRST WILDS2 ;No, just return
AOS MATCH## ;Increment the match count because
;we printed an error
PUSHJ P,.PSH4T## ;Save the temps
PUSH P,T2 ;Save T2 again for later
MOVE T1,['NWKNNN'] ;Get the prefix characters
PUSH P,[NONOD1] ;Put print routine address on the stack
PUSHJ P,ERMSP ;Go to our error message processor
POP P,T1 ;If here, pop the extra address
;off the stack
PUSHJ P,.POP4T## ;Restore the temps
JRST WILDS2 ;and fake a loop to WILDS
NONOD1: MOVE T1,[POINT 7,[ASCIZ/NODE /]] ;If here, print the
PUSHJ P,.TSTRG## ;rest of the message
POP P,T1 ;Put the node name into T1 for Scan
PUSHJ P,.TSIXN## ;and print it
MOVE T1,[POINT 7,[ASCIZ/ not in Network/]]
PUSHJ P,.TSTRG## ;and the rest of the message
PUSHJ P,.POP4T## ;Then restore the temps
JRST WILDS2 ;and fake a loop back to wilds
;** Here to handle too many non-fatal errors
; this is determined by MAXNFE in NDATA
NFEERR: MOVE T1,['NWKTME'] ;Too many non-fatal errors
MOVE T2,["?",,[ASCIZ/Too many errors/]]
SETZB T3,T4 ;Clear for Scan
PUSHJ P,.ERMSG## ;Tell the user the bad news
JRST FINISH ;[10] and then just die
;** Here to print standard error message prefixes
; Modified version of Scan's .ERMSG routine to allow us to put
; extra things in the line like a node spec or illegal parts of a
; node spec...
;
; T1 = The message prefix
; -1(P) = The address of the extra print routine
; uses T2-4
ERMSP:: PUSH P,T1 ;Save the prefix
MOVE T1,NFECNT## ;How many non-fatal errors did we have?
CAILE T1,MAXNFE## ;Did we have too many?
JRST NFEERR ;Yes, tell the user and die
AOS NFECNT## ;No, count the error
MOVEI T1,"%" ;Get the lead character (never called if fatal)
PUSHJ P,.TNEWL## ;make a new line
PUSHJ P,.TCHAR## ;Issue the lead character
PUSHJ P,.VERBO## ;Get /MESSAGE setting
MOVE T4,T1 ;and copy it to a safer place
POP P,T1 ;Get the prefix back
TXNE T4,JWW.PR ;See if /VERBOS:PREFIX
PUSHJ P,.TSIXN## ;Yes, issue the prefix
PUSHJ P,.TSPAC## ;Space to the text area
TXNE T4,JWW.FL ;See if /MESSAGE:FIRST
POP P,T1 ;Yes, use the supplied print address
POPJ P, ;and return to there
;** Here to tell the user he has entered a bad node spec.
; This happens when we get a PPN, device, or extension in a node spec
; We will tell him and then prompt him with a * as we change into
; run mode by poking our OFFSET word
SPECER: PUSHJ P,.PSH4T## ;Save the temps
MOVEI T1,1 ;Fake a run start so we will
MOVEM T1,OFFSET## ;prompt the user, a second chance
MOVE T1,['NWKBNS'] ;The prefix
PUSH P,[SPECE1] ;Set up the print routine address
PUSHJ P,ERMSP ;Process the message
POP P,T1 ;If here, restore the stack
JRST SPECE2 ;and exit
SPECE1: MOVEI T1,[ASCIZ/Bad NODE spec /]
PUSHJ P,.TSTRG## ;Type the generic message
MOVE T4,.FXMOD(T3) ;Get the Scan block modifier word
MOVE T1,.FXDEV(T3) ;Get the device name
TDNN T4,[FX.NDV] ;Do we have a device?
PUSHJ P,.TSIXN## ;Yes, type the device name
MOVEI T1,":" ;Get a ":"
TDNN T4,[FX.NDV] ;and print it if
PUSHJ P,.TCHAR## ;we printed a device
MOVE T1,.FXNAM(T3) ;Get the name
PUSHJ P,.TSIXN## ;and print it always
MOVEI T1,"." ;Get a period
TDNN T4,[FX.NUL] ;Null extension?
PUSHJ P,.TCHAR## ;No, type the period
HLLZ T1,.FXEXT(T3) ;Get the extension
TDNN T4,[FX.NUL] ;Is it null?
PUSHJ P,.TSIXN## ;No, type it
TDNN T4,[FX.DIR] ;Was a directory typed?
JRST SPECE2 ;No, skip this stuff
MOVE T1,.FXDIR(T3) ;Yes, get the PPN
PUSHJ P,.TPPNW## ;and type it
SPECE2: PUSHJ P,.POP4T## ;Restore the temps
JRST WILDS2 ;and fake a return to WILDS
;** Here when a node has gone offline when we are processing it
OFLINE: SKIPN ERRWD## ;Print "No Node" errors
AOBJN L1,LOOP ;No, fake loop
AOS MATCH## ;[18] So we don't get the
;[18] "No nodes meet constraints"
PUSHJ P,.PSH4T## ;[8] Save the temps
MOVE T1,['NWKNWD'] ;No, The prefix
PUSH P,[OFLIN2] ;Print routine address
PUSHJ P,ERMSP ;Error message routine
POP P,T1 ;Restore the stack
JRST OFLIN3 ;and exit to the main loop
OFLIN2: MOVEI T1,[ASCIZ/Node /] ;[18] text
PUSHJ P,.TSTRG## ;[18] Type the string
MOVE T1,-<MAXNOD##+1>(L1) ;[18] Get the sixbit name
PUSHJ P,.TSIXN## ;[18] Type it
MOVEI T1,[ASCIZ/ (/] ;[18]
PUSHJ P,.TSTRG## ;[18] Type it
MOVE T1,CN ;Get the node number
PUSHJ P,.TOCTW## ;Type it
MOVEI T1,")" ;Get a <right paren>
PUSHJ P,.TCHAR## ;Type it
MOVEI T1,[ASCIZ/ is going on or offline/] ;[9] Strange state msg
PUSHJ P,.TSTRG## ;Type the rest of the message
OFLIN3: PUSHJ P,.POP4T## ;Restore the temps
AOBJN L1,LOOP ;fake the end of the main loop
JRST LOOP0 ;And restart if end of loop
SUBTTL Control/C and other interupt handling!
;[19] Here on a ^C or other interrupt
CONC:: PUSHJ P,.PSH4T## ;Save the temps
HLRZ T1,INTYPE## ;Get the interupt type
CAIE T1,ER.ICC ;Was it a ^C interupt?
JRST CONC1 ;No, check the next type
PUSHJ P,.ISLGI## ;[7] Are we logged in?
JRST FINISH ;[10] No, Do the right thing and exit!
PUSHJ P,.POP4T## ;Yes, restore the temps and make it
EXIT 1, ;look like a plain ^C
;** Here if the user types a CONTINUE command
PUSH P,LASTPC## ;Put the return address on the stack
SETZM LASTPC## ;and clear it in the interupt block
POPJ P, ;Finally, return to what we were doing
CONC1: CAIE T1,ER.FUL ;is the disk full
JRST CONC2 ;No, check the next possibility
PUSHJ P,.PSH4T## ;Save the temps
MOVE T1,['NWKNMR']
MOVE T2,["?",,[ASCIZ/No more room on file structure/]]
SETZB T3,T4 ;Clear T3 and T4
PUSHJ P,.ERMSG## ;Print the Message
PUSHJ P,.POP4T## ;Restore the temps
JRST FINISH ;[10] Exit...(Die)
CONC2: CAIE T1,ER.QEX ;Did he exceed his disk quota?
JRST CONC3 ;No, check the next possibility
MOVE T1,['NWKDQE']
MOVE T2,["?",,[ASCIZ/Disk Quota exceeded/]]
SETZB T3,T4 ;clear T3 and T4
PUSHJ P,.ERMSG## ;Print the message
PUSHJ P,.POP4T## ;Restore the temps
JRST FINISH ;[10] Exit...(die)
CONC3: CAIE T1,ER.TLX ;Did he exceed his time limit?
JRST CONC4 ;No, check the last possibility
MOVE T1,['NWKTLE']
MOVE T2,["?",,[ASCIZ/Time Limit exceeded/]]
SETZB T3,T4 ;Clear T3 and T4
PUSHJ P,.ERMSG## ;Print the message
PUSHJ P,.POP4T## ;Restore the temps
EXIT 1, ;Do a continuable exit
;** Here if the user types a CONTINUE command
PUSH P,LASTPC## ;Put the return address on the stack
SETZM LASTPC## ;and clear it in the interupt block
POPJ P, ;Finally, return to what we were doing
CONC4: CAIE T1,ER.EIJ ;Did he encounter a fatal error
;of the fourth kind?
JRST CONC5 ;No, let the user have it
MOVE T1,['NWKFER']
MOVE T2,["?",,[ASCIZ/Fatal Error at PC/]]
SETZB T3,T4 ;Clear T3 and T4
PUSHJ P,.ERMSG## ;Print the message
HRRZ T1,LASTPC## ;[18] Get the last PC
SUBI T1,1 ;[18] Backup to the error PC
PUSHJ P,.TOCTW## ;[18] and type the PC
PUSHJ P,.POP4T## ;restore the temps
JRST FINISH ;[10] Exit to the monitor
CONC5: POP P,T1 ;Restore T1
PUSH P,LASTPC## ;Put the last PC on the stack
SETZM LASTPC## ;Clear it in the interupt block
POPJ P, ;Return to the user program
XLIST ;[19] For a neater listing
LIT ;Force literals to be in high segment
LIST ;[19]
PRGEND START
TITLE NDATA Data structures for the NETWORK program
SUBTTL Constant definitions
SEARCH SCNMAC,UUOSYM
TWOSEG ;Make sharable twoseg
MAXNOD=:200 ;The max number of nodes we can handle
BLKSIZ=:10 ;Number of words allocated to each Scan block
PREALO=:MAXNOD/10 ;How many nnode specs to preallocate for
MAXNFE=:MAXNOD/2 ;Maximum # of non-fatal errors we will allow
MAXCOR=:10000 ;The maximum amount of core we allow (in words)
MO.CHR=:400000 ;[10] Character mode bit
DEFWID=:^D72 ;[14] Define our default width
PSIZ=:40 ;Number of words in the stack
.NDNDB=:13 ;NDB access function of the NODE. UUO
.NDNLS=:12 ;List nodes in network function of NODE. UUO
SUBTTL Stack and interupt block
RELOC 0 ;Set to low segment for data and stack
PDL:: BLOCK PSIZ ;Stack
;** Interupt block
INTBLK::BLOCK 1 ;[15]4 words long,,interupt handler
BLOCK 1 ;[15]No message control,, 2 ^C
LASTPC::BLOCK 1 ;[15] User PC stored here when interrupted
INTYPE::BLOCK 1 ;[15] Interupt type in LH
SUBTTL UUO argument blocks
STDAT:: ;Start of core to be zeroed on initalization
;** Argument block for the NODE. UUO's .NDNDB function
NDLEN:: BLOCK 1 ;.NDNLS NODE. UUO function
CURNOD::BLOCK 1 ;Current node number
FLDNUM::BLOCK 1 ;Field number we want
DATBLK::BLOCK 100 ;Data area
;** Argument block for the TRMOP. UUO's .TOWID function
TTWID:: BLOCK 1 ;Function code to get TTY width
UDX:: BLOCK 1 ;Our TTY's UDX
CARWID::BLOCK 1 ;The TTY's width
;** argument block for the NODE. UUO's .NDNLS function
; This generates a list of all the nodes in the network by number
NODNUM::BLOCK 1 ;Header for UUO
NODBIN::BLOCK MAXNOD ;The list of the node numbers
SUBTTL Tables to allow wildcarding node names
;** List of nodes in network by their name in sixbit
NODNAM::BLOCK MAXNOD
;** List of numbers of nodes selected to be displayed
NODCNT:: BLOCK 1 ;Number of nodes to process
NODLST:: BLOCK MAXNOD ;List of nodes to process
;** Our model of an NDB. We copy the nodes NDB here so we can get it easier
NNM:: BLOCK 1 ;Node number
SNM:: BLOCK 1 ;Node name in sixbit
SID:: BLOCK 10 ;Software ID (asciz)
DAT:: BLOCK 10 ;Software date (asciz)
LMA:: BLOCK 1 ;Last NCL message assigned
LMS:: BLOCK 1 ;Last NCL ACK message sent
LAR:: BLOCK 1 ;Last NCL ACK recieved
LAP:: BLOCK 1 ;Last NCL ACK processed
LMR:: BLOCK 1 ;Last NCL message recieved
LMP:: BLOCK 1 ;Last NCL message processed
LAS:: BLOCK 1 ;Last NCL ACK sent
MOM:: BLOCK 1 ;Maximum outstanding message counter
TOP:: BLOCK 20 ;Network topology table in the form
;XWD Level , Node
CNF:: BLOCK 20 ;Configuration table in the form
;XWD Object , Number
ENDB:: BLOCK 1 ;End of our NDB
SUBTTL Scan related switces
;** Scan switch storage
FIRSW:: ;Start of switch area
WIDWD:: BLOCK 1 ;/WIDTH:nn switch.
FASWD:: BLOCK 1 ;Short listing switch
SILWD:: BLOCK 1 ;/SILENCE switch
BRIEWD::BLOCK 1 ;/BRIEF switch
TOPWD:: BLOCK 1 ;/TOPOLOGY switch
ERRWD:: BLOCK 1 ;/ERROR switch
COSTWD::BLOCK 1 ;/COST switch
SORTWD::BLOCK 1 ;/SORT switch
;** The following 12 locations must be contigous and in the same order
MCRWD:: BLOCK 1 ;Switch for nodes with "MCR"
TTYWD:: BLOCK 1 ;Switch for nodes with "TTY"
CDRWD:: BLOCK 1 ;Switch for nodes with "CDR"
LPTWD:: BLOCK 1 ;Switch for nodes with "LPT"
PTRWD:: BLOCK 1 ;Switch for nodes with "PTR"
PTPWD:: BLOCK 1 ;Switch for nodes with "PTP"
PLTWD:: BLOCK 1 ;Switch for nodes with "PLT"
MTAWD:: BLOCK 1 ;Switch for nodes with "MTA"
DTAWD:: BLOCK 1 ;Switch for nodes with "DTA"
TSKWD:: BLOCK 1 ;Switch for nodes with "TSK"
RDAWD:: BLOCK 1 ;Switch for nodes with "RDA"
CDPWD:: BLOCK 1 ;Switch for ndoes with "CDP"
TYPWD:: BLOCK 1 ;Value for the /TYPE switch
NDEV=:.-MCRWD ;Length of table of device switches
LASTSW=:. ;Last switch location
;** Other random variables used in odd places
MATCH:: BLOCK 1 ;Count of matches or match errors
FIRSTL::BLOCK 1 ;Count of times through the SHOLST code
SBMCNT::BLOCK 1 ;Count of Scan block error message
OFFSET::BLOCK 1 ;The starting offset
WMATCH::BLOCK 1 ;Flag for status of a wildcard search
HPOS:: BLOCK 1 ;The current horizontallocation of the carriage
NFECNT::BLOCK 1 ;Number of non-fatal errors
OUTCON::BLOCK 1 ;[10] Output control word
TEMP:: BLOCK BLKSIZ+1 ;Our scratch area
;[10] ** TTY buffer space
NCHAR:: BLOCK 1 ;[10] Number of characters in the buffer
BUFFP:: BLOCK 1 ;[10] Pointer into the buffer
BUFFER::BLOCK 20 ;[10] TTY buffer
BUFSIZ=:<<.-BUFFER> * 5 > - 2 ;[10] Number of characters in the buffer
SUBTTL Scan block storage area
;** Counters to keep track of the Scan block allocation
OUTFIL::BLOCK 1 ;Number of output specs
INFIL:: BLOCK 1 ;Number of input specs
NUMBLK::BLOCK 1 ;Number of scan blocks allocated so far
;** Default area to store Scan blocks.
; Must be at the end of core incase we want to expand
SBLKS:: BLOCK PREALO*BLKSIZ ;Make large enough to hold 1 Scan block
ENDAT:: BLOCK 1 ;End of our low seg to be zeroed
SUBTTL Pointers and constants
RELOC 400000 ;Relocate to the high segment
;Copy of the interupt control block to be BLTed on initalization
INT:: XWD 4,CONC## ;[15]4 words long,,interupt handler
XWD 0,2 ;[15]No message control,, 2 ^C
BLOCK 1 ;[15] User PC stored here when interrupted
BLOCK 1 ;[15] Interupt type in LH
IBLKLN=:.-INT ;[15]length of interupt block
;** Pointers to asciz strings used by the PCONF routine to
; print the device names in the configuration of a node. They must
; be in this order since they are indexed by their NCL device types.
CTAB:: POINT 7,[ASCIZ/MCR[/]
POINT 7,[ASCIZ/TTY[/]
POINT 7,[ASCIZ/CDR[/]
POINT 7,[ASCIZ/LPT[/]
POINT 7,[ASCIZ/PTR[/]
POINT 7,[ASCIZ/PTP[/]
POINT 7,[ASCIZ/PLT[/]
POINT 7,[ASCIZ/MTA[/]
POINT 7,[ASCIZ/DTA[/]
POINT 7,[ASCIZ/TSK[/]
POINT 7,[ASCIZ/RDA[/]
POINT 7,[ASCIZ/CDP[/]
SUBTTL Scan macro calls and definitions
;** Switch definitions
DEFINE SWTCHS<
SN BRIEF,BRIEWD,FS.NFS ;Control listing of devices
SN CDP,CDPWD,FS.NFS ;Only nodes with CDP's
SN CDR,CDRWD,FS.NFS ;Only nodes with CDR's
SN COST,COSTWD,FS.NFS ;List the link cost with /TOPOLOGY
SN DTA,DTAWD,FS.NFS ;Only nodes with DTA's
SN ERROR,ERRWD,FS.NFS ;Control listing of errors
SN FAST,FASWD,FS.NFS ;For super short list of nodes
SN HOSTES,MCRWD,FS.NFS ;Same as "MCR"
SN LPT,LPTWD,FS.NFS ;Only nodes with LPT's
SN MCR,MCRWD,FS.NFS ;Only nodes with MCR's (can be a host)
SN MTA,MTAWD,FS.NFS ;Only nodes with MTA's
SN PLT,PLTWD,FS.NFS ;Only nodes with PLT's
SN PTP,PTPWD,FS.NFS ;Only nodes with PTP's
SN PTR,PTRWD,FS.NFS ;Only nodes with PTR's
SN RDA,RDAWD,FS.NFS ;Only nodes with RDA's
SN SILENC,SILWD,FS.NFS ;Control non-error output
SN SORT,SORTWD,FS.NFS ;To sort the node names
SN TOPOLO,TOPWD,FS.NFS ;For the TOPOLOGY listing
SN TSK,TSKWD,FS.NFS ;Only nodes with TSK's
SN TTY,TTYWD,FS.NFS ;Only nodes with TTY's
SP TYPE,TYPWD,.SIXSW##,-1,FS.LRG!FS.NFS!FS.VRQ ;[1] Node type
SP WIDTH,WIDWD,.DECNW##,-1,FS.NFS!FS.LRG ;Output width
> ;END OF THE SWTCHS MACRO
DOSCAN (TOGLS) ;The DOSCAN macro generates the tables
;defined by the SWTCHS macro
SUBTTL Scan argument blocks
;[4] ** .ISCAN initalization block if logged out
ISBLO:: IOWD 1,ISCANI ;[4] Acceptable CCL commands table
XWD OFFSET,'NWK' ;[4] Starting offset,,Tmp core name
XWD 0,0 ;[4] Default I/O
XWD 0,0 ;[4] Indirect file name (unknown)
XWD 0,0 ;[4] Monitor return,, prompt routine
EXP FS.IFI ;[4] Indirect files illegal if logged out
;** .ISCAN initalization block if logged in
ISBLK:: IOWD 1,ISCANI ;Acceptable CCL commands table
XWD OFFSET,'NWK' ;Starting offset,,Tmp core name
XWD 0,0 ;Default I/O
XWD 0,0 ;Indirect file name (unknown)
XWD 0,0 ;Monitor return,, prompt routine
EXP 0 ;Reserved by Scan for the future
ISLEN=:.-ISBLK ;.ISCAN block length
;** Table of CCL names for Scan
ISCANI::SIXBIT/NETWOR/ ;Default CCL name
;** .OSCAN argument block
; The options file scanner (SWITCH.INI[,])
OSBLK:: IOWD TOGLSL,TOGLSN ;SWTCHS' table length,,name table
XWD TOGLSD,TOGLSM ;Table of defaults,,processor address
XWD 0,TOGLSP ;Pointers for storing values
EXP -1 ;Help word, -1 for "HLP:NETWOR.HLP"
SIXBIT /NETWOR/ ;Options word...our name
OSLEN=:.-OSBLK ;Length of .OSCAN block
TSBLK:: IOWD TOGLSL,TOGLSN ;SWTCHS' table length,,name table
XWD TOGLSD,TOGLSM ;Table of defaults,,processor address
XWD 0,TOGLSP ;Pointers for storing values
EXP -1 ;Use our name for help
XWD 0,0 ;Default to clear answers and file specs
XWD IALLO##,OALLO## ;Scan block allocation routines
XWD 0,0 ;Default for sticky defaults
XWD 0,1B18!1B19 ;Scan control flags
;1B18=More than 1 input spec OK
;1B19=Global switches can be anywhere
XWD 0,0 ;Let Scan store the values
TSLEN=:.-TSBLK ;.TSCAN block length
END