.Title NetPath - Display the path to a node .Ident /V01.006/ .Enable SUP .Default Displacement,Word .Subtitle Introduction ;+ ; ; ----- NetPath: Display the path to a node ; ; ; Facility: ; ; VAX/VMS network management. ; ; Abstract: ; ; This program will display the path to a particular DECnet node. ; ; Environment: ; ; VAX/VMS native mode, VMS V4.2 or later, NICE V4.0.0, TMPMBX and ; NETMBX privileges. ; ; ; ; Version: V01.006 ; Date: 23-Aug-1990 ; ; Copyright © 1988, 1989, 1990 San Diego Supercomputer Center ; ; Gerard K. Newman 3-Feb-1988 ; San Diego Supercomputer Center ; General Atomics ; P.O. Box 85608 ; San Diego, CA 92186-9784 ; 619.534.5076 ; ; Internet: GKN@SDS.SDSC.EDU ; BITNET: GKN@SDSC.BITNET ; SPAN: SDSC::GKN (27.1) ; ; ; Modifications: ; ; 21-Feb-1988 GKN Correct problem with TRACE_PATH assuming that ; NMA$C_PCNO_NND always has the node name specified. ; 22-Feb-1988 GKN Rid the output of the "::"s everywhere. ; 25-Feb-1988 GKN Fix FIND_NICE to return failure if the parameter ; it was told to search for isn't present in a single ; response message (it worked Ok for multiple responses). ; 1-Oct-1988 GKN If a response comes back with area number 0 in an ; address then stuff a 1. DECSA routers do this if ; they're talking to an area router in area 1 (sigh). ; 17-Aug-1990 GKN Change the parser logic to allow the tracing of a ; path from an arbitrary node to another arbitrary ; node (i.e., not just from "here to there", but from ; "there to somewhere else"). Display the estimated ; round-trip time (delay) along the path. ; 23-Aug-1990 GKN Cache channels to various NMLs along the path, to ; help improve trace times after the first time thru. ; ;- .Page .Subtitle Local definitions .Library "SYS$LIBRARY:LIB.MLB" ;Get special macros from here .NoCross ;Save a tree $IODEF ;I/O function codes $JPIDEF ;$GETJPI stuff $LNMDEF ;Define logical name stuff $NFBDEF ;Define network function block stuff $NMADEF ;Define NICE constants $SSDEF ;System service codes $STSDEF ;Define severity codes, etc. $TPADEF ;TPARSE definitions .Cross ;Turn CREF back on ; Local definitions CACHE_SIZE = 16 ;Logical link cache size ; Logical link cache block format $DEFINI LLC ;Logical link cache block format $DEF LLC$W_ADDR .Blkw ;Node address $DEF LLC$W_CHAN .Blkw ;Channel to same $DEF LLC$B_USE .Blkb ;Use count $DEF LLC$B_XXXX .Blkb 3 ;Pad to a nice quadword boundary $DEF LLC$K_LENGTH ;Length of this structure $DEFEND LLC ;End of the logical link cache block .Page .Subtitle TPARSE state table $INIT_STATE NETP_STATES,NETP_KEYS ;Initialize the state table $STATE ST_NODE ;Initial state $TRAN TPA$_EOS,TPA$_EXIT,TRACE_PATH ;Go trace the path at EOS. $TRAN TPA$_LAMBDA,TPA$_FAIL,TWO_NODES ;Ensure only 2 passes thru this! $TRAN TPA$_DECIMAL,ST_ADDR ;By address $TRAN TPA$_SYMBOL,ST_NAME,LOOK_NAME ;By name $STATE ST_ADDR ;By address. $TRAN '.',,FIX_AREA ;We have an area.node address $TRAN TPA$_LAMBDA,ST_NODE,LOOK_ADDR ;Someone did the conversion already $STATE ;Parse the other half of the address $TRAN TPA$_DECIMAL,ST_NODE,LOOK_ADDR ;Get the other half of a area.node address form $STATE ST_NAME ;Here to look up by name $TRAN '::',ST_NODE ;Swallow the ::s if there $TRAN TPA$_LAMBDA,ST_NODE ;Else loop $END_STATE ;Done .Page .Subtitle Impure storage .Psect IMPURE_DATA NOEXE,RD,WRT,PIC,NOSHR,PAGE ; Random data. TPARSE_BLOCK: .Long TPA$K_COUNT0 ;TPARSE block (argument count) .Blkb TPA$K_LENGTH0-4 ;Allocate the rest of the block OUT_DESC: .Long 128 ;Output buffer .Address OUT_BUFF ; descriptor LOCAL_NODE: .Long 0 ;Local node .Address LOCAL_BUFF ; name descriptor SRC_NODE: .Long 0 ;Source node .Address SRC_BUFF ; name descriptor TARGET_NODE: .Long 0 ;Target node .Address TARGET_BUFF ; name descriptor NEXT_NAME: .Long 0 ;Next node name .Address NEXT_BUFF ; descriptor LAST_NAME: .Long 0 ;Last node name .Address LAST_BUFF ; descriptor ADDR_PTR: .Blkl ;Pointer for LOOK_* to stash the address NODE_PTR: .Blkl ;Pointer for LOOK_* to stash the name CTRL_MASK: .Blkl ;Old DCL ^T/^Y mask FAO_ARGS: .Blkl 10 ;FAO argument list NODES: .Blkl ;Number of nodes on our command line AREA: .Blkl ;Area number COST: .Blkl ;Current circuit cost HOPS: .Blkl ;Current circuit hops TOTAL_COST: .Blkl ;Total cost AVE_RTT: .Blkl ;Average round-trip time SAMPLES: .Blkl ;Total round-trip time samples START_TIME: .Blkq ;Starting time END_TIME: .Blkq ;Ending time NEXT_NODE: .Blkl ;Next node in the chain LAST_NODE: .Blkl ;Last node in the chain LOCAL_ADDR: .Blkl ;Our local node address NML_LENGTH: .Blkl ;Length of the NML response NML_OFFSET: .Blkl ;Offset to the "real" responses in the NML response NML_MULTIPLE: .Blkl ;Multiple responses expected TT_CHAN: .Blkw ;Terminal channel number DELAY_CHAN: .Blkw ;Channel for calculating delay to the target node ; Stuff for dealing with DECnet. NET_IOSB: .Blkq ;Network I/O status block NETACP_CHAN: .Blkl ;Channel number to NETACP (+ padding) NCB: .Long 0 ;NCB .Address NCB_BUFF ; descriptor NFB: .Long NFB$K_LENGTH+8 ;A descriptor .Long 0 ; of one of our NFBs KEY: .Long 0 ;A descriptor of .Address NETACP_KEY ; our search key NETACP_DESC: .Long 128 ;A descriptor of .Address NETACP_BUFF ; our NETACP return buffer NETACP_KEY: .Blkl ;Space for NETACP to write a count into SEARCH_KEY: .Blkq 2 ;Space for a search key ; NFBs to get NETACP to translate node addresses to names and node names ; to addresses. ADDR_TO_NAME: .Byte NFB$C_FC_SHOW ;NFB$B_FCT Function = show .Byte 1@NFB$V_NOCTX ;NFB$B_FLAGS Flags = don't store context .Byte NFB$C_DB_NDI ;NFB$B_DATABASE Database = remote node info .Byte NFB$C_OP_EQL ;NFB$B_OPER Operation = match if equal .Long NFB$C_NDI_TAD ;NFB$L_SRCH_KEY Search key = transformed node address .Long 0 ;NFB$L_SRCH2_KEY [no second key] .Byte 0 ;NFB$L_OPER2 [no second key] .Byte 0 ;NFB$B_MBZ1 Must be zero .Word 0 ;NFB$W_CELL_SIZE Cell size = default .Long NFB$C_NDI_NNA ;NFB$L_FLDID Field 1: node name .Long NFB$C_ENDOFLIST ; ... That's all NAME_TO_ADDR: .Byte NFB$C_FC_SHOW ;NFB$B_FCT Function = show .Byte 1@NFB$V_NOCTX ;NFB$B_FLAGS Flags = don't store context .Byte NFB$C_DB_NDI ;NFB$B_DATABASE Database = remote node info .Byte NFB$C_OP_EQL ;NFB$B_OPER Operation = match if equal .Long NFB$C_NDI_NNA ;NFB$L_SRCH_KEY Search key = node name .Long 0 ;NFB$L_SRCH2_KEY [no second key] .Byte 0 ;NFB$B_OPER2 [no second key] .Byte 0 ;NFB$B_MBZ1 Must be zero .Word 0 ;NFB$W_CELL_SIZE Cell size = default .Long NFB$C_NDI_TAD ;NFB$L_FLDID Field 1: node address .Long NFB$C_ENDOFLIST ; ... That's all ; NICE messages. These must be in writable memory because we update the ; node and circuit specifications. ; Show node summary. NICE_SHOW_NODE: .Byte 5 ;Message length .Byte NMA$C_FNC_REA ;Function code = Read information .Byte !NMA$C_ENT_NOD ;Show Node Summary .Byte 0 ;Node format = Address TARGET_ADDR: .Blkw ;Target node address ; Show circuit status. NICE_SHOW_CIRC: .Byte 0 ;Message length .Byte NMA$C_FNC_REA ;Function code = Read information .Byte !NMA$C_ENT_CIR ;Show Circuit Status CIRCUIT: .Blkb 32 ;Space for the circuit name .Align Page ;Page align this mess for DZRO compression ; Logical link cache blocks. LLCS: .Blkb CACHE_SIZE*LLC$K_LENGTH ;Allocate the logical link cache ; Random buffers. NICE_BUFF: .Blkb 512 ;NICE message buffer NCB_BUFF: .Blkb 128 ;Space for an NCB to be built IN_BUFF: .Blkb 128 ;Input buffer OUT_BUFF: .Blkb 128 ;Output buffer NETACP_BUFF: .Blkb 128 ;NETACP output buffer LOCAL_BUFF: .Blkb 16 ;Space for our local node name SRC_BUFF: .Blkb 16 ;Space for our source node name TARGET_BUFF: .Blkb 16 ;Space for our target node name NEXT_BUFF: .Blkb 16 ;Space for the next node name LAST_BUFF: .Blkb 16 ;Space for the last node name .Page .Subtitle Pure storage .Psect PURE_DATA NOEXE,RD,NOWRT,PIC,SHR,PAGE ; Random pure data. LNM_ITEMS: .Word 16,LNM$_STRING ;Get the equivalence string .Address LOCAL_BUFF ;Put it here .Address LOCAL_NODE ;Return the length here .Long 0 ;That's all BAND_MASK: .Long 0 ;Short-form .Long 1@<<^a/T/>-<^a/@/>> ;Terminator mask PTR_TABLE: .Long 0,0 ;Illegal. .Address NEXT_NODE ;Source address .Address SRC_NODE ;Source node name .Address TARGET_ADDR ;Target address .Address TARGET_NODE ;Target node name ; FAO control strings and other related stuff. NET0: .Ascid "NET0" ;Where to find NETACP TT: .Ascid "TT" ;Where to find our terminal SYS$NODE: .Ascid "SYS$NODE" ;Where to find our node name LNM_TABLE: .Ascid "LNM$SYSTEM_TABLE" ;Where to find SYS$NODE US: .Ascid "NetPath" ;What we call ourselves LOCAL: .Ascic "(Local)" ;Local circuit name PROMPT: .Ascid "_Node: " HEADER: .Ascid " From Via To RTT(ms) Cost Hops" FAO_PATH: .Ascid "Path from !AD (!UB.!UW) to !AD (!UB.!UW):" FAO_SUMMARY: .Ascid "!UL hop!%S at a cost of !UL, RTT = !UL ms" FAO_HOP: .Ascid "!6 !9<(!UB.!UW)!> !9AC !6 !9<(!UB.!UW)!> !5UL !4UW !4UW" FAO_NCB: .Ascid '!UW::"19=/'<0><0><3><4><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0>'"' FAO_NCB_DELAY: .Ascid '!UW::"1="' FAO_STATUS: .Ascid "[!%T Attempting to connect to node !AD (!UB.!UW)]" .Page .Subtitle Entry point .Psect CODE EXE,RD,NOWRT,PIC,SHR,PAGE .Entry START,^m<> ;Entry here MOVAB COND_HANDLER,(FP) ;Get our own condition handler ; Get a channel to our terminal if we have one. $ASSIGN_S DEVNAM=TT,- ;Get a channel CHAN=TT_CHAN ; to our terminal ; Get a channel to speak to NETACP on. $ASSIGN_S DEVNAM=NET0,- ;First get a channel CHAN=NETACP_CHAN ; to talk to NETACP on BLBC R0,10$ ;Give up now ; Get our local node name and address. $TRNLNM_S TABNAM=LNM_TABLE,- ;Translate LOGNAM=SYS$NODE,- ; SYS$NODE ITMLST=LNM_ITEMS ; ... BLBC R0,10$ ;Lose. SUBL #2,LOCAL_NODE ;Lose the trailing ::s ADDL3 #6,LOCAL_NODE,KEY ;Complete the key descriptor MOVW LOCAL_NODE,SEARCH_KEY ;Copy the node name length MOVQ LOCAL_BUFF,SEARCH_KEY+2 ;Copy the node name MOVAB NAME_TO_ADDR,R1 ;Use this NFB BSBW ASK_NETACP ;Ask NETACP for the node address BLBS R0,20$ ;Win ; Here when we have a fatal initialization error. Lose. 10$: PUSHL R0 ;Signal our CALLS #1,G^LIB$STOP ; error and die ; Ok - we've got a way to talk to NETACP and know about our local DECnet ; node. Now start asking the user for commands. 20$: MOVZWL NETACP_BUFF,LOCAL_ADDR ;Copy our local node address MOVAL TPARSE_BLOCK,R11 ;A handy address ; Get another command from SYS$INPUT. 30$: MOVZBL #128,TPA$L_STRINGCNT(R11) ;Reset the input MOVAB IN_BUFF,TPA$L_STRINGPTR(R11) ; buffer descriptor PUSHAW TPA$L_STRINGCNT(R11) ;Return the length here PUSHAQ PROMPT ;Here's our prompt PUSHAQ TPA$L_STRINGCNT(R11) ;Here's our input buffer CALLS #3,G^LIB$GET_INPUT ;Get some input BLBC R0,40$ ;Check for EOF ; Trim & upcase the string. PUSHAQ TPA$L_STRINGCNT(R11) ;Stack the output descriptor address PUSHL (SP) ;Which is also the input buffer PUSHL (SP) ;Which is also where to return the length CALLS #3,G^STR$TRIM ;Trim the input down TSTW TPA$L_STRINGCNT(R11) ;Any input? BEQL 30$ ;If EQL no, ask again PUSHAQ TPA$L_STRINGCNT(R11) ;Stack the output descriptor address PUSHL (SP) ;Which is also the input buffer CALLS #2,G^STR$UPCASE ;Upcase the string ; Re-initialize a few variables. MOVL #2,NODES ;A maximum of two nodes, please. CLRO AREA ;Zap the area, cost, total cost and hops CLRQ AVE_RTT ;Zap the average RTT and samples MOVL LOCAL_ADDR,NEXT_NODE ;Start at the local host MOVL LOCAL_NODE,SRC_NODE ; ... MOVQ LOCAL_BUFF,SRC_BUFF ; ... PUSHAL NETP_KEYS ;The keyword table is here PUSHAL NETP_STATES ;The state table is here PUSHL R11 ;The TPARSE block is here CALLS #3,G^LIB$TPARSE ;Feed it to TPARSE BLBS R0,30$ ;Loop if we won ; Some kind of error -- signal it. CMPL #LIB$_SYNTAXERR,R0 ;Syntax error? BNEQ 40$ ;If NEQ no, simply signal what we've got PUSHAQ TPA$L_TOKENCNT(R11) ;Here's the token we barfed on PUSHL #1 ;1 FAO argument PUSHL #NP$_SYNTAX ;It's a syntax error CALLS #3,G^LIB$SIGNAL ;Signal it BRW 30$ ;Ask for something else to do 40$: CMPL R0,#RMS$_EOF ;End of file? BNEQ 50$ ;If NEQ no MOVL #SS$_NORMAL,R0 ;Else shhh. RET ;Bye ; Here when we've got some other sort of error code ... signal it and hope ; for the best. 50$: PUSHL R0 ;Signal what CALLS #1,G^LIB$SIGNAL ; we got BRW 30$ ;Ask again .Page .Subtitle LOOK_NAME - Look up a host by name ;+ ; ; ----- LOOK_NAME: Look up a host by name ; ; ; This routine is called as a TPARSE action routine to look up a host ; by name. ; ; Inputs: ; ; TPA$L_TOKENCNT(AP) - A descriptor of the destination node name ; ; Outputs: ; ; Node name looked up. ; ;- LOOK_NAME: .Word ^m ;Look up a host by name MOVZBW TPA$L_TOKENCNT(AP),SEARCH_KEY ;Stash the node name length MOVL NODE_PTR,R0 ;Fetch the node name descriptor address MOVZBL SEARCH_KEY,(R0) ;Stash the length here, too. MOVQ @TPA$L_TOKENPTR(AP),SEARCH_KEY+2 ;Stash the node name MOVQ SEARCH_KEY+2,@4(R0) ;Twice ADDL3 #6,(R0),KEY ;Make a descriptor of the search key MOVAB NAME_TO_ADDR,R1 ;Use this NFB BSBW ASK_NETACP ;Translate the name to an address MOVW NETACP_BUFF,@ADDR_PTR ;Copy the target address BLBS R0,10$ ;Win! CMPW #SS$_ENDOFFILE,R0 ;End of file? BNEQ 10$ ;If NEQ no MOVL #NP$_NONODE,R0 ;Else modify the message a bit 10$: RET ;Else return with the error code .Page .Subtitle LOOK_ADDR - Look up a node by address ;+ ; ; ----- LOOK_ADDR: Look up a node by address ; ; ; This routine is called as a TPARSE action routine to look up a host ; by address. We make an attempt to resolve the address to a name, ; but don't worry too much if we can't. ; ; Inputs: ; ; TPA$L_NUMBER(AP) - Node address ; AREA - Node area ; ; Outputs: ; ; Node name looked up. ; ;- LOOK_ADDR: .Word ^m ;Look up a node by address ADDW3 TPA$L_NUMBER(AP),AREA,@ADDR_PTR ;Get the target node address ; Ask NETACP to translate the number to a name (if we can). MOVL #8,KEY ;Make a key descriptor MOVZWL @ADDR_PTR,SEARCH_KEY ;Copy the search key MOVAB ADDR_TO_NAME,R1 ;Use this NFB BSBW ASK_NETACP ;Ask NETACP to translate this node BLBC R0,10$ ;Sigh. MOVL NODE_PTR,R0 ;Fetch the descriptor pointer MOVZWL NETACP_BUFF,(R0)+ ;Stash the length MOVQ NETACP_BUFF+2,@(R0) ;Stash the node name 10$: MOVL #SS$_NORMAL,R0 ;Unconditional success RET ;Back to TPARSE .Page .Subtitle TRACE_PATH - Trace a path between nodes ;+ ; ; ----- TRACE_PATH: Trace a path between nodes ; ; ; This routine is called to trace a path between two nodes. ; ; Inputs: ; ; TARGET_ADDR - Target node address ; NEXT_NODE - Source node address ; ; Outputs: ; ; Path traced and listed on SYS$OUTPUT. ; ;- TRACE_PATH: .Word ^m ;Trace a path between nodes ; First output a header. BSBW BLANK_LINE ;Output a blank line MOVAL FAO_ARGS,R0 ;A handy address MOVQ SRC_NODE,(R0)+ ;Copy our local node name descriptor EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,(R0)+ ;Stash our area number EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,(R0)+ ;Stash our node number MOVQ TARGET_NODE,(R0)+ ;Copy the target node name descriptor EXTZV #NMA$V_AREA,#NMA$S_AREA,TARGET_ADDR,(R0)+ ;Stash the target area number EXTZV #NMA$V_ADDR,#NMA$S_ADDR,TARGET_ADDR,(R0) ;Stash the target node number MOVAQ FAO_PATH,R1 ;Use this control string BSBW FAO_IT ;Format and display a result BSBW BLANK_LINE ;Output another blank line MOVL SRC_NODE,LAST_NAME ;Copy the source node parameters MOVQ SRC_BUFF,LAST_BUFF ; ... MOVL SRC_NODE,NEXT_NAME ;Copy the source node as the next node, too. MOVQ SRC_BUFF,NEXT_BUFF ; ... MOVW NEXT_NODE,LAST_NODE ; as the "last node" BNEQ 10$ ;Not tracing a path from ourselves ; If we're tracing a path from ourselves to ourselves we're definitely done. MOVL LOCAL_NODE,LAST_NAME ;Starting at node 0.0 -- local MOVQ LOCAL_BUFF,LAST_BUFF ;So copy the real poop MOVW LOCAL_ADDR,LAST_NODE ; on our local node. CMPW LOCAL_ADDR,TARGET_ADDR ;Are we done yet? BEQL 30$ ;If EQL yes. 10$: PUSHAQ HEADER ;Output another CALLS #1,G^LIB$PUT_OUTPUT ; header BSBW BLANK_LINE ; ... ; Check to see if we're done yet. 20$: CMPW NEXT_NODE,TARGET_ADDR ;Are we done yet? BNEQ 50$ ;If NEQ no, trudge on ; We're done. Display a summary and leave. 30$: BSBW BLANK_LINE ;Blank line MOVQ HOPS,FAO_ARGS ;Copy the hops and total cost BSBW CALC_DELAY ;Go attempt to calculate the delay to this node MOVL R0,FAO_ARGS+8 ;Stash the measured delay MOVAQ FAO_SUMMARY,R1 ;Use this control string BSBW FAO_IT ;Format and display a summary line BSBW BLANK_LINE ;Follow it with another blank line 40$: RET ;Done ; Get a connection to the next node in the chain. 50$: BSBW CONNECT_NEXT ;Go connect to the next node INCL HOPS ;1 more hop ; Ask this node what the status of the target node is. MOVAB NICE_SHOW_NODE,R1 ;Send this message. MOVL #2,NML_OFFSET ;The responses will start here BSBW SEND_NICE ; ... ; Now see if we have a next node to destination and a circuit name. Note ; that if the current node is a full routing node it will have reachability ; information for the target node if it's in the same area. If the target ; node is unreachable, there won't be a next node to destination in the ; response from NML ... MOVL #NMA$C_PCNO_NND,R7 ;Go search for this parameter BSBW FIND_NICE ;See if we can find it BLBS R0,70$ ;We did TSTL R0 ;Simply not there? BNEQ 60$ ;No, a real error PUSHAQ TARGET_NODE ;Stack the target name address EXTZV #NMA$V_ADDR,#NMA$S_ADDR,TARGET_ADDR,-(SP) ;Stack the node address EXTZV #NMA$V_AREA,#NMA$S_AREA,TARGET_ADDR,-(SP) ;Stack the node area PUSHL #3 ;3 FAO arguments PUSHL #NP$_UNREACH ;Stack the error code CALLS #5,G^LIB$SIGNAL ;Signal the error 60$: RET ;Return with an error code in R0 ; We have the next node to ask ... R11 is pointing at the NICE parameter. ; The next node is a NICE coded multiple field with two parts. The first ; part is the node address as an uncoded 16 bit field. The second part ; is an uncoded single image field containing the node name. 70$: MOVW 4(R11),NEXT_NODE ;Copy the node address CMPZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,#0 ;Any area number? BNEQ 80$ ;If NEQ yes BISW #<1@NMA$V_AREA>,NEXT_NODE ;Else stuff a 1 80$: CLRL NEXT_NAME ;Presume we don't have a node name length CMPZV #NMA$V_PTY_NLE,#NMA$S_PTY_NLE,2(R11),#2 ;Node name present? BNEQ 90$ ;If NEQ no, don't try to copy it. MOVB 7(R11),NEXT_NAME ;Copy the node name length MOVQ 8(R11),NEXT_BUFF ;Copy the next node name ; Go hunt down the next circuit to use. If we don't find it presume we're ; done, as it's likeley that we asked how to get to a cluster alias. 90$: MOVL #NMA$C_PCNO_DLI,R7 ;Go hunt for the destination circuit BSBW FIND_NICE ; ... BLBS R0,100$ ;If LBS, we found it TSTL R0 ;Simply not there? BNEQ 60$ ;If NEQ no, some real error. ; Ok - we've probably reached a cluster alias. Stick in a dummy circuit ; name and join the display code. MOVQ LOCAL,CIRCUIT ;Stash the circuit name CLRL COST ;Zero cost MOVW TARGET_ADDR,NEXT_NODE ;Fix the target address MOVL TARGET_NODE,NEXT_NAME ;Fix the target MOVQ TARGET_BUFF,NEXT_BUFF ; node name DECL HOPS ;No hops for the final leg. BRB 130$ ;Join the common display code ; Ok - R11 points to the destination circuit name, which is an ASCII image ; field. 100$: MOVZBL 3(R11),R1 ;Grab the circuit name length ADDB3 #3,R1,NICE_SHOW_CIRC ;Compute the entire length of the NICE message MOVB R1,CIRCUIT ;Stash the circuit name length MOVC3 R1,4(R11),CIRCUIT+1 ;Copy the circuit name ; Do a Show Circuit Characteristics to get the cost. MOVAB NICE_SHOW_CIRC,R1 ;Send this message CLRL NML_OFFSET ;The responses will start here BSBW SEND_NICE ; ... BLBC R0,110$ ;Lose! ; Now hunt down the circuit cost. CLRL COST ;Zap the cost MOVL #NMA$C_PCCI_COS,R7 ;Go hunt for BSBW FIND_NICE ; the circuit cost BLBS R0,120$ ;If LBS, we're ok TSTL R0 ;Simply not there? BEQL 120$ ;If EQL yes, no big deal 110$: RET ;Bogus error detected ; Ok - R11 is pointing at the NICE parameter containing the circuit cost, ; which is a decimal number 1 byte in length. 120$: MOVZBL 3(R11),COST ;Stash the cost ADDL COST,TOTAL_COST ;Add it in to the total ; Display another line. 130$: MOVAL FAO_ARGS,R1 ;A handy address MOVQ LAST_NAME,(R1)+ ;Stash the current node name descriptor EXTZV #NMA$V_AREA,#NMA$S_AREA,LAST_NODE,(R1)+ ;Grab the area number EXTZV #NMA$V_ADDR,#NMA$S_ADDR,LAST_NODE,(R1)+ ;Grab the node number MOVAB CIRCUIT,(R1)+ ;Stash a pointer to the circuit name MOVQ NEXT_NAME,(R1)+ ;Stash the next node name descriptor EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,(R1)+ ;Grab the area number EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,(R1)+ ;Grab the node number ; Compute the average round-trip time from all of the queries we sent to NML. DIVL3 SAMPLES,AVE_RTT,(R1)+ ;Average the round-trip time (in ms) MOVQ COST,(R1) ;Copy the cost and hops MOVAQ FAO_HOP,R1 ;Format with this string BSBW FAO_IT ;Format and display the line MOVL NEXT_NAME,LAST_NAME ;Next node is now MOVW NEXT_NODE,LAST_NODE ; the last node MOVQ NEXT_BUFF,LAST_BUFF ; ... BSBW DRAIN_NICE ;Go drain out any left-over NICE messages BRW 20$ ;Loop .Page .Subtitle CONNECT_NEXT - Connect to the next node in the chain ;+ ; ; ----- CONNECT_NEXT: Connect to the next node in the chain ; ; ; This routine is called to connect to NML on the next node in the path. ; We keep a cache of open channels to NMLs along the path, and search ; this cache before opening a new channel. If we don't have a node in ; our cache we'll add it, possibly purging out an older one in the ; process. Our cache is fairly small, so the search thru it is linear ; since it's easier to code and a faster search algorithm wouldn't buy ; us much (and I'm lazy). The replacement algorithm is LRU approximation ; via a use count in each cache block. ; ; Inputs: ; ; NEXT_NODE - Next node address to connect to. ; LLCS - Logical link cache table ; ; Outputs: ; ; R0 - Status ; R9 - LLC pointer ; ;- CACHE_FOUND: ;Ref. label INCB LLC$B_USE(R9) ;Another use MOVL #SS$_NORMAL,R0 ;Success RSB ;Done CONNECT_NEXT: ;Connect to the next node in the chain ; Reinitialize things for the next pass thru. CLRL NML_LENGTH ;No NML responses CLRL NML_MULTIPLE ; laying around ; Search the LLC for this node. MOVAL LLCS,R9 ;Address the LLC cache MOVL #CACHE_SIZE,R8 ;Here's how big the table is MOVZWL NEXT_NODE,R7 ;Fetch the next node number BNEQ 10$ ;If NEQ it's non-zero MOVW LOCAL_ADDR,R7 ;Else use our local address 10$: TSTW LLC$W_CHAN(R9) ;Is this one in use? BEQL 20$ ;If EQL no CMPW R7,LLC$W_ADDR(R9) ;Match? BEQL CACHE_FOUND ;If EQL yes! 20$: MOVAB LLC$K_LENGTH(R9),R9 ;Chain to the next LLC SOBGTR R8,10$ ;Around and around we go. ; We get here when the cache is full and we didn't find our node in it. ; Search the cache for the node with the lowest use count and delete it. ; If we happen to stumble into an LLC block which is not in use we'll ; happily use it instead. An LLC block can wind up not in use if it was ; in the cache at one time, but an attempt to use the channel again ; produced an error. MOVL #CACHE_SIZE,R8 ;Get the cache size again MOVAL LLCS,R9 ;Start at the beginning MOVL R9,R1 ;Preset it to be the oldest (not likekely that it is, tho) 30$: TSTB LLC$B_USE(R9) ;Is this LLC in use? BEQL 50$ ;If EQL no, use it! CMPB LLC$B_USE(R9),LLC$B_USE(R1) ;This one older? BGEQU 40$ ;If GEQU no. CMPW LOCAL_ADDR,LLC$W_ADDR(R9) ;Is this us? BEQL 40$ ;If EQL yes, don't delete it. MOVL R9,R1 ;Else we have a new oldest one 40$: MOVAB LLC$K_LENGTH(R9),R9 ;Address the next LLC SOBGTR R8,30$ ;Search the entire table. MOVL R1,R9 ;R1 points to the one to purge. ; Here when we've got an empty LLC entry or one that needs replacing. 50$: $DASSGN_S CHAN=LLC$W_CHAN(R9) ;Lose the old channel number just in case CLRW LLC$W_CHAN(R9) ; ... MOVW R7,LLC$W_ADDR(R9) ;Stash the node address in the block CLRB LLC$B_USE(R9) ;Not in use, so use count = 0 ; If we've got a terminal, establish an out-of-band AST for ^T to report ; on our status. TSTW TT_CHAN ;Do we have a terminal? BEQL 60$ ;If EQL no PUSHAL CTRL_MASK ;Return the old mask here PUSHAL BAND_MASK+4 ;Turn off ^T CALLS #2,G^LIB$DISABLE_CTRL ; ... MOVAB BAND_MASK,R1 ;Address our OOB mask to maintain PIC $QIOW_S CHAN=TT_CHAN,- ;Establish an FUNC=#IO$_SETMODE!IO$M_OUTBAND,- ; out-of-band P1=90$,P2=R1 ; AST ; Attempt to connect to the remote. 60$: $ASSIGN_S DEVNAM=NET0,- ;Get a new channel CHAN=LLC$W_CHAN(R9) ; to talk to the network on BLBC R0,70$ ;We lose. MOVAQ NCB,R2 ;Address our NCB MOVZBL #128,(R2) ;Reset the NCB descriptor $FAO_S CTRSTR=FAO_NCB,- ;Build an OUTBUF=(R2),- ; NCB to contact OUTLEN=(R2)- ; NML at the next P1=NEXT_NODE ; node ... ; Attempt to connect to the remote NML. $QIOW_S CHAN=LLC$W_CHAN(R9),- ;Establish contact FUNC=#IO$_ACCESS,- ; with the remote IOSB=NET_IOSB,- ; NML P2=R2 ;NCB descriptor here 70$: PUSHL R0 ;Save the status $CANCEL_S CHAN=TT_CHAN ;Flush the OOB ast PUSHAL CTRL_MASK ;Re-enable CALLS #1,G^LIB$ENABLE_CTRL ; DCL ^T POPL R0 ;Restore the connect status BLBC R0,80$ ;Lose! MOVZWL NET_IOSB,R0 ;Check here, too. BLBC R0,80$ ;Lose! CLRQ AVE_RTT ;Zap the average RTT and sample count INCB LLC$B_USE(R9) ;Up the use count RSB ;Done ; Here on some sort of dire error. 80$: PUSHL R0 ;Stack the associated condition PUSHAQ NEXT_NAME ;Stack the address of the node name EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,-(SP) ;Stack the node address EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,-(SP) ;Stack the node area PUSHL #3 ;3 FAO arguments PUSHL #NP$_CONNERR ;Stack the error code CALLS #6,G^LIB$SIGNAL ;Signal the error BSBW ZAP_LLC ;Zap the LLC RET ;Abort the action routine ; Simple out-of-band AST for ^T while attempting a connection. 90$: .Word ^m ;Here on ^T MOVAL FAO_ARGS,R2 ;A handy address CLRL (R2)+ ;Use the current time MOVAQ NEXT_NAME,R1 ;Presume we're connecting MOVZWL NEXT_NODE,R0 ; some other node besides ourselves BNEQ 100$ ;If NEQ we are MOVAQ LOCAL_NODE,R1 ;Else we're connecting to MOVZWL LOCAL_ADDR,R0 ; ourselves 100$: MOVQ (R1),(R2)+ ;Copy the node name EXTZV #NMA$V_AREA,#NMA$S_AREA,R0,(R2)+ ;Copy the area number EXTZV #NMA$V_ADDR,#NMA$S_ADDR,R0,(R2) ;Copy the node number MOVAB FAO_STATUS,R1 ;Use this control string BSBW FAO_IT ;Format and display the message RET ;Dismiss the AST .Page .Subtitle CALC_DELAY - Calculate the delay to a node ;+ ; ; ----- CALC_DELAY: Calculate the delay to a node ; ; ; This routine uses a heuristic to attempt to calculate the delay to ; a given node. At present, this routine is only called for the ; target node of a given path trace. The node cache is bypassed for ; this calculation, since we attempt to connect to object number 1 ; at the remote node (which usually doesn't exist). We calculate ; the delay based on the amount of time it takes for the remote node ; to reject the connection (either because the object doesn't exist, ; because the access control info failed), or, on the off chance that ; object 1 does exist, for the connect confirm to come back. ; ; Inputs: ; ; TARGET_ADDR - Target node address ; ; Outputs: ; ; As described above. ; ;- CALC_DELAY: ;Calculate the delay to a node MOVAQ NCB,R2 ;Address our NCB descriptor MOVZBL #128,(R2) ;Reset its length $FAO_S CTRSTR=FAO_NCB_DELAY,- ;Format with this string OUTBUF=(R2),- ;Output buffer is here OUTLEN=(R2),- ;Return the length here P1=TARGET_ADDR ;Here's the address $GETTIM_S START_TIME ;"At the tone, the time will be ..." $ASSIGN_S DEVNAM=(R2),- ;Attempt to connect to object 1 CHAN=DELAY_CHAN ; ... $GETTIM_S END_TIME ;Get the time now $DASSGN_S DELAY_CHAN ;Lose the channel CLRW DELAY_CHAN ; ... SUBL START_TIME,END_TIME ;Compute the SBWC START_TIME+4,END_TIME+4 ; elapsed time EDIV #10000,END_TIME,R0,R1 ;Convert it to ms RSB ;Done .Page .Subtitle SEND_NICE - Send a NICE message ;+ ; ; ----- SEND_NICE: Send a NICE message ; ; ; This routine is called to send a NICE message. We first check to ; make sure that the last NICE response was an "all done" message. ; ; Inputs: ; ; R1 - Pointer to a counted string of the NICE message ; R9 - LLC pointer. ; ; Outputs: ; ; Message sent; R0 = status ; ;- SEND_NICE: ;Send a NICE message PUSHL R1 ;Stash the NICE message pointer a bit BSBW DRAIN_NICE ;Drain any NICE responses which are lurking $GETTIM_S START_TIME ;Get the starting time POPL R1 ;Restore the NICE message pointer MOVZBL (R1)+,R0 ;Grab the length $QIOW_S CHAN=LLC$W_CHAN(R9),- ;Send the message FUNC=#IO$_WRITELBLK,- ; ... IOSB=NET_IOSB,- ;I/O status here P1=(R1),P2=R0 ;Here's the message BLBC R0,10$ ;Lose. MOVZWL NET_IOSB,R0 ;Grab the verdict BLBC R0,10$ ;Lose. RSB ;Done otherwise ; Here when we had trouble sending a message to the destination. Signal ; an error and return. 10$: PUSHL R0 ;Stack the associated condition PUSHAQ NEXT_NAME ;Stack the address of the node name EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,-(SP) ;Stack the node address EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,-(SP) ;Stack the node area PUSHL #3 ;3 FAO arguments PUSHL #NP$_XMITERR ;Stack the error code CALLS #6,G^LIB$SIGNAL ;Signal the error BSBW ZAP_LLC ;Zap the LLC RET ;Abort the action routine .Page .Subtitle DRAIN_NICE - Drain any lurking NICE responses ;+ ; ; ----- DRAIN_NICE: Drain any lurking NICE responses ; ; ; This routine can be called to drain any lurking NICE responses in ; a multiple-response query. ; ; Inputs: ; ; R9 - LLC w/channel to NICE. ; ; Outputs: ; ; NICE responses drained. ; ;- DRAIN_NICE: ;Drain any lurking NICE responses BBC #0,NML_MULTIPLE,10$ ;Branch if we're not in multiple response mode CMPB #NMA$C_STS_DON,NICE_BUFF ;All done? BEQL 10$ ;If EQL yes $QIOW_S CHAN=LLC$W_CHAN(R9),- ;Else grab FUNC=#IO$_READLBLK,- ; the next IOSB=NET_IOSB,- ; message P1=NICE_BUFF,P2=#512 ; ... BLBC R0,20$ ;Lose. MOVZWL NET_IOSB,R0 ;Check here, too BLBC R0,20$ ;Lose. BRB DRAIN_NICE ;Look again 10$: CLRL NML_MULTIPLE ;Not in multiple response mode any more CLRL NML_LENGTH ;No current NML response RSB ;Done ; Here when we had trouble receiving a message from the destination. Signal ; an error and return. 20$: PUSHL R0 ;Stack the associated condition PUSHAQ NEXT_NAME ;Stack the address of the node name EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,-(SP) ;Stack the node address EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,-(SP) ;Stack the node area PUSHL #3 ;3 FAO arguments PUSHL #NP$_RECVERR ;Stack the error code CALLS #6,G^LIB$SIGNAL ;Signal the error BSBW ZAP_LLC ;Zap the LLC RET ;Abort the action routine .Page .Subtitle FIND_NICE - Find a NICE parameter ;+ ; ; ----- FIND_NICE: Find a NICE parameter ; ; ; This routine is called to search for a particular NICE parameter amid ; the myriad of parameters a query to the remote NML will produce. If ; we don't have a response from the remote NML yet we'll ask for one. ; This routine will also properly handle multiple NICE responses. ; ; Inputs: ; ; R7 - NICE parameter to search for ; R9 - LLC with channel to the remote NML ; ; Outputs: ; ; R0 - Status (0 implies not found) ; R11 - Address of the NICE parameter ; ;- DECNET_ERR: ;Ref. label PUSHL R0 ;Stack the associated error PUSHAQ NEXT_NAME ;Stack the address of the node name EXTZV #NMA$V_ADDR,#NMA$S_ADDR,NEXT_NODE,-(SP) ;Stack the node address EXTZV #NMA$V_AREA,#NMA$S_AREA,NEXT_NODE,-(SP) ;Stack the node area PUSHL #3 ;3 FAO arguments PUSHL #NP$_RECVERR ;Stack the error code CALLS #6,G^LIB$SIGNAL ;Signal the error BSBW ZAP_LLC ;Zap the LLC RET ;Abort the action routine NICE_ERR: ;Ref. label PUSHAB 3(R11) ;Stack the address of the counted string CVTBL (R11),-(SP) ;Stack the NICE error code PUSHL #2 ;2 FAO arguments PUSHL #NP$_NICERR ;Stack the condition value CALLS #4,G^LIB$SIGNAL ;Signal the error RET ;Abort the action routine FIND_NICE: ;Find a NICE parameter MOVAB NICE_BUFF,R11 ;Address our NICE buffer MOVL NML_LENGTH,R10 ;Grab the NML length BGTR 60$ ;If GTR we've something to look at ; No NML response yet, solicit one (or more) 10$: CLRL NML_LENGTH ;Start afresh MOVAB NICE_BUFF,R11 ; ... $QIOW_S CHAN=LLC$W_CHAN(R9),- ;Grab FUNC=#IO$_READLBLK,- ; another IOSB=NET_IOSB,- ; response P1=(R11),P2=#512 ; from NML BLBC R0,DECNET_ERR ;Bogon emission detected! MOVZWL NET_IOSB,R0 ;Check here, too BLBC R0,DECNET_ERR ;Just not our day BLBS NML_MULTIPLE,20$ ;Multiple response mode? ; Not in multiple response mode -- compute the round trip time. BSBW COMPUTE_RTT ;Go compute the round-trip time (branches won't make it if we do this in-line) 20$: MOVZWL NET_IOSB+2,R10 ;Grab the response length ; Check to see what kind of NICE response this is. CLRL R0 ;Presume parameter not found TSTB (R11) ;Check the NICE response BGTR 40$ ;If GTR it's Ok ; Here when we have a NICE error. If it's -128 then it's not an error. CMPB #NMA$C_STS_DON,(R11) ;NICE done? BNEQ NICE_ERR ;If NEQ no. 30$: RSB ;Done, status in R0 ; Here when the respone from NICE was encouraging. Check to see if this ; is a success, or "more comming" message. 40$: MOVL R10,NML_LENGTH ;Stash the length CMPB #NMA$C_STS_MOR,(R11) ;More comming? BNEQ 60$ ;If NEQ no MOVL #1,NML_MULTIPLE ;Else flag the fact that 50$: BRB 10$ ; got multiple responses comming ; Pass up the NICE response code, detail bytes, and error message. 60$: ADDL #3,R11 ;Pass up the response code SUBL #3,R10 ; and detail bytes MOVZBL (R11)+,R0 ;Grab the error message length DECL R10 ;Account for it ADDL R0,R11 ;Pass up the error message SUBL R0,R10 ; ... ; Pass up response-specific parameter(s). ADDL NML_OFFSET,R11 ;Pass up SUBL NML_OFFSET,R10 ; the NML MOVZBL (R11)+,R0 ; specific DECL R10 ; parameter(s) BICB #^x80,R0 ;Clear the silly-ass "I am executor bit" ADDL R0,R11 ; ... SUBL R0,R10 ; ... ; Now begin the search in earnest for the specified parameter, whose ; type code is in R7. 70$: TSTL R10 ;Anything left to search thru? BGTR 80$ ;If GTR yes BLBS NML_MULTIPLE,50$ ;Multiple responses comming? CLRL R0 ;Nope RSB ;Done 80$: MOVL #SS$_NORMAL,R0 ;Presume success CMPW R7,(R11) ;Is it this one? BEQL 30$ ;If EQL yes, we're done ; Not the one we're looking for, skip it and try the next one. MOVZWL (R11)+,R1 ;Grab the entity type SUBL #2,R10 ;Adjust the length BBC #NMA$V_CNT_COU,R1,100$ ;Branch if it's not a counter ; We have a counter. Bits 0-11 are the counter number, bit 12 indicates ; the presence of a bitmap, and bits 13-14 are the counter width in bytes. EXTZV #NMA$V_CNT_WID,#NMA$S_CNT_WID,R1,R2 ;Grab the length in bytes BBC #NMA$V_CNT_MAP,R1,90$ ;Branch if there's no bitmap ADDL #2,R2 ;Else add in the map length 90$: ADDL R2,R11 ;Pass up the counter SUBL R2,R10 ; ... BRB 70$ ;And try the next parameter ; Here when we have a regular parameter. The next byte is the data type. 100$: MOVZBL (R11)+,R1 ;Grab the data type DECL R10 ;Adjust the length ; Check to see if it's a coded type. MOVL #1,R2 ;Presume it's a single type, coded or uncoded BBC #NMA$V_PTY_COD,R7,120$ ;Branch if it's not a coded type. ; It's a coded type. See if it's a single or multiple. BBC #NMA$V_PTY_MUL,R1,120$ ;Branch if it is. ; It's a coded multiple (yuck). The number of fields are in bits 0-4, ; and each field is preceeded by a data type byte. EXTZV #NMA$V_PTY_NLE,#NMA$S_PTY_NLE,R1,R2 ;Grab the number of fields ; Here to grab the next type byte. 110$: MOVZBL (R11)+,R1 ;Grab the data type DECL R10 ;Adjust the length ; Figure out if we've got another coded field, image field, or strict data. 120$: EXTZV #NMA$V_PTY_NLE,#NMA$S_PTY_NLE,R1,R0 ;Grab the data length BBS #NMA$V_PTY_COD,R1,140$ ;Coded type? BBS #NMA$V_PTY_ASC,R1,130$ ;ASCII image? BICL #^c,R1 ;Image? BNEQ 140$ ;If NEQ no ; Image type (either ASCII or otherwise). The next byte contains the ; length, so snarf it up. 130$: MOVZBL (R11)+,R0 ;Grab the image length DECL R10 ;Adjust the message length ; Pass up this parameter, whose length is (finally) in R0. 140$: ADDL R0,R11 ;Pass up this entity SUBL R0,R10 ;Adjust the length SOBGTR R2,110$ ;Do this as many times as necessary BRW 70$ ;Check out the next entity ; Local subroutine to compute the round-trip time average. Do it this ; way so the branches above can still reach (sigh). COMPUTE_RTT: ;Ref. label $GETTIM_S END_TIME ;Get the current time INCL SAMPLES ;Another sample SUBL START_TIME,END_TIME ;Compute the SBWC START_TIME+4,END_TIME+4 ; delta time EDIV #10000,END_TIME,R0,R1 ;Convert it to ms. ADDL R0,AVE_RTT ;Add it into the average round-trip time RSB ;Done .Page .Subtitle ASK_NETACP - Ask NETACP something ;+ ; ; ----- ASK_NETACP: Ask NETACP something ; ; ; This routine is called to ask NETACP something via the IO$_ACPCONTROL ; QIO interface. ; ; Inputs: ; ; R1 - NFB address ; NETACP_CHAN - Channel to NETACP ; KEY - Search key descriptor ; NETACP_DESC - A descriptor of NETACP's output buffer ; ; Outputs: ; ; R0 - Status ; ;- ASK_NETACP: ;Ask NETACP something MOVL R1,NFB+4 ;Form a descriptor of the NFB (they're all te same length) MOVAB NETACP_DESC,R4 ;Address the output descriptor to maintain PIC MOVAB KEY,R2 ;Address the key descriptor to maintain PIC MOVZBL #128,(R4) ;Reset the output descriptor length $QIOW_S CHAN=NETACP_CHAN,- ;Ask NETACP FUNC=#IO$_ACPCONTROL,- ; to do something IOSB=NET_IOSB,- ; for us P1=NFB,- ;NFB descriptor here P2=R2,- ;Key descriptor here P4=R4 ;Output descriptor here BLBC R0,10$ ;Lossage! MOVZWL NET_IOSB,R0 ;Grab the status 10$: RSB ;Done, status in R0 .Page .Subtitle BLANK_LINE - Output a blank line ;+ ; ; ----- BLANK_LINE: Output a blank line ; ; ; This routine will output a blank line on SYS$OUTPUT. ; ; Inputs: ; ; OUT_DESC - Output buffer descriptor ; ; Outputs: ; ; Blank line output on SYS$OUTPUT. ; ;- BLANK_LINE: ;Output a blank line CLRL OUT_DESC ;Output PUSHAQ OUT_DESC ; a blank CALLS #1,G^LIB$PUT_OUTPUT ; line RSB ;Done .Page .Subtitle FAO_IT - Format and display a buffer ;+ ; ; ----- FAO_IT: Format and display a buffer ; ; ; This routine is called to format a buffer and then display the ; result on SYS$OUTPUT. ; ; Inputs: ; ; R1 - FAO control string address ; FAO_ARGS - FAO argument list ; OUT_DESC - Output buffer descriptor ; ; Outputs: ; ; Buffer formatted and displayed. ; ;- FAO_IT: ;Format and display a buffer MOVZBL #128,OUT_DESC ;Reset the descriptor length $FAOL_S CTRSTR=(R1),- ;Format with this string OUTBUF=OUT_DESC,- ;The output buffer is here OUTLEN=OUT_DESC,- ;Return the length here PRMLST=FAO_ARGS ;Here are the arguments PUSHAQ OUT_DESC ;Stack the address of the resulting descriptor CALLS #1,G^LIB$PUT_OUTPUT ;Display same RSB ;Done .Page .Subtitle FIX_AREA - Fix the area number ;+ ; ; ----- FIX_AREA: Fix the area number ; ; ; This routine is called as a TPARSE action routine when we detect the ; presence of an area number in our command. The area number is still in ; TPA$L_NUMBER(AP), but it hasn't been stuffed into the area number bits ; (10-15) of the node address. We perform the stuffing and return. ; ; Inputs: ; ; TPA$L_NUMBER(AP) - Area number ; ; Outputs: ; ; Area number shifed left 10 bits. ; ;- FIX_AREA: .Word ^m<> ;Fix the area number MULW3 #1024,TPA$L_NUMBER(AP),AREA ;Shove the area number over into the right spot RET ;That was easy .Page .Subtitle TWO_NODES - Ensure a maximum of two nodes given ;+ ; ; ----- TWO_NODES: Ensure a maximum of two nodes given ; ; ; This routine is called as a TPARSE action routine to ensure that ; the user specifies a maximum of two nodes at us -- if our counter ; gets to zero then we return "success" from this routine, causing ; TPARSE to punt out with a syntax error. A side duty we perform ; is to initialize the pointers to node name and address for LOOK_* ; to stash their info in. ; ; Inputs: ; ; NODES - Number of nodes allowed left ; ; Outputs: ; ; R0 - LBC Ok, LBS syntax error (backwards from normal) ; ;- TWO_NODES: .Word ^m<> ;Ensure a maximum of two nodes given CLRL AREA ;Zap the area number again. MOVL NODES,R0 ;Fetch the index MOVAB PTR_TABLE,R1 ;Address our table MOVQ (R1)[R0],ADDR_PTR ;Set up the pointers for LOOK_* CLRL R0 ;Presume we're Ok SOBGEQ NODES,10$ ;More left? INCL R0 ;No, syntax error. 10$: RET ;Done .Page .Subtitle ZAP_LLC - Invalidate an LLC entry ;+ ; ; ----- ZAP_LLC: Invalidate an LLC entry ; ; ; This routine is called to invalidate an LLC entry due to some ; sort of error. ; ; Inputs: ; ; R9 - Current LLC address ; ; Outputs: ; ; LLC invalidated ; ;- ZAP_LLC: ;Invalidate an LLC entry $DASSGN_S CHAN=LLC$W_CHAN(R9) ;Zap the LLC CLRQ (R9) ;Lose the LLC RSB ;Done .Page .Subtitle COND_HANDLER - Condition handler ;+ ; ; ----- COND_HANDLER: Condition handler ; ; ; This routine is the condition handler for this module. We output an error ; message and exit with status if the error condition was severe. ; ; Inputs: ; ; CHF$L_SIGARGLST(AP) - Signal argument vector address ; CHF$L_MCHARGLST(AP) - Mechanism argument vector address ; ; Outputs: ; ; An error message is output to SYS$OUTPUT and SYS$ERROR using ; $PUTMSG. Image exit will be forced if the error was SEVERE. ; ;- COND_HANDLER: .Word ^m ;Here on a signalled error ; Output the error message. BSBW BLANK_LINE ;Output a blank line MOVL CHF$L_SIGARGLST(AP),R2 ;Address the signal vector SUBL #2,(R2) ;Never mind the PC and PSL $PUTMSG_S MSGVEC=(R2),- ;Output the error code(s) FACNAM=US ;Use our name. BSBW BLANK_LINE ;Output another blank line ; Quit or continue? CMPZV #STS$V_SEVERITY,- ;Is this #STS$S_SEVERITY,- ; a severe CHF$L_SIG_NAME(R2),- ; (fatal) #STS$K_SEVERE ; error? BEQL 10$ ;If EQL yes, force image exit ; Continue ... fix up the saved R0. MOVL CHF$L_MCHARGLST(AP),R2 ;Else continue MOVL #SS$_CONTINUE,R0 ; the previous MOVL R0,CHF$L_MCH_SAVR0(R2) ; thread of RET ; execution ; Quit ... exit with status. 10$: BISL3 #STS$M_INHIB_MSG,- ;Don't output this CHF$L_SIG_NAME(R2),R0 ; message twice $EXIT_S R0 ;Exit with status .End START