Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-sources/cists.mac
There are 8 other files named cists.mac in the archive. Click here to see a list.
; UPD ID= 62, SNARK:<6.TOOLS-TAPE>CISTS.MAC.13, 23-Jun-84 21:58:09 by CDUNN
;Make the version number show by adding it to .JBVER
;
; UPD ID= 59, SNARK:<6.TOOLS-TAPE>CISTS.MAC.10, 13-Jun-84 21:06:54 by CDUNN
;Fix output of .SBDSP to include only the remote port number
;
; UPD ID= 58, SNARK:<6.TOOLS-TAPE>CISTS.MAC.9, 13-Jun-84 20:57:25 by CDUNN
;Fix SB counting to allow for SBLIST indexed by node number and not SBI.
;
; UPD ID= 51, SNARK:<6.TOOLS-TAPE>CISTS.MAC.8, 2-May-84 00:32:00 by CDUNN
;Be sure to init the symbol counter on startup
;
; UPD ID= 50, SNARK:<6.TOOLS-TAPE>CISTS.MAC.7, 2-May-84 00:25:43 by CDUNN
;Fix don't care output to show the address of connect block on the DC queue.
;
; UPD ID= 49, SNARK:<6.TOOLS-TAPE>CISTS.MAC.6, 1-May-84 14:22:54 by CDUNN
;Add flags and connect ID's to connect block output. Also output a warning
;when symbols require the full monitor search.
;
; UPD ID= 48, SNARK:<6.TOOLS-TAPE>CISTS.MAC.5, 30-Apr-84 15:31:47 by CDUNN
;Fix typeout of "No connect blocks". Also fix AC smashing in OUTSB.
;
; UPD ID= 45, SNARK:<6.TOOLS-TAPE>CISTS.MAC.4, 29-Apr-84 05:12:33 by CDUNN
;Make system block output include connect blocks. The don't care queue
;get connect block output as well...
;
; UPD ID= 44, SNARK:<6.TOOLS-TAPE>CISTS.MAC.3, 29-Apr-84 03:10:31 by CDUNN
;Fix the reset counter for the virgin count case.
;
; UPD ID= 43, SNARK:<6.TOOLS-TAPE>CISTS.MAC.2, 27-Apr-84 18:26:32 by CDUNN
;Major updates to make this a useful tool to ship.
;
;Update to reflect changes in PHYKLP for VC state, etc...
;Add macros for doing text output
;
;SNARK:<CDUNN.SCA>CISTS.MAC.66 17-Apr-83 07:28:18, Edit by CDUNN
;Type out local port number on startup
;
;SNARK:<CDUNN.SCA>CISTS.MAC.60 17-Apr-83 07:14:31, Edit by CDUNN
;Add trafic to date output.
TITLE CISTS -- A hack to get status info about the CI
SUBTTL C. Dunn 17-Apr-83 /CD
SEARCH MONSYM,MACSYM,GLXMAC,JOBDAT
.REQUIRE SYS:MACREL
STDAC. ;Get the monitor standard set of AC defs
SALL
SUBTTL Definitions
VMAJOR=1 ;Major version number
VMINOR=0 ;Minor version number
VEDIT=14 ;Edit number
VWHO==0 ;Last editor (0 = DEC development)
VCISTS==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
LOC .JBVER
VCISTS
RELOC
STKLEN==^D50 ;Lengt of the stack
KLPCHN==7 ;Channel where we find the KLIPA
PTHA==10,,0 ;Status bit for CI path A in .SBVCS
PTHB==20,,0 ;Status bit for CI path B in .SBVCS
.VCCLO==0 ;Port VC is closed (.SBVCS)
.VCSTS==1 ;Start sent
.VCSTR==2 ;Start received
.VCOPN==3 ;Port VC is open (.SBVCS)
MSKSTR IDSNT,PTHSTS,1B0 ;Last ID sent: 0 = Path A, 1 = Path B
MSKSTR IDPA,PTHSTS,1B1 ;Status of path A: 1 = bad
MSKSTR IDPB,PTHSTS,1B2 ;Status of path B: 1 = bad
MSKSTR IDNRA,PTHSTS,1B3 ;Status of response on path A: 1 = No response
MSKSTR IDNRB,PTHSTS,1B4 ;Status of response on path B: 1 = No response
MSKSTR IDTRY,PTHSTS,1B5 ;Last try status: 0 = 1st, 1 = 2nd
MSKSTR IDWFR,PTHSTS,1B6 ;Waiting for response (from our port) to RID
MSKSTR IDNOR,PTHSTS,77B17 ;Count of consecutive no-responses when we
; know the other port is receiving our
; request-ids
DIALEN==^D30 ;Length of DIAG block
; SCA messages types
.STORQ==0 ;Connect request
.STORS==1 ;Connect response
.STARQ==2 ;Accept request
.STARS==3 ;Accept response
.STRRQ==4 ;Reject request
.STRRS==5 ;Reject response
.STDRQ==6 ;Disconnect request
.STDRS==7 ;Disconnect response
.STCRQ==10 ;Credit request
.STCRS==11 ;Credit response
.STAMG==12 ;Application message
.STADG==13 ;Application datagram
.STLST==.STADG+1 ;Highest expected message type number
SUBTTL Definitions -- MACROs
; This macro will output a <CRLF>.
;
DEFINE $CRLF(%1),<
TRNA ;Normal entry, continue
JRST %1 ;We wish to skip this macro, please do so...
HRROI T1,[ASCIZ |
|]
PSOUT
%1:!>
; This macro outputs a line of text with a trailing <CRLF>
;
DEFINE $TYPEC(TEXT,%1),<
TRNA ;Normal entry, go on
JRST %1 ;Desire to skip this, do so
HRROI T1,[ASCIZ |TEXT
|]
PSOUT
%1:!>
; This macro outputs a line of text without the trailing <CRLF>
;
DEFINE $TYPE(TEXT,%1),<
TRNA ;Normal entry, go on
JRST %1 ;Desire to skip this, do so
HRROI T1,[ASCIZ |TEXT|]
PSOUT
%1:!>
; This macro outputs number with given radix, magnitude only.
;
DEFINE $NUMO(NUMADR,RADX,%1),<
TRNA ;Normal entry, go on
JRST %1 ;Desire to skip this macro, do so
MOVE T2,NUMADR ;Get the number to output
MOVX T1,.PRIOU ;Always output to primary JFN
MOVX T3,<NO%MAG!RADX> ;Flags for octal magnitude only please
NOUT% ;Output the number
ERCAL JSYERR ;Handle JSYS failure
%1:!>
; This macro outputs a decimal number with magnitude only.
;
DEFINE $DECNUM(NUMADR),<
$NUMO (NUMADR,<^D10>) ;Output number in octal please
>
; This macro output an octal number, magnitude only.
;
DEFINE $OCTNUM(NUMADR),<
$NUMO (NUMADR,<10>) ;Output decimal number please
>
SUBTTL Macro's -- $SYMTB
; This macro generates a table of symbols whos value is required by the
;system block type out routine (SBDATA).
...CNT==0
DEFINE $SYMTB,<
$ENT (.SBDHT,SCAMPI)
$ENT (.SBDHV,SCAMPI)
$ENT (.SBDSP,SCAMPI)
$ENT (.SBDST,SCAMPI)
$ENT (.SBDSV,SCAMPI)
$ENT (.SBFCB,SCAMPI)
$ENT (.SBLCB,SCAMPI)
$ENT (.SBLMB,PHYKLP)
$ENT (.SBVCS,SCAMPI)
$ENT (.CBSTS,SCAMPI)
$ENT (.CBANB,SCAMPI)
$ENT (.CBAPB,SCAMPI)
$ENT (.CBFLG,SCAMPI)
$ENT (.CBSCI,SCAMPI)
$ENT (.CBDCI,SCAMPI)
$ENT (.CBJNB,SCAMPI)
$ENT (.CBJPB,SCAMPI)
$ENT (.CBSPN,SCAMPI)
$ENT (.CBDPN,SCAMPI)
$ENT (.CBRCD,SCAMPI)
$ENT (.CBPRC,SCAMPI)
$ENT (.CBRQC,SCAMPI)
$ENT (.CBSCD,SCAMPI)
$ENT (.CBPS1,SCSJSY)
$ENT (SBLIST,SCAMPI)
$ENT (C%PNMN,SCSJSY)
$ENT (C%SBLL,SCAMPI)
$ENT (.SBLEN,PHYKLP)
$ENT (RIDSTS,PHYKLP)
$ENT (TOPDC,SCAMPI)
$ENT (BOTDC,SCAMPI)
$ENT (SNDTAB,SCAMPI)
$ENT (RECTAB,SCAMPI)
$ENT (CHNTAB,STG)
$ENT (CDBVER,PHYKLP)
; PURGE ...CNT ;Get rid of useless symbols
>; End $SYMTB definition
DEFINE $ENT(SYM,MODULE),<
SYM: BLOCK 1 ;Generate a cell for the value of SYM
LOC SYMTAB+...CNT+140 ;Relocate to the "symbol table"
RADIX50 0,SYM ;Generate the required symbol
LOC SYMMOD+...CNT+140 ;Relocate to the module table
RADIX50 0,MODULE ;Stash the module we find this symbol in
LOC SYMLOC+...CNT+140 ;Find the symbol address table
SYM ;Addr of cell for storing value of symbol
RELOC ;Return to whence we came
...CNT==...CNT+1 ;Bump the table index
>;End $ENT definition
SUBTTL Entry point
EVEC: JRST CISTS ;Start address
JRST CISTS ;Reentry point
VCISTS ;Version number
CISTS: RESET% ;Reset the world please
MOVE P,[IOWD STKLEN,STK] ;Get the stack set up
; Init the symbols we require
SETZM SLOWF ;Init the symbol counter
MOVX Q1,SYMLEN-1 ;Get the lenth of the "symbol table"
SLOOP: MOVE T1,SYMTAB(Q1) ;Get the desired symbol
MOVE T2,SYMMOD(Q1) ; and the module we will find it
CALL GETSYM ;Get the value of the symbol
MOVEM T1,@SYMLOC(Q1) ;Store its value for later generations
SOJGE Q1,SLOOP ;Loop if there are more symbols to do
SKIPN T4,SLOWF ;Get the number of slow searches
JRST MAIN ;If none, do no output
$TYPE (<% >)
$DECNUM (T4) ;Output the number of symbols gotten slowly
$TYPEC (< symbols required a search of all monitor modules>)
$CRLF
; Symbols in hand, get down to business...
MAIN: CALL KLPINF ;(/) Output info about the KLIPA
$CRLF
CALL SBINF ;Output info about all known system blocks
CALL DCINF ;Output info about the dont care queue
$CRLF
CALL PKTINF ;Output info about packet stats
$CRLF
; CALL PTHINF ;Output path information
; $CRLF
CALL CNTINF ;Output the port counters
$CRLF
EXIT: HALTF ;All done...
SUBTTL Info routines -- CNTINF (Output the port counters)
; Routine to play with the port counters. If the counters are not currently
;owned or set, this routine will set them to watch all nodes.
;
; Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
CNTINF: MOVX T1,<XWD -DIALEN,DIABLK> ;Space for returning DIAG info
MOVX T2,<.DGRDC> ;Channel we wish for KLIPA,,read function
HRRM T2,DIABLK+1 ;Store, we need a symbol for this
DIAG% ;Read the port counters
ERCAL JSYERR ;Handle a JSYS failure
; Indicate the counter reset count
$TYPE (<The port counters have >)
HLRE T2,DIABLK+.DGPVL ;Get the monotonic counter
CAMN T2,[-1] ;Are the counters virgin???
IFNSK.
$TYPEC (<not been reset since system startup.>)
ELSE.
$TYPE (<been reset >)
ADDI T2,1 ;Convert from monotonic counter to actual count
$DECNUM (T2) ;Output the counter reset count
$TYPEC (< times.>) ;Finish the text
ENDIF.
; Test the designated node. If it is anything but ^D255 see if they are owned.
;If they are not owned, get them, reset them to record all data for all nodes,
;and release them...
MOVE T1,DIABLK+.DGPTG ;Get the taget node number
LSH T1,-4 ;Right justify the node number
MOVE T2,DIABLK+.DGPVL ;Get the counter and fork owner
CAIN T1,^D255 ;Are the counters set for all nodes???
CAMN T2,[-1] ; or are the counters virgin???
CALL CNTSET ;Counters need to be set, see if we can
; Counters are set for all nodes and are not virgin. Just read them
;and report the contents.
; Show recording mode
$CRLF
$TYPEC (<Port counters are set to record for all nodes.>)
MOVX T1,<XWD -DIALEN,DIABLK> ;Point o the DIAG block
MOVX T2,<.DGRDC> ;Read counter function
HRRM T2,DIABLK+1 ;Store counter function
DIAG% ;Read the port counters
ERCAL JSYERR ;Handle JSYS failure
; Show counter ownership
HRRE T2,DIABLK+.DGPVL ;Get the owning fork number
$TYPE (<Counters are>)
CAME T2,[-1] ;Are the counters owned???
IFNSK.
$TYPE (< owned by fork >)
$OCTNUM (T2) ;Output the fork number
$CRLF
ELSE.
$TYPEC (< unowned>)
ENDIF.
; Show the counts themselves
MOVEI T4,DIABLK ;Setup base address of DIAG args
$CRLF
$TYPE (<Path A Acks: >)
$DECNUM (<.DGP0A(T4)>) ;Output the Path A ACK count
$CRLF
$TYPE (< Naks: >)
$DECNUM (<.DGP0N(T4)>) ;Output the Path A NAK count
$CRLF
$TYPE (< No responses: >)
$DECNUM (<.DGP0R(T4)>) ;Output the Path A No response count
$CRLF
$CRLF
$TYPE (<Path B Acks: >)
$DECNUM (<.DGP1A(T4)>) ;Output Path B ACK count
$CRLF
$TYPE (< Naks: >)
$DECNUM (<.DGP1N(T4)>) ;Output Path B NAK count
$CRLF
$TYPE (< No responses: >)
$DECNUM (<.DGP1R(T4)>) ;Output the Path B No response count
$CRLF
$CRLF
$TYPE (<Total packets received: >)
$DECNUM (<.DGPRC(T4)>) ;Output total packets received count
$CRLF
$TYPE (<Total packets transmitted: >)
$DECNUM (<.DGPXC(T4)>) ;Output the total xmit packet count
$CRLF
$TYPE (<Total number of datagrams discarded: >)
$DECNUM (<.DGPDD(T4)>) ;Output number of discarded datagrams
$CRLF
RET ;All done
SUBTTL Info routines -- PTHINF (Output path information)
; Routine to output information about all of the paths known to man.
;
; Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
; ERCAL to JSYERR on internal failure
;
PTHINF: $TYPEC (Status of all known paths:)
SETO Q1, ;Start with node zero
PTHLOP: AOS Q1 ;Try the next node number
CAMLE Q1,C%SBLL ;Still in range of reasonable node???
RET ;No, all done
CAMN Q1,LCLPRT ;Are we doing a path to ourselves???
JRST PTHLOP ;Yes, ignore it...
$TYPE (Node ) ;Text for ptompting output
$DECNUM (Q1) ;Output the node number
$TYPEC (<:>) ;Now output a : please
$TYPE (Last path for REQUEST-ID: )
LOAD T2,IDSNT,(Q1) ;Get the last path for RID
HRROI T1,[ASCIZ |Path A
|] ;Assume Path A
SKIPN T2 ;Was it path A???
HRROI T1,[ASCIZ |Path B
|] ;Nope, get text for path B
PSOUT ;Output last path for RID
$TYPE (Path status: Path A -- )
LOAD T2,IDPA,(Q1) ;Get the status of path A
SKIPE T2 ;Is the path good???
$TYPEC (bad) ;Nope, say so
SKIPN T2 ;Is the path bad???
$TYPEC (good) ;Nope, say so...
$TYPE ( Path B -- )
LOAD T2,IDPB,(Q1) ;Load status of path B
SKIPN T2 ;Is path B available???
$TYPEC (good) ;Yes, say so
SKIPE T2 ;Is path B down???
$TYPEC (bad) ;Yes, say so...
$TYPE (ID Response status: Path A -- )
LOAD T2,IDNRA,(Q1) ;Get the ID rec status for Path A
SKIPN T2 ;Has there been a response here???
$TYPEC (Response available)
SKIPE T2 ;Is there no response here???
$TYPEC (No response)
$TYPE ( Path B -- )
LOAD T2,IDNRB,(Q1) ;Get the response status on path B
SKIPN T2 ;Is a response available???
$TYPEC (Response available)
SKIPE T2 ;Is a response not available
$TYPEC (No response)
$TYPE (Status of ID attempt: )
LOAD T2,IDTRY,(Q1) ;Get the status of the ID attempts
SKIPN T2 ;Is this the first try???
$TYPEC (First try)
SKIPE T2 ;Is this the second try???
$TYPEC (Second try)
LOAD T2,IDWFR,(Q1) ;Get waiting status for local port
SKIPE T2 ;Are we waiting for a response from this node??
$TYPEC (** Awaiting response to REQUEST-ID **)
SKIPN T2 ;Are we not waiting for REQ-ID response
$TYPEC (There are no REQUEST-ID's outstanding)
$TYPE (Count of consecutive NO-RESPONSEs after opening VC: )
LOAD T2,IDNOR,(Q1) ;Get the count we advertised
$DECNUM (T2) ;Output the count
$CRLF ;Type a <CRLF> and continue
$CRLF
JRST PTHLOP ;Loop for the rest of the paths
RET ;All done
SUBTTL Info routines -- PKTINF (Output info about packet stats)
; Routine to output pertinant information about packet statistics...
;
;Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
; ERCAL JSYERR on failure
;
PKTINF: $TYPEC (<Traffic to date:>)
MOVX T1,.STLST ;Move whole send table please
XMOVEI T2,SNTAB ;Move to local SNDTAB
MOVE T3,SNDTAB ;Where to get the monitor data
CALL GETWDS ;Move the data please
MOVX T1,.STLST ;Move whole stats table
XMOVEI T2,RETAB ; into local copy pls...
MOVE T3,RECTAB ;Get data from monitor pkt rcv table
CALL GETWDS ;Move the monitor data
SETZ Q1, ;Start with message type zero
MSGLOP: HRRO T1,MSGTYP(Q1) ;Point to message type text
PSOUT ;Output the message type
$TYPE (<s: >)
$DECNUM (<SNTAB(Q1)>) ;Output the stats for this message type
$TYPE (< sent >)
MOVEI T1," " ;Get a TAB
CAIGE T2,^D10 ;Output too many digits for this # of tabs?
PBOUT ;No, output the extra tab
HRRO T1,MSGTYP+1(Q1) ;Now point to the response type
PSOUT ;Output the name
$TYPE (<s: >) ;Some delimiter
$DECNUM (<SNTAB+1(Q1)>) ;Output the number of responses
$TYPEC (< sent>)
$TYPE (< >) ;Set up for receive stats on request type
$DECNUM (<RETAB(Q1)>) ;Get the receive stats
$TYPE (< received >)
MOVE T2,RETAB(Q1) ;Get the response stat
CAIG T2,^D99999 ;Is it greater than 5 digits long???
IFNSK.
$TYPE (< >) ;No, give lots of extra room
ELSE.
$TYPE (< >) ;Yes, give less room
ENDIF.
$DECNUM (<RETAB+1(Q1)>);Get the receive stats for response type
$TYPEC (< received>)
$CRLF
MOVEI Q1,2(Q1) ;Try for the next message type
CAIGE Q1,.STLST ;Have we overextended ourselves???
JRST MSGLOP ;Yep, exit now pls...
RET ;All done
SUBTTL Info routines -- DCINF (Output info about the DC queue)
; Routine to output pertinant info about the dont care queue.
;
;Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
; ERCAL to JSYERR on internal failure
;
DCINF: MOVX T1,1 ;Only one word please
XMOVEI T2,TPDC ;Store in local user memory here pls...
MOVE T3,TOPDC ;Where to get the monitor data
CALL GETWDS ;Fetch the monitor data please
MOVX T1,1 ;Only one word please
XMOVEI T2,BTDC ;Store in local user memory here pls...
MOVE T3,BOTDC ;Where to get the monitor data
CALL GETWDS ;Fetch the monitor data please
$CRLF
$TYPEC (<The don't care queue:>)
$TYPE (<(TOPDC) >)
MOVE T1,TPDC ;Get the PC to be output
CALL OUTPC ;Output the PC please
$CRLF
$TYPE (<(BOTDC) >)
HRRZ T1,BTDC ;Get the insection address part of DC Q BLINK
CAMN T1,TOPDC ;Is it really a pointer to the FLINK???
IFNSK.
$TYPE (<1,,TOPDC>) ;Yes, output in symbolic instead
ELSE.
MOVE T1,BTDC ;No, get the PC of the last thing on the Q
CALL OUTPC ;Output the PC please
ENDIF.
$CRLF
; Now display the connect blocks on the queue
SKIPN P1,TPDC ;Are there any blocks to display???
RET ;No, all done
SETO Q1, ;Fudge so we start at zero
$CRLF
DCLOP: $TYPE (< CB>)
AOS T1,Q1 ;Increment the CB count
ADDI T1,"0" ;Show which CB
PBOUT ; this is
$TYPE (<: >)
MOVE T1,P1 ;Get the address of this connect block
CALL OUTPC ;Output the address of the connect block
$CRLF
CALL OUTCB ;Output info on this CB please
MOVE P1,.CBANB ;Index for next connect block
SKIPN P1,CB(P1) ;Is there a next CB???
RET ;No, all done
$CRLF
$TYPEC (< - - - - - ->)
$CRLF
JRST DCLOP ;Loop for more connection blocks
SUBTTL Info routines -- KLPINF (Output KLIPA class info)
; This routine outputs the opening header information about the KLIPA
;
; Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
KLPINF: MOVX T1,1 ;We want only one word pls...
XMOVEI T2,CDBADR ;Where to store the data
MOVE T3,CHNTAB ;Get the base address of monitor channel table
ADDI T3,KLPCHN ;Offset CHNTAB to KLIPA entry
CALL GETWDS ;Get the data from the monitor please
SKIPN CDBADR ;Is there a CDB for the KLIPA???
JRST NOKLP ;No, stop now
MOVEI T1,.SSGLN ;SCS% function for get local node number
XMOVEI T2,SCSBLK ;Get the address of the diag block
MOVX T3,.LBGLN ;Length of the block
MOVEM T3,SCSBLK+.SQLEN ;Store in arg block
SCS% ;Get the local node number
ERCAL JSYERR ;Handle bad JSYS calls
MOVE T1,SCSBLK+.SQLNN ;Retrieve the node number
MOVEM T1,LCLPRT ;Store for later generations
$TYPE (<[Local port number: >)
$DECNUM (LCLPRT) ;Output the local node number
MOVX T1,1 ;We only want one word
XMOVEI T2,UCVER ;Place it in the cell for microcode version
MOVE T3,CDBADR ;Get the base address of the KLIPA CDB
ADD T3,CDBVER ;Calculate final address to be XPEEKed
CALL GETWDS ;Get microcode version from the monitor
$TYPE (<, running KLIPA microcode version >)
$OCTNUM (UCVER) ;Output the microcode version number
$TYPE (<]>)
RET ;All done
SUBTTL Info routines -- SBINF (Output system block info)
; This routine types information about all known system blocks
;
; Usage:
; Call
; No arguments
;
; Return (+1)
; No data returned
;
SBINF:
; Setup the path status info needed for all system blocks
MOVE T1,C%SBLL ;For all nodes please
XMOVEI T2,PTHSTS ;My status table
MOVE T3,RIDSTS ;Monitor address of the table
CALL GETWDS ;Retrieve monitor data on path ststus
; Say how many blocks are built
MOVE T1,C%SBLL ;Get the whole of SBLIST
XMOVEI T2,SBL ;Put SBLIST here please
MOVE T3,SBLIST ;Where to get the monitor data
CALL GETWDS ;Retrieve SBLIST from the monitor
MOVE T1,C%SBLL ;Get the number of iterations
SETZ T2, ;Start with the first SB entry
SKIPE SBL(T1) ;Is there an entry here???
AOS T2 ;Yes, count it
SOJG T1,.-2 ;Loop if there are more entries to scan
$TYPE (<[There are >)
$DECNUM (T2) ;Output the number of system blocks
$TYPEC (< system blocks currently built]>)
JUMPE T2,R ;If there are no SB's, we have nothing to do
; Now loop over all the system blocks
$CRLF
SETZ Q1, ;Start with system block zero
SBLOP: MOVE T1,Q1 ;Move the desired SBI
CALL OUTSB ;Type out info about this system block
AOS Q1 ;Increment the SB index
CAMLE Q1,C%SBLL ;Are we at the end of our rope???
RET ;All done
JRST SBLOP ;No, loop for more system blocks
SUBTTL Support routines -- CNTSET (Try to set the port counters)
; This routine attempts to set the port counters. It will give up if another
;fork already owns the counters. I.E. the force release function is not done.
;
; Usage:
; Call
; No arguments
;
; Return (+1) Always
; No data returned
;
CNTSET: $TYPE (<Attempting to set port counters to collect for all nodes>)
MOVX T1,<XWD -DIALEN,DIABLK> ;Point to the diag block
MOVX T2,.DGRDC ;DIAG read port counters subfunction
HRRM T2,DIABLK+1 ;Store as an arg
DIAG% ;Read the port counters
ERCAL JSYERR ;Handle JSYS failure
HRRE T2,DIABLK+.DGPVL ;Get the owning fork number
CAMN T2,[-1] ;Are the counters unowned???
JRST OKSET ;No, go get them
$CRLF
$TYPE (<%Port counters already owned by fork >)
$OCTNUM (T2) ;Output owning fork
$TYPEC (<, counter set function aborted>)
RET ;No, someone already has them
; We can get the counters, do so and set them.
OKSET: MOVX T1,<XWD -DIALEN,DIABLK>
MOVX T2,.DGGTC ;Get counters sub-function
HRRM T2,DIABLK+1 ;Store in argblock
DIAG% ;Get the counters
ERCAL JSYERR ;Handle JSYS failure
MOVX T2,.DGPTC ;Point and clear subfunction
HRRM T2,DIABLK+1 ;Store in DIAG block
SETOM DIABLK+2 ;Set counters to clear all and watch all
MOVX T2,^D255 ;Node number for watching all nodes
MOVEM T2,DIABLK+3 ;Store as arg
DIAG% ;Set the port counters
ERCAL JSYERR ;Handle JSYS failure
MOVX T2,.DGGVC ;Release counters sub-function
HRRM T2,DIABLK+1 ;Store
SETZM DIABLK+2 ;We dont need the force release function
DIAG% ;Release the counters
ERCAL JSYERR ;Handle JSYS failure
$TYPEC (< [OK]>) ;Say we succeeded
RET ;All done
SUBTTL Support routines -- GETWDS (Get words out of the monitor)
; This routine gets a block of data from the monitor.
;
; Usage:
; Call
; T1/ Length of block
; T2/ Address in user space
; T3/ Address in monitor space
;
; Return (+1) Always
; Data block moved
;
; ERCAL to JSYERR on internal failure
;
GETWDS: MOVEM T1,XPKBLK+.XPCN1 ;Store the length of the block
MOVEM T2,XPKBLK+.XPUAD ; and the addr to store in user space
MOVEM T3,XPKBLK+.XPMAD ; and the monitor space to read from
XMOVEI T1,XPKBLK ;Point to the block
XPEEK% ;Get the data from te monitor
ERCAL JSYERR ;Handle JSYS badness
RET ;All done
SUBTTL Support routines -- OUTSB (Output information from an SB)
; This routine outputs the pertinant information in a system block.
;
; Usage:
; Call
; T1/ System block index
;
; Return (+1) Always
; No data returned
;
; ERCAL to JSYERR on internal failure
;
OUTSB: SAVEAC <Q1,P1>
MOVE Q1,T1 ;Save the SBI we want
SKIPN SBL(Q1) ;Is there an entry here???
RET ;No, nothing to do then...
MOVE T1,.SBLEN ;Move all the words in this SB
XMOVEI T2,SB ;Place it in my user mode space for an SB
MOVE T3,SBL(Q1) ;Get the address of the system block
CALL GETWDS ;Get the whole system block
; Indicate which block this is
$CRLF
$TYPE (<Node >)
$DECNUM (Q1) ;Output the node number
$TYPE (<: >)
MOVE T1,SBL(Q1) ;Get the PC of this system block
CALL OUTPC ;Output the PC please
$CRLF
; Output remote port number
$TYPE (<(.SBDSP) Remote port number: >)
MOVE T2,.SBDSP ;Get the index for port number
HRRZ T2,SB(T2) ;Now for the port number itself
$DECNUM (T2) ;Output destination port number
$CRLF
; Virtual circuit state
$TYPE (<(.SBVCS) Port to port circuit state:>)
MOVE T2,.SBVCS ;Index to state info
HRRZ T2,SB(T2) ;Get just the circuit state info
HRROI T1,[ASCIZ | unknown|] ;Cover states we dont understand
CAIN T2,.VCOPN ;Is the circuit open???
HRROI T1,[ASCIZ | open|] ;Yes, use correct text
CAIN T2,.VCSTS ;Start sent???
HRROI T1,[ASCIZ | START sent|] ;Yes, use correct text
CAIN T2,.VCSTR ;Start received???
HRROI T1,[ASCIZ | START received|] ;Yes, use the correct text
CAIN T2,.VCCLO ;Or is it just plain closed
HRROI T1,[ASCIZ | closed|] ;Dead VC, use correct text
PSOUT ;Output the circuit state
$CRLF
; Path states
$TYPEC (< Path states:>)
$TYPE (< Path A: >)
LOAD T2,IDPA,(Q1) ;Get the status of path A
SKIPN T2 ;Is the path good???
$TYPEC (good)
SKIPE T2 ;Is the path bad???
$TYPEC (bad)
$TYPE ( Path B: )
LOAD T2,IDPB,(Q1) ;Get the path state for path B
SKIPN T2 ;Is the path good???
$TYPEC (good)
SKIPE T2 ;Is the path bad???
$TYPEC (bad)
; State of local message buffer
$TYPE (<(.SBLMB) Local host has >)
MOVE T2,.SBLMB ;Index for local msg buf
SKIPN T2,SB(T2) ;Are we waiting for a message???
IFNSK.
$TYPE (<no SCA packets outstanding>)
ELSE.
$TYPE (<SCA packet(s) outstanding>)
ENDIF.
; Info on connect blocks hanging off this system block
CBTST: MOVE T2,.SBFCB
SKIPN T2,SB(T2) ;Are there CB's hanging on this SB???
IFNSK.
$CRLF
$TYPE (<(.SBFCB) There are no connection blocks>)
JRST HARDW ;Go do hardware stuff...
ENDIF.
$CRLF
$TYPE (<(.SBFCB) >)
MOVE T1,.SBFCB ;Index for first CB
MOVE T1,SB(T1) ;PC of first CB
CALL OUTPC ;Output the PC
$CRLF
$TYPE (<(.SBLCB) >)
MOVE T1,.SBLCB
MOVE T1,SB(T1) ;Section number for BLINK
CALL OUTPC ;Output the PC
; Configuration info about this remote host. First the remote hardware type.
HARDW: $CRLF
$TYPE (<(.SBDHT) Remote hardware type:>)
MOVX T1,4 ;Number of allowable bytes
MOVE P5,.SBDHT
MOVX T2,<POINT 8,SB(P5)> ;Byte pointer to hard type string
CALL OUT8BA ;Output the 8 bit ASCII string
$CRLF
; Hardware version
$TYPE (<(.SBDHV) Destination hardware version:>)
MOVE T2,.SBDHV ;Index for hardware version
MOVE T2,SB(T2) ;Get the version number to output
$OCTNUM (T2) ;Output the version number
$CRLF
; Remote software type
SOFTT: $TYPE (<(.SBDST) Software type:>)
MOVX T1,4 ;Max number of characters
MOVE P5,.SBDST
MOVX T2,<POINT 8,SB(P5)> ;Byte pointer to type string
CALL OUT8BA ;Output the software type string
$CRLF
; Remote software version
SOFTV: $TYPE (<(.SBDSV) Software version:>)
MOVX T1,4 ;Max number of characters
MOVE P5,.SBDSV ;Index for software version
MOVX T2,<POINT 8,SB(P5)> ;Byte pointer to type string
CALL OUT8BA ;Output the software version (an 8 bit string!)
$CRLF
; Now for the connect block chain.
SETO Q1, ;Fudge to get us to CB0 the first time out
MOVE P1,.SBFCB ;Index for the
SKIPN P1,SB(P1) ;Now the address of the first connect block
RET ;All done if there are no connect blocks
$CRLF
CBLOP: $TYPE (< CB>)
AOS T1,Q1 ;Increment and fetch the relative CB number
ADDI T1,"0" ;Make it the character for output
PBOUT ;Output the relative CB number
$TYPE (<: >)
MOVE T1,P1 ;Get the address of this CB
CALL OUTPC ;Output said PC
CALL OUTCB ;Else output info about the connect block.
MOVE T1,.CBANB ;Offset to next CB
SKIPN P1,CB(T1) ;Is there a next connect block???
IFNSK.
$CRLF
RET ;No, all done
ENDIF.
$CRLF
$TYPEC (< - - - - - ->)
$CRLF
JRST CBLOP ;Loop for the next CB
SUBTTL Support routines -- OUTCB (Output the pertinant info in a CB)
; This routine outputs the pertinant information in a connect block.
;
; Usage:
; Call
; P1/ Monitor address of a connect block
;
; Return (+1) Always
; P1/ Monitor address of a connect block
; CB/ Contents of the inticated connect block
;
; ERCAL to JSYERR on internal failure
;
OUTCB: MOVE T1,.CBPS1 ;Fudge for monitor
AOS T1 ; not referanceing .CBLEN (Length of CB)
XMOVEI T2,CB ;Where we want it in user space
MOVE T3,P1 ;Now the monitor address of the connect block
CALL GETWDS ;Get the contents of the connect block please
$CRLF
; Show pointers to other connect blocks
$TYPE (< Pointer to next connect block: >)
MOVE T1,.CBANB ;Index to next CB address
MOVE T1,CB(T1) ;Get address of next connect block
CALL OUTPC ;Output the PC of the next connect block
$CRLF
$TYPE (< Pointer to previous connect block: >)
MOVE T1,.CBAPB ;Index to previous CB address
MOVE T1,CB(T1) ;Get said value
CALL OUTPC ;Output the PC of the previous CB
$CRLF
$TYPE (< Pointer to next JSYS connect block: >)
MOVE T1,.CBJNB ;Index to next JSYS connect block address
MOVE T1,CB(T1) ;Get said address
CALL OUTPC ;Output the address of the next JSYS CB
$CRLF
$TYPE (< Pointer to previous JSYS connect block: >)
MOVE T1,.CBJPB ;Index to previous JSYS connect block
MOVE T1,CB(T1) ;Get the address of the previous JSYS CB
CALL OUTPC ;Output it please
$CRLF
; Show the connect ID's
$CRLF
$TYPE (< Source connect ID: >)
MOVE T1,.CBSCI ;Index to the source connect ID
MOVE T1,CB(T1) ;Fetch the connect ID's
CALL OUTHAF ;Output in halfword format
$CRLF
$TYPE (< Destination connect ID: >)
MOVE T1,.CBDCI ;Index to the destination connect ID
MOVE T1,CB(T1) ;Fetch the ID
CALL OUTHAF ;Output in halfword format
$CRLF
; Show the state of the connection
$CRLF
$TYPE (< Connection state: >)
MOVE T1,.CBSTS ;Index to the state
HRRZ T1,CB(T1) ;Get the state of the block
HRRO T1,STSTAB(T1) ;Point to status string
PSOUT ;Show the connection state
$CRLF
$TYPE (< Block state: >)
MOVE T2,.CBSTS ;Index to status info
HLRZ T2,CB(T2) ;Get the block state
$OCTNUM (T2) ;Output the block state
$CRLF
; Show the flags
$TYPE (< Flags: >)
MOVE T1,.CBFLG ;Index to the flags
MOVE T1,CB(T1) ;Fetch said flags
CALL OUTHAF ;Output in halfword format
$CRLF
; Show the process names
$CRLF
$TYPE (< Source process name: >)
MOVE T1,C%PNMN ;Max length of the string
XMOVEI P5,CB ;Get the base address of the connect block
ADD P5,.CBSPN ;Add in the index to the source name
MOVX T2,<POINT 8,(P5)> ;Byte pointer to source process name
CALL OUT8BA ;Output the source process name
$CRLF
$TYPE (< Destination process name: >)
MOVE T1,C%PNMN ;Max length of the string
XMOVEI P5,CB ;Base address of the connect block
ADD P5,.CBDPN ;Now the destination process name
MOVX T2,<POINT 8,(P5)> ;Byte pointe to the process name
CALL OUT8BA ;Output the process name
$CRLF
; Now the credit levels.
$CRLF
$TYPE (< Send credit: >)
MOVE T2,.CBSCD ;Index to send credit
$DECNUM (<CB(T2)>) ;Output the send credit
$CRLF
$TYPE (< Receive credit: >)
MOVE T2,.CBRCD ;Index to receive credit
$DECNUM (<CB(T2)>) ;Output the receive credit
$CRLF
$TYPE (< Pending receive credit: >)
MOVE T2,.CBPRC ;Index to pending receive credit
$DECNUM (<CB(T2)>) ;Output the pending receive credit
$CRLF
$TYPE (< Requeue credit: >)
MOVE T2,.CBRQC ;Index to requeue credit
$DECNUM (<CB(T2)>) ;Output the requeue credit
$CRLF
RET ;All done
SUBTTL Support routines -- OUTHAF (Output octal number in halfwords)
; This routines outputs an octal number in halfword format.
;
; Usage:
; Call
; T1/ Number to be output
;
; Return (+1) Always
; T1/ Number output
;
; ERCAL to JSYERR on internal failure
;
OUTHAF: STKVAR <NUM>
MOVEM T1,NUM ;Save the called argument
HLRZS T1 ;Get just the left half
$OCTNUM (T1) ;Output the left half
$TYPE (<,,>) ;Left half,,righ half
HRRZ T1,NUM ;Get the right half to be output
$OCTNUM (T1) ;Output the right half
RET ;All done
SUBTTL Support routines -- GETSYM (Get symbol value from the monitor)
; This routine gets the value of a symbol from the monitor. The module to
;search may be provided. If the module search fails a monitor wide search is
;attempted.
;
; Usage:
; Call
; T1/ Symbol who's value is desired
; T2/ Module to search (in RADIX50)
;
; Return (+1) Always
; T1/ Value of the symbol
;
; ERCAL to JSYERR on internal failure
;
GETSYM: STKVAR <SYM>
MOVEM T1,SYM ;Save the symbol we are looking for
MOVE T3,T2 ;Get the module to search
MOVE T2,T1 ;Get the symbol to look for
MOVX T1,.SNPSY ;Snoop function for getting a symbol
SNOOP% ;Find the value of the symbol please
ERJMP SYMFAL ;Failed, if failure is no sym, try whole monitr
MOVE T1,T2 ;Setup the value where promised
RET ;All done
; Here when we fail to get the desired symbol. If the error is no such symbol,
;try the entire monitor. If this fails, halt...
SYMFAL: CAIE T1,SNOP14 ;Was the error "No such symbol"???
CALL JSYERR ;No, cause a JSYS failure
MOVX T1,.SNPSY ;Yes, try again, function for finding symbols
MOVE T2,SYM ;Get the symbol again
SETZ T3, ;No module this time
SNOOP% ;Find the symbol please
ERCAL JSYERR ;No luck, fail this time
AOS SLOWF ;Increment the count of slow fetchs
MOVE T1,T2 ;Worked! Slow, but at least it worked...
RET ;Return ok...
ENDSV.
SUBTTL Support routines -- OUTPC (Output a PC)
; This routine outputs a PC.
;
; Usage:
; Call
; T1/ 30 bit PC
;
; Return (+1) Always
; T1/ 30 bit PC
;
; ERCAL to JSYERR on internal failure
;
OUTPC: STKVAR <PC>
MOVEM T1,PC ;Save the PC
HLRZ T2,T1 ;Get the section number
JUMPE T2,PCRH ;If no section do no output yet
$OCTNUM (T2) ;Output the section number
$TYPE (<,,>) ;Section,,PC
PCRH: MOVX T1,.PRIOU ;Say its going to the TTY
HRRZ T2,PC ;Get the in-section address
MOVX T3,<NO%MAG!NO%LFL!NO%ZRO!<6B17>!^O10> ;PC style output pls...
NOUT% ;Output the in section address pls...
ERCAL JSYERR ;Handle the output failure
RET ;All done
ENDSV.
SUBTTL Support routines -- OUT8BA (Output an 8 bit ASCII string)
; This routine will output an 8 bit ASCII string
;
; Usage:
; Call
; T1/ Max length of the string
; T2/ Byte pointer to the string to be output (to the terminal)
;
; Return (+1) Always
; No data returned
;
; Will ERCAL to JSYERR on internal failure
;
OUT8BA: MOVE T3,T1 ;Use T1 for the bytes we output
OUTLOP: ILDB T1,T2 ;Get a byte
JUMPE T1,R ;End on a null byte
PBOUT ;Else output the byte
SOJG T3,OUTLOP ;Loop for more chars if we allow more
RET ;All done
SUBTTL Support routines -- R (Common label for returning)
R: RET
SUBTTL Error handlers
SUBTTL Error handlers -- Handle having no KLIPA (NOKLP)
NOKLP: $TYPEC (<?No CHNTAB entry for KLIPA channel>)
HALTF
SUBTTL Error handlers -- Fatal JSYS errors (JSYERR)
; This routine handles fatal JSYS errors.
;
JSYERR: HRROI T1,JERTXT ;Point to start of error text
PSOUT ;Start reporting of error
MOVX T1,.PRIOU ;Output error to terminal
HRRZ T2,(P) ;Get the in section part of the address
SUBI T2,2 ;Point to addr of failing JSYS
MOVX T3,<NO%MAG!NO%LFL!NO%ZRO!<6B17>!^O10> ;Nout output format bits
NOUT% ;Output insection part of the address
ERJMP ERRERR ;Handle an error within an error
HRROI T1,CRLF ;Point to standard CRLF string
PSOUT ;Output pls...
MOVX T1,"?" ;Now the start of the error string
PBOUT ;Output this as well
MOVX T1,.PRIOU ;Output error string to TTY
MOVX T2,<XWD .FHSLF,-1> ;My last error please
SETZ T3, ;No max on string length
ERSTR ;Output error string
ERJMP ERRERR ;Error within an error?
ERJMP ERRERR ;. . .
HRROI T1,CRLF ;Point to the CRLF
PSOUT ;Output it
HALTF ;Die here...
SUBTTL Error handlers -- Error within an error (ERRERR)
; This routine handles an error within an error.
;
ERRERR: HRROI T1,FATTXT ;Point to the appropriate text
PSOUT ;Say why we are about to die
HALTF ; die...
SUBTTL Storage
DIABLK: .DGCTR ;Always the diag port counter function
XWD KLPCHN,0 ;Always on the KLIPA channel
BLOCK DIALEN-2 ;Save space for DIAG port counter stuff
LCLPRT: BLOCK 1 ;Local port number stored here
SNTAB: BLOCK .STLST ;Block for sent message type output
RETAB: BLOCK .STLST ;Block for received message type output
TPDC: BLOCK 1 ;A place for the top of the DC queue
BTDC: BLOCK 1 ; nd his friend the DC Q bottom pointer
CDBADR: BLOCK 1 ;Address of the CDB in monitor space
UCVER: BLOCK 1 ;Loc for the KLIPA microcode version
SBLEN: BLOCK 1 ;Length of a system block
STK: BLOCK STKLEN ;Keep the stack here
MSGTYP: $BUILD (.STLST)
$SET (.STORQ,<>,<[ASCIZ |Connec request|]>)
$SET (.STORS,<>,<[ASCIZ |Connec response|]>)
$SET (.STARQ,<>,<[ASCIZ |Accept request|]>)
$SET (.STARS,<>,<[ASCIZ |Accept response|]>)
$SET (.STRRQ,<>,<[ASCIZ |Reject request|]>)
$SET (.STRRS,<>,<[ASCIZ |Reject response|]>)
$SET (.STDRQ,<>,<[ASCIZ |Discon request|]>)
$SET (.STDRS,<>,<[ASCIZ |Discon response|]>)
$SET (.STCRQ,<>,<[ASCIZ |Credit request|]>)
$SET (.STCRS,<>,<[ASCIZ |Credit response|]>)
$SET (.STAMG,<>,<[ASCIZ |Applic message|]>)
$SET (.STADG,<>,<[ASCIZ |Applic datagram|]>)
$EOB
STSTAB: $BUILD (SQ%HIS+1)
$SET (SQ%CLO,<>,<[ASCIZ |Closed|]>)
$SET (SQ%LIS,<>,<[ASCIZ |Listening|]>)
$SET (SQ%CSE,<>,<[ASCIZ |Connect sent|]>)
$SET (SQ%CRE,<>,<[ASCIZ |Connect received|]>)
$SET (SQ%CAK,<>,<[ASCIZ |Connect Acknoledged|]>)
$SET (SQ%ACS,<>,<[ASCIZ |Accept sent|]>)
$SET (SQ%RJS,<>,<[ASCIZ |Reject sent|]>)
$SET (SQ%OPN,<>,<[ASCIZ |Open|]>)
$SET (SQ%DSE,<>,<[ASCIZ |Disconnect sent|]>)
$SET (SQ%DRE,<>,<[ASCIZ |Disconnect received|]>)
$SET (SQ%DAK,<>,<[ASCIZ |Disconnect acknoledged|]>)
$SET (SQ%DMC,<>,<[ASCIZ |Disconnect match|]>)
$EOB
CRLF: ASCIZ |
|
JERTXT: ASCIZ |?JSYS failure at PC:|
FATTXT: ASCIZ |?Error within an error
|
SYMTAB: BLOCK 1000 ;Leave room for lots of symbols
SYMLOC: BLOCK 1000 ; their values,
SYMMOD: BLOCK 1000 ; and the modules they live in
SYMVAL: $SYMTB ;Generate the required symbols table
SYMLEN==.-SYMVAL ;Length of the required symbols table
SLOWF: BLOCK 1 ;Number of symbols found on long search
XPKBLK: .XPUAD+1 ;Length of XPEEK% block
.XPPEK ;Allways the peek function
BLOCK <.XPUAD-.XPCN1>+1 ;Reserve the rest of the XPEEK block
SCSBLK: BLOCK .SQLPN+1 ;Reserve an SCS% block
.PSECT DATSTR/OVERL,400K ;Put this out of the way
CB: BLOCK 1000 ;A page for a CB pls...
SB: BLOCK 1000 ; and a page for an SB
PTHSTS: BLOCK 1000 ; and a page for path status
SBL: BLOCK 100 ;Leave room for the data in SBLIST
.ENDPS DATSTR
END EVEC