Google
 

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