.TITLE	OPA - ONLINE POOL ANALYZER

	.IDENT	/JN3SLL/
	.ENABL	LC		;ALLOW LOWER-CASE I/O AND LISTING

; WRITTEN BY J. NEELAND
;
;MODIFIED 801021. BY DANIEL STEINBERG -- RECOVER FROM ODD ADDR. TRAPS BETTER
;				BY USING THREADED ROUTINE LIST
;MODIFIED 801102. BY J. NEELAND TO HANDLE FUNNY INTRP. VECTORS (DECNET)
; 				BETTER, ALSO IMPROVE OCB HANDLING
;
;MODIFIED 801209  BY SNLL	VIRTUAL DISK CODE ADDED (FROM CPA)
;				ALLOW USER TO DEFINE HIS OWN FILL CHARACTERS
;				 MORE EASILY
;
;MODIFIED 20-SEP-82  BY SNLL	For RSX11M-V4.0
;				   Increase Pool buffer to 12. K words 
;				   Increase size of TCB & VCB
;				   Add Volume Set Control Block for Mag-Tape
;				   Add CLI Parser Blocks if A$$CLI defined

	.LIST	MEB		;NEED TO SEE ALL CODE FOR DEBUGGING

	.MCALL	QIOW$,DIR$,EXIT$S,GMCR$,GTIM$
	.MCALL	F11DF$,UCBDF$,DCBDF$,TCBDF$,PCBDF$,SCBDF$,MTADF$
	F11DF$
	MTADF$
	UCBDF$
	DCBDF$
	TCBDF$
	SCBDF$
	V$$D11=0		; HANDLE VIRTUAL DISKS

	MAXFRG=100.

;  THESE DEFINITIONS DETERMINE WHAT CHARACTERS ARE USED TO FILL WHICH
; DATA STRUCTURES.
ASTFIL = 56			; '.
FREFIL = 55			; '-
HDRFIL = 75			; '=		WAS	'#
ICBFIL = 40			; ' 
UCBFIL = 75			; '=		WAS	'%
WBFIL  = 75			; '=
;
;  THESE ARE THE DEFINITIONS OF THE BEGINNING CHARACTERS MARKING THE
; DATA STRUCTURES.
DYNCHR = 176			; '~		WAS	'+
OCBCHR = 46			; '&		WAS	'!
SUBCHR = 57			; '/
	.PAGE
	.SBTTL	Map Definitions

;=============================================================================*
;	OPA - CPA   Map Definitions
;
;  <DCB+UCB+SCB = dv:==>	Device Driver Data Structure
;	<IO=ddn:>			I/O Packet in use
;	<I dd: >			Interrupt Control Block
;  <TCB === tasknm>		Task Control Block
;	<A>				Attachment Discriptor Block
;	[...]				AST Control Block
;	[Ax]				Specify-AST Block w/type code
;	[FDX TT:]			Reserved by Terminal Driver
;	[BIO TT:]			Buffered I/O    
;	&prntnm				Offspring Control Block	
;	/tasknmD\			Receive Data Queue
;	/tasknmR\			Receive by Reference Queue
;	(ctsknam)			Checkpointed Task saved Sub-PCB
;  <Header tasknm===>		Task Header
;	<WB====>			Window Block
;  ( parnam)			Main Partition Control Block
;	(/parnam)			Sub-Partition Control Block
;	(/ dv:  )			Driver Sub-Partition Control Block
;	(~parnam)			Dynamic Partition Control Block
;  <VCB === ddn:>		Volume Control Block
;	<FCB @ddn:>			File Control Block
;	<VDn: EXT>			Virtual Disk Extension Block
;  <VSCB = ddn:volnam===>	Volume Set Control Block (Magtape)
;  	<MVL				Mounted   Volume List (VSCB)
;  	<UVL				Unmounted Volume List (VSCB)
;  <CP>				Checkpoint File PCB
;  <CPBx>			CLI Parser Block w/position code
;  <Cx>				Clock Queue Control Block w/type code
;  <Pkt Opt>			Unused I/O Packet
;  <Lx>				Logical Assignment Control Block w/type code
;  <M				Mount Countrol Block
;  <MCR Line for tasknm>	MCR Command Line for Task
;=============================================================================*
	.PAGE
	.SBTTL	OPA Entry Point

OPA::				;ENTRY POINT
	DIR$	#GMCR		;EMPTY OUR MCR BUFFER IF ONE EXISTS
	MOV	$EXSIZ,POOLWD	;CALC. TOTAL POOL SPACE
	SUB	#$POOL,POOLWD
	MOV	POOLWD,MAPSIZ	;SET SIZE OF OUR MAP
	ASR	MAPSIZ		; IN # SEGMENTS OF 4 BYTES EA.
	ASR	MAPSIZ
	MOV	#MAP,R0		;SET MAP TO ALL '?????' FOR UNKNOWN/USED
	MOV	MAPSIZ,R2
	MOV	#'?,R1
5$:	MOVB	R1,(R0)+
	SOB	R2,5$
	MOV	#THRLST,THREAD	;INIT THREADED ROUTINE LIST ADDRESS
	CALL	$SWSTK,END	;GET ONTO SYSTEM STACK TO LOOK AT POOL
	MOV	SP,OKSP		;SAVE SP FOR RESTORE ON ODD OR MP TRAP
	MOV	@#PS,OKPS	;SAVE VALID PSW TOO
	MOV	@#4,OLDODD	;SAVE OLD ODD ADDR. TRAP VECTOR
	MOV	@#250,OLDMPV	; SAME FOR MEM. PROT. VIOLATION
	MOV	#ODDTRP,@#4	;PUT IN OUR OWN TRAP VECTORS
	MOV	@MPVTRP,@#250
	CLR	BADPC		;CLEAR FLAG/BAD PC LOCATION
	MOV	#FRLIST,R5	;GET POINTER TO BUFFER AREA
	CLR	R4		;ZERO COUNT OF FRAGMENTS
	MOV	#MAXFRG,R3	;GET MAXIMUM # ENTRIES
	MOV	$CRAVL,R2	;GET LISTHEAD OF FREE POOL
10$:	MOV	R2,R0		;SAVE CURRENT ADDRESS
	INC	R4		;FOUND FREE SEGMENT; COUNT IT
	SUB	#$POOL,R0	;CALC. ADDR. RELATIVE TO START OF POOL
	MOV	R2,(R5)+	;SAVE REL. ADDRESS
	MOV	2(R2),R1	;GET SEGMENT SIZE
	MOV	R1,(R5)+	;THEN SAVE IT
	CALL	MRKMP1		;MARK THE MAP
	.WORD	FREFIL		; WITH '-----' FOR FREE PIECES
	MOV	(R2),R2		;GET THE NEXT FREE SEGMENT ADDR.
	BEQ	ENDFRE		;END IF POINTER TO NEXT IS ZERO
	SOB	R3,10$		;CONTINUE IF MORE ROOM IN LIST AREA
;
ENDFRE:	MOV	R4,FRGMNT	;SAVE # FRAGMENTS
;+
;AT THIS POINT, SYSTEM SP AND PS SHOULD BE CORRECT AND THREAD POINTS
; TO THE FIRST ENTRY IN THE THREADED ROUTINE LIST
;-
NXTTHR:	MOV	@THREAD,R0	;GET NEXT LIST ENTRY
	BEQ	XITSYS		;IF ZERO, END OF TABLE
	ADD	#2,THREAD	;ADVANCE POINTER TO NEXT ENTRY
	JMP	(R0)		;GO DO THIS PHASE OF DECODING
;+
;GO BACK TO USER STATE
;-
XITSYS:	MOV	OLDODD,@#4	;RESTORE STANDARD TRAP VECTORS
	MOV	OLDMPV,@#250
	RETURN			;RETURN TO USER STATE (TO END:)
;+
;ENTRY HERE ON ODD ADDRESS OR MEM. PROTECT TRAPS
;-
MPVTRP:	INC	(SP)		;FLAG MEM. PROTECT VIOLATIONS W/ ODD PC
ODDTRP:	MOV	(SP),BADPC	;SAVE MOST RECENT PC FOR ERROR MESSAGE
	MOV	OKSP,SP		;RESTORE VALID SP (ELIMINATE JUNK ON STACK)
	MOV	OKPS,@#PS	; SAME FOR PSW
	BR	NXTTHR		;THEN TRY NEXT THREADED CODE ENTRY

	.SBTTL	TCB's / AD's / AST's / OCB's
;+
;NOW MARK TCB'S W/ THEIR NAMES
;-
STATCB:	MOV	$TSKHD,R4	;GET FIRST TCB
10$:	MOV	R4,R0		;COPY ADDR. FOR DESTRUCTIVE USE
	CALL	GTMOFF		;GET MAP OFFSET
	BCS	22$		;IF OUTSIDE POOL, JUST IGNORE IT
	MOV	#TCBSTG,R1	;INSERT '<TCB  -  '
	CALL	MOVSTG
	CALL	GTTSKN		;COPY IN TASK NAME
	MOVB	#'>,(R0)+	;FINISH OFF W/ CLOSING BRACKET
12$:	MOV	T.ATT(R4),R3	;LOOK FOR ATTACHMENT DESCRIPTOR LIST
	BEQ	20$		;NONE IF ZERO
15$:	MOV	R3,R0		;MAKE A COPY FOR DESTRUCTIVE USE
	SUB	#6,R0		;ADJUST TO BEGINNING OF BLOCK
	CALL	GTMOFF		;GET THE OFFSET FROM BEGINNING OF POOL
	BCS	20$		;IGNORE IF OUTSIDE OF POOL
	MOVB	#'<,(R0)+	;MARK AREA WITH '<A>'
	MOVB	#'A,(R0)+
	MOVB	#'>,(R0)+
18$:	MOV	(R3),R3		;LOOK FOR MORE ATTACHMENTS
	BNE	15$		; AND CONTINUE WITH THEM

;CHECK FOR VARIOUS AST CONTROL BLOCKS

20$:	MOV	T.SAST(R4),R3	;CHECK FOR ANY SPECIFIED AST CONTROL BLOCKS
	CALL	MRKAST		; & GO MARK THEM OFF
	MOV	T.ASTL(R4),R3	;Any active AST Block's queued?
	CALL	MRKAST		; & GO MARK THEM OFF

	MOV	T.OCBH(R4),R3	;LOOK FOR OFFSPRING CONTROL BLOCKS
	BEQ	210$		;QUIT SEARCH IF NONE
21$:	MOV	R3,R0		;NEED COPY OF ADDRESS FOR DESTRUCTIVE USE
	CALL	GTMOFF		;CONVERT TO MAP ADDRESS
	BCS	210$		;QUIT SEARCH IF OUTSIDE MAP AREA
	CALL	MRKOCB		;GO MARK THEM AS: '!PRNTNM' (PARENT NAME)
	MOV	(R3),R3		;GET NEXT OCB ADDRESS
	BNE	21$		; & PROCESS IT (IF THERE IS ONE)

210$:	MOV	T.RCVL(R4),R3	; Anything in Receive Data queue?
	BEQ	215$		; If not, leave.
211$:	MOV	R3,R0		; Save address.
	CALL	GTMOFF		; Convert to MAP address.
	BCS	215$		; Done if outside MAP area.
	MOVB	#'/,(R0)+	; Mark Receive Packet.
	CALL	GTTSKN		; Copy in Task name.
	MOVB	#'D,(R0)+	; Mark as Receive Data.
	MOVB	#'\,(R0)+	; Close area.
	MOV	(R3),R3		; Get next one
	BNE	211$		;  if there is one.

215$:	MOV	T.RRFL(R4),R3	; Anything in Receive by Reference queue?
	BEQ	219$		; If not, leave.
216$:	MOV	R3,R0		; Save address.
	CALL	GTMOFF		; Convert to MAP address.
	BCS	219$		; Done if outside MAP area.
	MOVB	#'/,(R0)+	; Mark Receive Packet.
	CALL	GTTSKN		; Copy in Task name.
	MOVB	#'R,(R0)+	; Mark as Receive by Reference.
	MOVB	#'\,(R0)+	; Close area.
	MOV	(R3),R3		; Get next one
	BNE	216$		;  if there is one.

219$:	; Checkpointed file Sub-partition Control Block

	BIT	#TS.CKP,T.STAT(R4)	; Is it checkpointed?
	BEQ	22$			;  No
	BIT	#TS.OUT,T.STAT(R4)	; Is it out-of-memory?
	BEQ	22$			;  No
	MOV	T.PCB(R4),R0		; PCB address
	CALL	GTMOFF			; Convert to Map address
	BCS	22$			; Outside of Map
	MOVB	#'(,(R0)+		; Tag as "(cxxxxxx)"
	MOVB	#'c,(R0)+
	CALL	GTTSKN			; Copy in Task name
	MOVB	#'),(R0)+		; Add terminator

22$:	MOV	T.TCBL(R4),R4	;GET NEXT TCB
	BEQ	ENDTCB		; UNTIL END OF LIST
	TST	T.TCBL(R4)	;HAVE WE GOTTEN TO THE NULL TASK?
	BNE	10$		;IF NO, CONTINUE
;
ENDTCB:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	Clock Queue Control Blocks	'<Cn'
;+
;NOW DO CLOCK-QUEUE CONTROL BLOCKS (AN EASY ONE)
;-
STACLQ:	MOV	$CLKHD,R3	;GET FIRST CONTROL BLOCK
	BEQ	ENDCLQ		;MAYBE THERE AREN'T ANY????
10$:	MOV	R3,R0		;WE NEED TO GET THIS INTO AN OFFSET
	CALL	GTMOFF		;GET MAP OFFSET
	BCS	20$		;IGNORE IF OUTSIDE POOL AREA
	MOVB	#'<,(R0)+	;MARK JUST AS '<Cn>'
	MOVB	#'C,(R0)+	;WHERE n is REQUEST TYPE
	MOVB	C.RQT(R3),R1	;GET THE REQUEST TYPE
	CALL	CNVASC		;PUT OUT AS ASCII
	MOVB	#'>,(R0)+
20$:	MOV	C.LNK(R3),R3	;GET NEXT CONTROL BLOCK IF ANY
	BNE	10$		; AND MARK THAT ONE
;
ENDCLQ:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	ASN Control Blocks  '<Ln'
;+
;NOW MARK ASN CONTROL BLOCKS (ANOTHER EASY ONE)
;-
STALOG:	MOV	$LOGHD,R3	;GET 1ST ONE
	BEQ	ENDLOG		; IF IT EXISTS, ELSE SKIP OUT
10$:	MOV	R3,R0		;MAKE A COPY
	CALL	GTMOFF		;GET OFFSET INTO MAP
	BCS	20$		;IGNORE IF OUTSIDE POOL
	MOVB	#'<,(R0)+	;MARK IN FORM '<Ln'
	MOVB	#'L,(R0)+	; WHERE n is ASN TYPE
	MOVB	L.TYPE(R3),R1	;GET THE ASN TYPE #
	CALL	CNVASC		;PUT OUT IN ASCII
20$:	MOV	L.LNK(R3),R3	;GET NEXT ASN BLOCK IF IT EXISTS
	BNE	10$
;
ENDLOG:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	CLI Parser Blocks  '<CPBn>'
;+
;Now mark CLI Parser Blocks
;-
     .IF DF	A$$CLI

STACPB:	CLR	R2		; Initialize CLI count
	MOV	#$CPTBL+2,R3	; Point to 1st alternate CLI in table

10$:	INC	R2		; CLI count
	MOV	(R3)+,R0	; Get CPB address in Pool
	BEQ	ENDCPB		;   Done if zero
	CALL	GTMOFF		; Get offset into MAP
	BCS	20$		; Ignore if outside Pool
	MOV	#CPBSTG,R1	; Mark with '<CPB'
	CALL	MOVSTG
	MOV	R2,R1		; CLI count to convert & store
	CALL	CNVASC		; Put out in ASCII (Hex if need be)
	MOVB	#'>,(R0)+	; Add terminator
20$:	CMP	#$NMCLI-1,R2	; Check if done
	BNE	10$		;   Not yet

ENDCPB:	JMP	NXTTHR		; Go do next routine

	.ENDC		;A$$CLI

	.SBTTL	PCB's / HDR's / WB's / Sub-PCB's
;+
;NOW TRY TO DO PARTITION-CONTROL-BLOCKS
;-
STAPAR:	MOV	$PARHD,R3	;GET PTR TO 1ST PCB
PARNXT:	MOV	R3,R0		;MAKE A COPY TO CALCULATE MAP OFFSET
	CALL	GTMOFF		;CONVERT TO BYTE OFFSET IN MAP
	BCS	NXTPAR		;TRY NEXT IF OUTSIDE POOL
	MOVB	#'(,(R0)+	;MARK IT WITH A '('
	CMP	P.MAIN(R3),R3	;IS THIS A 'MAIN' PARTITION?
	BNE	NTMAIN
	MOVB	#40,(R0)+	;YES, NO SPECIAL SYMBOL INSERTED
PARNM:	MOV	P.NAM(R3),R1	;GET PARTITION NAME
	CALL	$C5TA		; AND CONVERT TO ASCII
	MOV	P.NAM+2(R3),R1	;MARK AS '( PARNAM)'
PARL:	CALL	$C5TA
TRLPAR:	MOVB	#'),(R0)

;LOOK FOR TASK HEADERS IN POOL

	MOV	P.HDR(R3),R0	;SEE IF THIS PARTITION HAS A HEADER
	BEQ	PARSYS		;NO IF ZERO
	MOV	P.TCB(R3),R4	;MAYBE, HAVE TO CHECK IF STILL IN MEMORY
	CMP	T.PCB(R4),R3	; Is it really the TCB for this PCB?
	BNE	PARSYS		; If NE -- N0!

;	TST	P.ATT(R3)	; Is partition attached?
;	BNE	PARSYS		; If not, there should be no header.

	BIT	#TS.OUT,T.STAT(R4) ;HEADER IS ALLOCATED UNTIL MARKED OUT
	BNE	PARSYS		;IF OUT, THEN NO HEADER IN POOL
	MOV	H.HDLN(R0),R1	;IT'S THERE, GET IT'S LENGTH
	CALL	GTMOFF		;GET OFFSET INTO MAP
	BCS	PARSYS		;IF C SET, WASN'T IN POOL AREA
	MOV	R0,-(SP)	;SAVE START OFFSET ADDRESS
	CALL	MRKMP2		;MARK THE WHOLE HEADER AREA
	.WORD	HDRFIL		; Fill Area
	MOVB	#'>,-(R0)	;MARK END W/ USUAL ANGLE BRACKET
	MOV	(SP)+,R0	;GET BACK BEGINNING OF HEADER
	MOV	#HDRSTG,R1	;INSERT '<HEADER = ' TEXT
	CALL	MOVSTG
	CALL	GPTSKN		;THEN INSERT THE TASK NAME

;NOW LOOK AT LUT FOR WINDOW BLOCKS IN POOL

	MOV	P.HDR(R3),R2	;RETRIEVE HEADER ADDRESS
	MOV	H.NLUN(R2),-(SP) ;GET NUMBER OF LUNS FOR THIS TASK
	BEQ	ENDHDR		;QUIT IF NO LUNS
	ADD	#H.LUN,R2	;MOVE POINTER TO 1ST LUN
GTWB:	MOV	(R2)+,R0	;GET UCB ADDRESS
	BEQ	NOWB		;SKIP IF NO UCB
5$:	CMP	U.RED(R0),R0	;IS THE DEVICE REDIRECTED?
	BEQ	10$		;SKIP IF NO
	MOV	U.RED(R0),R0	;ELSE FOLLOW REDIRECT CHAIN
	BR	5$

10$:	BIT	#DV.MNT,U.CW1(R0) ;CHECK IF THIS DEVICE IS LEGAL FILES-11
	BEQ	NOWB		;NOT IF NOT MOUNTABLE
	BIT	#DV.F11,U.CW1(R0)
	BEQ	NOWB		;NOT IF NOT FILES-11
	BITB	#US.MNT,U.STS(R0) ;LEGAL, BUT IS IT ACTUALLY MOUNTED?
	BNE	NOWB		;NO IF BIT ON!
	MOV	(R2),R0		;OK, NOW GET WINDOW BLOCK POINTER
	BIT	#1,R0		;CHECK IF APPROX. VALID ADDRESS
	BNE	NOWB		;IGNORE IF NOT
	CALL	MRKWB		;GOOD ONE, GO MARK IT IN MAP
NOWB:	TST	(R2)+		;SKIP TO NEXT LUN
	DEC	(SP)		;DECR. COUNT OF LUNS TO TEST
	BNE	GTWB		; & TRY ANOTHER
ENDHDR:	TST	(SP)+		;REMOVE EXHAUSTED COUNT FROM STACK

;NOW DETERMINE WHAT TYPE OF PARTITION WE HAVE

PARSYS:	BIT	#PS.SYS,P.STAT(R3) ;IS THIS A SYSTEM-CONTROLLED PARTITION?
	BEQ	NXTPAR
	MOV	R3,R1		;YES, MAKE A COPY OF ADDRESS IN CASE HAVE TO
	MOV	P.SUB(R3),R3	; BACKTRACK
	BNE	PARNXT		;GO PROCESS THIS PCB
	MOV	P.MAIN(R1),R3	;END OF SUBPARTITIONS - BACK TO MAIN
NXTPAR:	MOV	P.LNK(R3),R3	;GET NEXT MAIN PCB
	BNE	PARNXT		; UNLESS AT END OF LIST
	BR	ENDPAR		;THEN DONE W/ PCB'S

NTMAIN:	BIT	#PS.COM,P.STAT(R3) ;IS THIS A DYNAMIC PARTITION?
	BNE	20$		;BR IF YES
	MOVB	#SUBCHR,(R0)+	;NO, MARK AS A SUB-PARTITION CNTL BLOCK
	BIT	#PS.DRV,P.STAT(R3) ;IS THIS A DRIVER SUBPARTITION?
	BNE	10$
	CALL	GPTSKN		;NO, PUT IN TASK NAME
	BR	TRLPAR		; & THEN GO APPEND TRAILING PAREN.

10$:	MOVB	#40,(R0)+	;WAS A DRIVER, PUT IN A BLANK
	MOV	P.TCB(R3),R1	;THEN GET DCB ADDRESS
	MOVB	D.NAM(R1),(R0)+	;COPY OVER THE DEVICE NAME
	MOVB	D.NAM+1(R1),(R0)+
	MOV	#PDVSTG,R1	;FINISH OFF W/ ':  )'
	CALL	MOVSTG
	BR	PARSYS		;PICK UP MAIN CODE FOR NEXT MAIN/SUB PAR

20$:	MOVB	#DYNCHR,(R0)+	;FOUND DYNAMIC PAR (COMMON IN SYS-CNTLD)

;??	BR	PARNM		;FLAG IT W/ '~', THEN INSERT SUB-PAR NAME

	MOV	P.NAM(R3),R1	;GET PARTITION NAME
	CALL	$C5TA		; AND CONVERT TO ASCII
	MOV	P.NAM+2(R3),R1	;MARK AS '(~PARNAM)'
	CALL	$C5TA
	MOVB	#'),(R0)
	BR	PARSYS

ENDPAR:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	VCB's / FCB's / VSCB's
;+
;NOW TRY TO PICK UP VOLUME-CONTROL-BLOCKS & FILE-CONTROL BLOCKS
;-
STAVCB:	MOV	$DEVHD,R3	;START WITH THE LIST OF DEVICES
CHKDEV:	MOVB	D.UNIT+1(R3),R5	;GET TOTAL # UNITS
	MOVB	D.UNIT(R3),R4	;GET THE BOTTOM UNIT NUMBER
	SUB	R4,R5		;SUBTRACT BOTTOM #
	INC	R5		;ADJUST FOR END COUNT
	MOV	D.UCBL(R3),R4	;SAVE LENGTH OF A UCB
	MOV	D.UCB(R3),R2	;GET A UCB
TSTUCB:	BIT	#DV.MNT,U.CW1(R2) ;IS THIS DEVICE MOUNTABLE?
	BEQ	NXTDEV		;IF NOT, GO TRY FOR ANOTHER DEVICE
	BIT	#DV.F11,U.CW1(R2) ;IS IT FILES-11?
	BEQ	NXTDEV		;IF NO, TRY ANOTHER DEVICE
	BITB	#US.MNT,U.STS(R2) ;OKAY, IS IT ACTUALLY MOUNTED
	BNE	NXTUNT		;IF NO, CHECK THE NEXT UNIT
	BIT	#DV.SQD,U.CW1(R2)	;Is it a sequential (Magtape) device
	BEQ	GETVCB			; If not set, must be valid VCB
	JMP	GTVSCB			; If set, get VSCB instead

GETVCB:	MOV	U.VCB(R2),R0	;AHA!, GOT ONE.  GET ADDRESS OF VCB
	CALL	GTMOFF		;GET OFFSET IN MAP
	BCS	FNDFCB		;IGNORE IF OUTSIDE POOL
	MOV	#VCBSTG,R1	;MARK WITH '<VCB === '
	CALL	MOVSTG
	MOV	R0,NAMFLD	;SAVE LOCATION OF DEVICE NAME FOR LATER USE
	MOVB	D.NAM(R3),(R0)+ ;NOW COPY DEVICE NAME OUT OF DCB
	MOVB	D.NAM+1(R3),(R0)+
	MOVB	D.UNIT(R3),R1	;GET THE STARTING UNIT # FOR THIS DCB
	MOV	R1,-(SP)	;SAVE IT FOR A MOMENT (NOW SIGN-EXTENDED)
	MOVB	U.UNIT(R2),R1	;GET THE UNIT # FOR THIS UCB
	ADD	(SP)+,R1	;COMBINE
	ADD	#'0,R1		; & CONVERT TO ASCII
	MOVB	R1,(R0)+	;INSERT IN MAP
	MOVB	#':,(R0)+	;APPEND ':>'
	MOVB	#'>,(R0)+

    .IFDF	V$$D11		; This is for Stamerjohn's vd: disk driver

	CMP	D.NAM(R3),#"VD	; Is it a VD: ?
	BNE	ENDVDS		; Br if no
	MOV	U.VCB+2(R2),R0	; Any extension block ?
	BEQ	ENDVDS		; Br if no
	CALL	GTMOFF		; Get offset in map
	BCS	ENDVDS		; Ignore if not in pool
	MOV	R1,-(SP)	; Save the unit #
	MOV	#VDASTG,R1	; Point to starting '<VD'
	CALL	MOVSTG		; Stuff it
	MOVB	(SP)+,(R0)+	; Now for the stacked unit #
	MOV	#VDBSTG,R1	; Point to ending ': ext>'
	CALL	MOVSTG		; Stuff it
ENDVDS:
	.ENDC			; V$$D11

; NOW TRACK DOWN FILE-CONTROL-BLOCKS IN POOL

FNDFCB:	MOV	U.VCB(R2),R1	;GET THE VCB ADDRESS AGAIN
	MOV	V.FCB(R1),R1	;GET 1ST FCB
CHKFCB:	CMP	R1,$EXSIZ	;IN POOL?
	BHI	GETWB		;IF NOT, GIVE UP (ELSE HAVE TO MAP TO ACP)
	MOV	R1,R0		;COPY TO CONVERT TO MAP PTR
	CALL	GTMOFF
	BCS	GETWB		;GIVE UP ON THIS CHAIN IF OUTSIDE OF POOL
	MOV	R1,-(SP)	;SAVE FCB FOR TRACING CHAIN
	MOV	#FCBSTG,R1	;MARK W/ '<FCB @'
	CALL	MOVSTG
	MOV	NAMFLD,R1	;GET NAME-FIELD ADDRESS FROM BEFORE
	MOVB	(R1)+,(R0)+	;COPY OVER DEVICE-NAME & UNIT #
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOV	(SP)+,R1	;RETRIEVE FCB POINTER
NXTFCB:	MOV	(R1),R1		;GET ANOTHER FCB
	BNE	CHKFCB		; & SEE IF IT'S IN POOL, IF ONE EXISTS

GETWB:	MOV	U.VCB(R2),R1	;GET THE VCB ADDRESS A 3RD TIME
	MOV	V.IFWI(R1),R0	;NOW GET THE INDEX-FILE WINDOW BLK ADDR.
	CALL	MRKWB		;GO MARK WB IN MAP

NXTUNT:	ADD	R4,R2		;ADVANCE TO NEXT UCB
	DEC	R5		; UNTIL NO MORE UNITS
	BNE	TSTUCB
NXTDEV:	MOV	(R3),R3		;MOVE TO NEXT DEVICE IN CHAIN
	BNE	CHKDEV		; AND GO CHECK IF IT'S A FILES-11 TYPE

ENDVCB:	JMP	NXTTHR		;GO DO NEXT ROUTINE

GTVSCB:		; Get VSCB for Magtape Device

	MOV	U.VCB(R2),R0	; Get address of VSCB
	CALL	GTMOFF		; Get offset in MAP
	BCS	NXTUNT		; Ignore if outside POOL
	MOV	#VSCBTG,R1	; Mark with '<VSCB = '
	CALL	MOVSTG
	MOVB	D.NAM(R3),(R0)+ ; Now copy device name out of DCB
	MOVB	D.NAM+1(R3),(R0)+
	MOVB	D.UNIT(R3),R1	; Get the starting Unit # for this DCB
	MOV	R1,-(SP)	; Save it for a moment (now sign-extended)
	MOVB	U.UNIT(R2),R1	; Get the Unit # for this UCB
	ADD	(SP)+,R1	; combine
	ADD	#'0,R1		; & convert to ASCII
	MOVB	R1,(R0)+	; Insert in MAP
	MOVB	#':,(R0)+	; Append ':'
	MOV	U.VCB(R2),R1	; Get address of VSCB again
	ADD	#V.LABL,R1	; Get address of VOL Label ( 1st 6 char's)
		.REPT 6		; Transfer VOL Label
	MOVB	(R1)+,(R0)+
		.ENDR
	MOV	#S.VSCB-110,R1	; Fill rest of VSCB
	CALL	MRKMP2
	.WORD	HDRFIL		; '=' fill char
	MOVB	#'>,-(R0)	; Add terminating char

	MOV	U.VCB(R2),R0	; Get address of VSCB again
	MOV	V.MVL(R0),R0	; Get address of Mounted Volume list
	CALL	GTMOFF		; Get offset in Map
	BCS	20$		; Ignore if outside Pool
	MOV	#VMVLTG,R1	; Mark '<MVL'
	CALL	MOVSTG
20$:
	MOV	U.VCB(R2),R0	; Get address of VSCB again
	MOV	V.UVL(R0),R0	; Get address of Unmounted Volume list
	CALL	GTMOFF		; Get offset in Map
	BCS	NXTUNT		; Ignore if outside Pool
	MOV	#VUVLTG,R1	; Mark '<UVL'
	CALL	MOVSTG

	BR	NXTUNT		; Next UCB

	.SBTTL	DCB's / ICB's / UCB's / SCB's / I/O Pkt's
;+
;NOW FIND ANY DEVICE DRIVER DATA STRUCTURES IN POOL
; OR PERHAPS JUST INTERRUPT CONTROL BLOCKS
;-
STADCB:	MOV	$DEVHD,R0	;GET START OF DCB'S
TSTDCB:	MOV	R0,-(SP)	;SAVE DCB PTR; R0 WILL BE USED DESTRUCTIVELY
	MOV	D.UCB(R0),R3	;GET 1ST UCB
	BIT	#DV.PSE,U.CW1(R3) ;IS THIS A PSEUDO DEVICE?
	BEQ	10$		;IF NOT, OK TO CONTINUE ON THIS ONE
	JMP	NXTDCB		;IF YES, CAN'T DO MUCH WITH IT - GOTO NXT DVC.
10$:	MOVB	D.UNIT(R0),R1	;CALCULATE # UNITS FOR THIS DCB
	MOVB	D.UNIT+1(R0),R2	;GET HIGHER #
	SUB	R1,R2		;SUB LOWER #
	INC	R2		; & ADD FOR END COUNT
	MOV	R1,UNITNO	;SAVE STARTING UNIT NUMBER
	CLR	R4		;INIT. TO SEARCH FOR NEW SCB ADDRS.
TSTSCB:

;;;	CMP	U.SCB(R3),R4	;HAVE WE GOT A NEW SCB ADDRESS?
;;;	BEQ	NXTUCB		;IF NOT, TRY ANOTHER UCB

NEWSCB:	MOV	U.SCB(R3),R4	;GET THE SCB ADDRESS

; NOW CHECK FOR I/O PACKETS IN USE & QUEUED TO THIS CONTROLLER (SCB)

	TSTB	S.STS(R4)	; Is this Controller busy?
	BNE	5$		; If so, process packets
	BIT	#DV.TTY,U.CW1(R3) ;  Else check for terminal multiplexer
	BEQ	DOVEC		; If not a terminal, look at vector.
	BIT	#U2.DH1,U.CW2(R3) ; If not a multiplexer,
	BEQ	DOVEC		;    proceed to look at intrp vector.
5$:	MOV	S.PKT(R4),R0	;IS BUSY, GET CURRENT PACKET
	MOV	(R4),R5		; AND SAVE LINK TO POSSIBLE NEXT PACKET
	CLR	CURPKT		;CLEAR ADDRESS FOR MAP OF CURRENT PACKET
IOPKT:	CMP	I.UCB(R0),R3	; Is packet for this UCB?
	BNE	NXTPKT		; If not, check next packet.
	CALL	GTMOFF		;CONVERT PACKET ADDRESS TO MAP ADDRESS
	BCS	NXTPKT		;TRY ANOTHER ONE IF OUTSIDE POOL
	MOV	R0,CURPKT	;SAVE MAP ADDRESS TO COPY LATER
	MOV	#IOP,R1		;PUT '<IO DVn:>' INTO MAP
	CALL	MOVSTG
	SUB	#5,R0		;BACK UP TO PUT IN ACTUAL DEVICE NAME & #
	MOV	(SP),R1		;RETREIVE DCB ADDRESS
	MOVB	D.NAM(R1),(R0)+	;COPY OVER DEVICE NAME
	MOVB	D.NAM+1(R1),(R0)+
	MOV	UNITNO,R1	;NOW GET CURRENT UNIT NUMBER
	CALL	CNVASC		;CONVERT TO ASCII & INSERT IN MAP
NXTPKT:	TST	R5		;SEE IF LINK POINTS TO ANOTHER PACKET
	BEQ	DOVEC		;IF NOT, OFF TO LOOK AT INTRP. VECTOR
	MOV	R5,R0		;GET COPY FOR DESTRUCTIVE USE
	MOV	(R5),R5		;ADVANCE POINTER TO POSSIBLE NEXT PACKET
	MOV	CURPKT,R1	;GET OLD PACKET ADDRESS
	BEQ	IOPKT		;IF NONE, HAVE TO GET CONTENTS THE HARD WAY
	CALL	GTMOFF		;CONVERT NEW PACKET ADDRESS TO MAP ENTRY
	BCS	NXTPKT		;BACK FOR ANOTHER IF OUTSIDE POOL
	MOV	#9.,-(SP)	;SET UP TO COPY 9 BYTES FROM OLD MAP ADDRESS
10$:	MOVB	(R1)+,(R0)+
	DEC	(SP)
	BNE	10$
	TST	(SP)+		;CLEAR EXPENDED COUNT FROM STACK
	BR	NXTPKT		; & BACK FOR POSSIBLE NEW PACKET

DOVEC:	MOVB	S.VCT(R4),R5	;THEN GET THE INTRP VECTOR ADDR.
	ASL	R5		;CONVERT TO ACTUAL ADDR
	ASL	R5
	CMP	(R5),#$POOL	;DO WE HAVE AN INTRP-CONTROL-BLOCK IN POOL?
	BLO	CLEANS		;IF NOT, GO TO NEXT UCB

; NOW LET'S MARK OFF AN ICB (OR POSSIBLY 2)

	CALL	MRKICB		;DO MARKING VIA SUBROUTINE
	CMP	(R5)+,(R5)+	;THEN ADVANCE TO NEXT POSSIBLE VECTOR ADDR.
	CMP	(R5),#$POOL	;IF THAT'S IN POOL, MAYBE DEVICE IS FULL-DUPLX
	BLO	CLEANS		;IF NOT, GO RESTORE STACK/REGISTERS
	MOV	(R5),R0		;LOOK AT MAP
	CALL	GTMOFF		; & SEE IF WE HAVE ANYTHING THERE
	BCS	CLEANS		;QUIT IF BAD ADDRESS
	CMPB	(R0),#'?	;SHOULD BE A '?' IF SO FAR UNIDENTIFIED
	BNE	CLEANS
	CALL	MRKICB		;IF SO, LET'S MARK AS PART OF THIS DEVICE
				; IF WE'RE WRONG, WILL HOPEFULLY GET FIXED
				; BY A LATER DEVICE INTRP VECTOR FIND
CLEANS:	MOV	(SP),R0		;GET FRESH COPY OF R0 FROM STACK
NXTUCB:	ADD	D.UCBL(R0),R3	;ADVANCE UCB POINTER TO NEXT UCB
	INC	UNITNO		;INCR. UNIT # WE ARE TESTING
	DEC	R2		; & DECR. COUNT OF REMAINING UCB'S
	BNE	TSTSCB		; & BACK TO TRY FOR ANOTHER UCB/SCB
	SUB	D.UCBL(R0),R3	;RESTORE UCB POINTER TO LAST GOOD UCB ADDR.
	CMP	R0,#$POOL	;IS THIS DCB INSIDE POOL AREA?
	BLO	NXTDCB		;NO IF LOWER, SO DONE W/ THIS DEVICE

; WE NOW HAVE ALL THE ASSOCIATED DATA STRUCTURES FOR THIS DEVICE.
; WE WILL ASSUME THAT THEY HAVE BEEN INSERTED IN STANDARD ORDER, I.E.
;  DCB, UCB, SCB...

	ADD	#S.MPR,R4	;ADVANCE TO END OF SCB AREA
	BIT	#FE.EXT,$FMASK	;DO WE HAVE TO WORRY ABOUT UMR AREA?
	BEQ	10$
	BITB	#UC.NPR,U.CTL(R3) ;YES, BUT IS THIS AN NPR DEVICE?
	BEQ	10$
	ADD	#12.,R4		;YES, SO ADD IN SPACE FOR UMR ALLOCATION
10$:	SUB	R0,R4		;CONVERT R4 TO SIZE OF AREA
	MOV	R4,R1		;SET UP FOR MARKING OFF AREA
	CALL	GTMOFF		;CONVERT TO OFFSET IN POOL MAP
	MOV	R0,-(SP)	;SAVE START OF AREA
	CALL	MRKMP2
	.WORD	UCBFIL		;FILL AREA 
	MOVB	#'>,-(R0)	;END AREA W/ USUAL '>'
	MOV	(SP)+,R0	;RECOVER BEGINNING OF AREA
	MOV	#DCBSTG,R1	;INSERT '<DCB+UCB+SCB = '
	CALL	MOVSTG
	MOV	(SP),R1		;RECOVER ABSOLUTE DCB ADDRESS
	MOVB	D.NAM(R1),(R0)+	;COPY IN DEVICE NAME
	MOVB	D.NAM+1(R1),(R0)+
	MOVB	#':,(R0)	; PLUS TRAILING ':'
NXTDCB:	MOV	@(SP)+,R0	;GET NEXT DCB ADDRESS, RESTORE STACK
	BEQ	ENDDCB		;IF AT END, PROCEED TO NEXT ITEM TO LOOK FOR
	JMP	TSTDCB		; ELSE BACK TO EXAMINE THIS NEW ONE
;
ENDDCB:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	MCR Command Lines	'<MCR Line for'
;+
;NOW LOOK FOR MCR LINES NOT YET READ
;-
STAMCR:	MOV	$MCRCB,R3	;GET LISTHEAD FOR MCR LINES OF TASKS
10$:	MOV	R3,R0		;GET COPY FOR DISTRUCTIVE USE
	BEQ	ENDMCR		;QUIT IF NO NEW LINE
	CALL	GTMOFF		;GET OFFSET INTO POOL MAP
	BCS	ENDMCR		;SKIP IF SOMEWHOW NOT IN POOL
	MOV	#MCRSTG,R1	;PUT '<MCR LINE FOR ' IN MAP
	CALL	MOVSTG
	MOV	2(R3),R4	;GET TASK CONTROL BLOCK ADDRESS
	CALL	GTTSKN		;MOVE TASK NAME INTO MAP
	MOVB	#'>,(R0)	;FINISH OFF WITH ENDING DELIMITER
	MOV	(R3),R3		;GET NEXT MCR LINE ADDRESS
	BR	10$		;AND GO TRY OUT THAT ONE
ENDMCR:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	Unused I/O Pkt's	 '<Pkt Opt>'
;+
;NOW GET ANY CURRENTLY UNUSED I/O PACKETS FROM I/O OPTIMIZATION
;-
STAOPK:				;REF. LABEL
	.IF DF	Q$$OPT
	MOV	#$PKAVL,R2	;GET POINTER TO PACKET TAIL
	MOV	(R2)+,R0	;GET ADDRESS OF 1ST PACKET
	BEQ	ENDOPK		;DONE IF NONE AVAIL.
	MOVB	(R2),R3		;GET COUNT OF PACKETS AVAIL.
OPKLUP:	MOV	R0,R2		;SAVE COPY OF R0
	CALL	GTMOFF		;CONVERT TO OFFSET IN MAP
	BCS	ENDOPK		;QUIT IF PACKET OUTSIDE POOL
	MOV	#PKTOPT,R1	;GET STRING ADDRESS TO INSERT IN MAP
	CALL	MOVSTG		;INSERT '<Pkt Opt>'
	MOV	(R2),R0		;GET NEXT PACKET ADDRESS
	SOB	R3,OPKLUP	;ANY LEFT TO DO?
	.ENDC	;Q$$OPT
ENDOPK:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	Mount Control Blocks	'<M'
;+
;NOW LOOK FOR MOUNT CONTROL BLOCKS
;-
STAMOU:	MOV	$MOULS,R3	;GET LISTHEAD FOR MOUNT-CONTROL-BLOCKS
10$:	BEQ	ENDMOU		;QUIT IF NO MORE
	MOV	R3,R0		;GET COPY FOR DISTRUCTIVE USE
	CALL	GTMOFF		;CONVERT TO MAP OFFSET
	BCS	ENDMOU		;QUIT THIS IF NOT IN POOL
	MOVB	#'<,(R0)+	;LABEL WITH '<M'
	MOVB	#'M,(R0)
	MOV	(R3),R3		;GET THE NEXT ONE IN THE LIST
	BR	10$		; AND GO PROCESS IT
;
ENDMOU:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	Checkpoint File PCB's	 '<CP>'
;+
;NOW FOR CHECKPOINT FILE PCB
;-
STACKP:	MOV	$CFLPT,R3	;GET LIST HEAD
10$:	BEQ	ENDCKP		;QUIT IF NO MORE ENTRIES
	MOV	R3,R0		;NEED A COPY FOR DISTRUCTIVE USE
	CALL	GTMOFF		;CONVERT TO MAP ADDRESS
	BCS	ENDCKP		;QUIT IF BAD ADDRESS
	MOV	#CKPSTG,R1	;LABEL W/ '<CP>'
	CALL	MOVSTG
	MOV	P.SUB(R3),R3	;GET NEXT CP-PCB
	BR	10$		; GO PROCESS IT
;
ENDCKP:	JMP	NXTTHR		;GO DO NEXT ROUTINE

	.SBTTL	Print Display of Pool Fragments
;+
;NOW WE HAVE ALL THE DATA - WE NEED TO DISPLAY IT
;-
END:				;REF. LABEL
	MOV	#IO.ATT,QIO+Q.IOFN ;1ST ATTACH TERMINAL
	DIR$	#QIO
	MOV	#IO.WVB,QIO+Q.IOFN ;THEN RESTORE TO NORMAL QIO
	MOV	BADPC,R2	;CHECK FOR TRAP WHILE ON SYSTEM STACK
	BEQ	NOERR
	MOV	#ODDMSG,R1	;OOPS, DEFAULT TO ODD ADDRESS MESSAGE
	ASR	R2		;CHECK FOR FLAG FOR MEM. PROT VIOLATION
	BCC	10$		;FLAG CLEAR IF EVEN ADDRESS
	MOV	#MPVMSG,R2	;WAS MEM. PROT. VIOLATION, CHANGE MESSAGE
10$:	ASL	R2		;CONVERT BACK TO VALID PC
	CLR	R3		;SET FLAG FOR OCTAL PRINTOUT
	CALL	PRMSNM		; AND OUTPUT MESSAGE W/ NUMBER
NOERR:	CMPB	GMCR+G.MCRB+4,#'F ;INITIATED WITH 'OPA Free' COMMAND?
	BNE	ENFRAG		;IF NO, SKIP FRAGMENT LIST
	MOV	FRGMNT,R2
	MOV	#FRGMSG,R1	;SET FOR MESSAGE ABOUT FRAGMENTS
	MOV	PC,R3		;SET FOR DECIMAL CONVERSION
	CALL	PRMSNM		;PRINT #FRAGMENTS
	MOV	POOLWD,R2
	ASR	R2		;CONVERT TO # WORDS
	MOV	#POOLMS,R1
	CALL	PRMSNM		;PRINT POOL SIZE
	MOV	#TEXTBF,R0	;OUTPUT MESSAGE ABOUT NEXT PRINTOUT
	MOV	#SEGMSG,R1	;IT'S LIST OF FREE SEGMENT ADDRS.
	CALL	MOVSTG
	CALL	OUTIT
	MOV	FRGMNT,R5	;SET LOOP COUNT FOR PRINTING
	MOV	#FRLIST,R4	;GET ADDRESS OF SEGMENT LIST
	CLR	R3		;ACCUMULATE SEGMENT LENGTHS IN R3
PRSEG:	MOV	(R4),R1		;GET ADDRESS OF SEGMENT
	MOV	#1,R2		;NO ZERO SUPPRESSION
	MOV	#TEXTBF,R0	;SET START OF OUTPUT BUFFER
	CALL	$CBOMG		;CONVERT TO OCTAL
	MOVB	#'-,(R0)+	;INSERT A DASH
	MOV	(R4)+,R1	;GET START ADDR. AGAIN
	ADD	(R4),R1		;ADD LENGTH
	DEC	R1		;ADJUST TO LAST FREE BYTE ADDRESS
	MOV	#1,R2		;NO ZERO SUPPRESS FOR OCTAL PRINTOUT
	CALL	$CBOMG		;1ST PRINT VALUE IN OCTAL
	MOVB	#40,(R0)+	;SEPARATE VALUES W/ A SPACE
	MOV	(R4)+,R1	;RECOVER LENGTH TO PRINT IN DECIMAL
	ASR	R1		;CONVERT LENGTH TO WORDS
	ADD	R1,R3		;ACCUMULATE SEGMENT LENGTHS
	CLR	R2		;SUPPRESS ZEROS THIS TIME
	CALL	$CBDMG		;CONVERT TO DECIMAL FOR SEGMENT LENGTH
	MOVB	#'.,(R0)+	;SHOW IT TO BE A DECIMAL VALUE
	CALL	OUTIT
	SOB	R5,PRSEG	;KEEP GOING UNTIL ALL SEGMENTS DONE
	MOV	R3,R2		;PRINT TOTAL OF FREE SEGMENTS
	MOV	#NFRMSG,R1
	MOV	PC,R3		;PRINT IN DECIMAL
	CALL	PRMSNM
ENFRAG:				;REF. LABEL

	.SBTTL	Print Pool Map & Exit
;+
;NOW PRINT MAP IN ROWS OF 64 CHARS. W/ ADDRESS OF EACH ROW
;-
	DIR$	#GTIM		; Get Date & Time
	MOV	#DTEMSG+1,R0	; Setup Date & Time Msg
	MOV	#DTEBUF,R1
	CALL 	$DAT		; Format Date	dd-mm-yy
	MOV	#DTEMSG+14,R0
	MOV	#2,R2		; Format Time   hh:mm
	CALL	$TIM
	MOV	#TEXTBF,R0	;OUTPUT Date & Time
	MOV	#DTEMSG,R1
	CALL	MOVSTG
	CALL	OUTIT

	MOV	#TEXTBF,R0	;OUTPUT HEADER FOR MAP:
	MOV	#MAPMSG,R1
	CALL	MOVSTG
	CALL	OUTIT

	MOV	#$POOL,R0	;CALC. EVEN 100'S MAP ADDRESS TO START
	BIC	#377,R0
	MOV	R0,POOLAD	;SAVE AS POOL ADDRESS
	MOV	$EXSIZ,R5	;CALC. MAP OUTPUT SIZE
	SUB	R0,R5
	ASR	R5		; IN # BYTES
	ASR	R5
	SUB	#$POOL,R0
	ASR	R0		;CONVERT TO MAP ADDRESS
	ASR 	R0
	ADD	#MAP,R0
	MOV	R0,MAPAD	;SAVE MAP ADDRESS

PRTLUP:	MOV	POOLAD,R1	;SET UP TO CONVERT POOL ADDRESS TO OCTAL
	ADD	#400,POOLAD	;BUMP POOL ADDRESS TO NEXT LINE
	MOV	#1,R2		;SET FOR NO ZERO SUPPRESSION
	MOV	#TEXTBF,R0	;GET OUTPUT BUFFER ADDRESS
	CALL	$CBOMG		;CONVERT TO OCTAL WORD
	MOVB	#':,(R0)+	;SEPARATE FROM MAP W/ ': '
	MOVB	#40,(R0)+
	MOV	MAPAD,R1	;GET OUR CURRENT MAP ADDRESS
	MOV	#64.,R4		;SET R4 TO DEFAULT # BYTES/RECORD
	CMP	R4,R5		;IS THERE LESS REMAINING?
	BLE	10$
	MOV	R5,R4		;YES, USE THE SMALLER #
10$:	ADD	R4,MAPAD	;ADVANCE MAP ADDRESS FOR NEXT RECORD
	SUB	R4,R5		;DECREASE #BYTES LEFT TO PRINT
11$:	MOVB	(R1)+,(R0)+	;COPY MAP INTO BUFFER
	SOB	R4,11$		; UNTIL RECORD FILLED
	CALL	OUTIT		;PRINT IT
	TST	R5		;ANYTHING LEFT TO PRINT?
	BNE	PRTLUP		;IF SO, BACK FOR ANOTHER RECORD
;
	EXIT$S

	.SBTTL	Subroutines
;+
;SUBROUTINES
;-
;===============================================
;PRMSNM:  PRINT MESSAGE W/ TRAILING NUMBER
; ENTRY W/ R1 = ADDR. OF ASCIZ STRING TO OUTPUT
;	   R2 = VALUE TO APPEND
;	   R3 = FLAG FOR TYPE OF CONVERSION: ZERO=OCTAL, NON-ZERO=DECIMAL
PRMSNM:	MOV	#TEXTBF,R0	;SET START OF OUTPUT BUFFER
	CALL	MOVSTG		;COPY IN THE TEXT
	MOVB	#'=,(R0)+	;SEPARATE MESSAGE FROM VALUE
	MOV	R2,R1		;GET THE VALUE TO CONVERT
	CLR	R2		;SUPPRESS LEADING ZEROS
	MOV	R3,-(SP)	;SAVE R3 FOR USER REUSE
	BEQ	CNVOCT		; AND CONVERT TO OCTAL IF FLAG WAS ZERO
	CALL	$CBDMG		;CONVERT TO DECIMAL MAGNITUDE
	MOVB	#'.,(R0)+	;APPEND DECIMAL POINT
	BR	RESR3
;
CNVOCT:	CALL	$CBOMG		;CONVERT TO OCTAL
RESR3:	MOV	(SP)+,R3	;RESTORE R3
OUTIT:	SUB	#TEXTBF,R0	;CALC. LENGTH OF MESSAGE
	MOV	R0,QIO+Q.IOPL+2 ;SET IN DIRECTIVE PARAM. BLOCK
	DIR$	#QIO		;PRINT #
	RETURN
;===============================================
;
MRKMAP:		;MAIN ENTRY POINT
;ENTRY WITH: 	      R0=ABSOLUTE ADDRESS OF POOL
;		      R1=SIZE OF SEGMENT IN BYTES
;		      @0(SP)=CHAR. TO PUT IN MAP
;  ENTRY AT MRKMP1 W/ R0=REL. ADDRESS IN POOL
;  ENTRY AT MRKMP2 W/ R0= BYTE ADDRESS IN MAP
;
;  EXIT W/ NO-OP & CARRY SET IF MAP OFFSET NEGATIVE, ELSE CARRY CLEAR

	SUB	#$POOL,R0	;ADJUST TO BEGINNING OF POOL
MRKMP1:	ASR	R0		;CONVERT TO SEGMENT NUMBER
	ASR	R0
	ADD	#MAP,R0		;GET START ADDRESS IN MAP
MRKMP2:	CMP	R0,#MAP		;IN MAP AREA?
	BHIS	10$
	SEC			;NO, FLAG ERROR
	RETURN			; & RETURN
;
10$:	ADD	#3,R1		;ROUND SIZE TO NEXT LARGER #SEGMENTS
	ASR	R1
	ASR	R1
STOCH:	MOVB	@0(SP),(R0)+	;STUFF CHAR. IN MAP
	SOB	R1,STOCH	; UNTIL ALL SEGMENTS MARKED
	ADD	#2,(SP)		;MOVE RETURN PAST MARK CHARACTER
	CLC			;SHOW SUCCESSFUL OPERATION
	RETURN			;NOW DONE
;===============================================
;
GTMOFF:				;REF LABEL
; ENTERED W/ POOL ADDRESS IN R0
; EXIT W/ MAP ADDRESS IN R0
; RETURN W/ CARRY SET & NO-OP IF OUTSIDE POOL
	CMP	R0,$EXSIZ	;ABOVE TOP OF POOL?
	BHI	5$		;IF YES, SKIP CONVERSION
	SUB	#$POOL,R0	;1ST GET ADDR. REL TO START OF POOL
	BHIS	10$		;LEGAL IF POSITIVE OFFSET
5$:	SEC			;NO, SHOW ERROR CODE
	RETURN			; & EXIT W/O DOING ANYTHING ELSE
;
10$:	ASR	R0		;THEN GET BLOCK #
	ASR	R0
	ADD	#MAP,R0		;FINALLY CALC. ACTUAL MAP ADDR.
	RETURN
;===============================================
;
CNVASC:				;REF LABEL
;ENTERED W/ HEX VALUE IN R1
;EXIT W/ ASCII VALUE STORED @(R0)+
	ADD	#'0,R1		;CONVERT TO ASCII
	CMP	R1,#'9		;USE HEX IF > 9.
	BLE	11$
	ADD	#<140-'9>,R1	;BUMP TO ASCII 'a'
11$:	MOVB	R1,(R0)+	;INSERT INTO MAP
	RETURN
;===============================================
;
MOVBYT:	MOVB	(R1)+,(R0)+	;COPY A BYTE TO TARGET AREA
MOVSTG:				;REF. LABEL
;ENTERED W/ OUTPUT ADDRESS IN R0
;        W/ INPUT ASCIZ STRING ADDRESS IN R1
	TSTB	(R1)		;AT END OF STRING?
	BNE	MOVBYT
	RETURN			;NOT MUCH OF A ROUTINE, IS IT?
;===============================================
;
GPTSKN:				;REF. LABEL
;ENTERED W/ PCB ADDRESS IN R3 AT ENTRY GPTSKN
;     OR W/ TCB ADDRESS IN R4 AT ENTRY GTTSKN
;OUTPUT IS TASK-NAME IN ASCII STORED AT ADDRESS IN R0
; R0 IS UPDATED TO NEXT BYTE AFTER NAME
	MOV	P.TCB(R3),R4	;GET TCB ADDRESS TO GET TASK NAME
GTTSKN:	MOV	T.NAM(R4),R1	;GET TASK NAME FOR SUBPARTITION
	CALL	$C5TA
	MOV	T.NAM+2(R4),R1
	CALL	$C5TA		;CONVERT THIS 2ND HALF OF NAME
	RETURN			;DONE COPYING IN TASK NAME
;===============================================
;
MRKICB:				;REF. LABEL
;ENTERED WITH R5 CONTAINING A VECTOR ADDRESS WHICH APPEARS TO HAVE
; AN INTRP CONTROL BLOCK IN POOL
	MOV	(R5),R1		;GET ADDRESS OF ICB
	CMP	(R1),#4537	;IS THERE A CALL THERE TO PERHAPS INTSV?
	BEQ	10$		;IF A CALL, PROBABLY OK
	CMP	6(R1),#4537	;IF MULTI-CONTROLLER, THEN CALL IS FARTHER
	BNE	20$		;ELSE IT'S SOMETHING WE CAN'T HANDLE FOR NOW
10$:	CMP	(R1)+,#207	;LOOK FOR STANDARD END OF ICB
	BNE	10$
	SUB	(R5),R1		;CALCULATE SIZE OF ICB
	MOV	(R5),R0		;GET START ADDR. INTO R0
	CALL	MRKMAP		;MARK OFF AREA W/ BLANKS
	.WORD	ICBFIL		;(DON'T EXPECT IT TO BE LARGE)
	MOVB	#'>,-(R0)	;PUT CLOSING MARK AT END
	MOV	(R5),R0		;GET BEGINNING AGAIN
	CALL	GTMOFF		;(IN MAP COORDINATES)
	MOVB	#'<,(R0)+	;MARK AS: '<I '
	MOVB	#'I,(R0)+
	MOVB	#40,(R0)+
	MOV	2(SP),R1	;RETRIEVE DCB ADDRESS FROM STACK
	MOVB	D.NAM(R1),(R0)+	;PUT DEVICE NAME INTO MAP
	MOVB	D.NAM+1(R1),(R0)+
	MOVB	#':,(R0)	;APPEND COLON TO SHOW IT'S A DEVICE
20$:	RETURN			;FINALLY DONE
;===============================================
;
MRKWB:				;REF. LABEL
;ENTERED W/ WINDOW BLOCK ADDRESS IN R0
;MARKS VARIABLE SIZE WINDOW IN MAP
	MOVB	W.WISZ(R0),R1	;THEN GET THE # OF RETRIEVAL POINTERS
	MUL	#6,R1		;CONVERT TO #BYTES IN THE POINTERS
				; FOR 3.2, WE HAVE 2-4 RETREIVAL PTRS
	ADD	#<W.RTRV-W.CTL>,R1 ;ADJUST TO SIZE OF WHOLE WINDOW
	CALL	GTMOFF		;GET START OF WINDOW POINTER IN MAP
	BCS	XITWB		;SKIP THIS ONE IF OUTSIDE POOL
	MOV	R0,-(SP)	;SAVE POINTER
	CALL	MRKMP2		;MARK OFF USED WINDOW AREA
	.WORD	WBFIL		; WITH '========='
	MOVB	#'>,-(R0)	;STICK TRAILING DELIMITER ON
	MOV	(SP)+,R0	;GET BACK START ADDRESS
	MOVB	#'<,(R0)+	;STICK '<WB' AT BEGINNING
	MOVB	#'W,(R0)+
	MOVB	#'B,(R0)+
XITWB:	RETURN
;===============================================
;
;MRKAST: MARK AN AST CONTROL BLOCK - BASED ON KIND OF BLOCK
;ENTRY W/ R3 CONTAINING POSSIBLE START OF LIST OF CONTROL BLOCKS
MRKAST:	BEQ	20$		;RETURN NOW IF NO LIST
	MOV	R3,R0		;GET COPY FOR DESTRUCTIVE USE
	CALL	GTMOFF		;GET CORRESPONDING MAP ADDRESS
	BCS	19$		;ADVANCE TO NEXT IN LIST IF OUTSIDE POOL
	TST	A.CBL(R3)	;WHAT KIND OF BLOCK IS THIS?
	BNE	11$		;IF DEQUEUED ELSEWHERE, ASSUME IT'S A BLOCK
				; RESERVED BY THE TERMINAL DRIVER W/ THE SAME
				; SIZE AS AN I/O PACKET
	MOV	#TTEXT,R1	;MARK IT AS ASSOCIATED W/ FDX TT:
	CALL	MOVSTG
	BR	19$		;THEN CONTINUE W/ NEXT AST BLOCK
;
11$:	MOVB	A.CBL(R3),R1	;CHECK FOR SIZE/TYPE OF AST BLOCK
	BEQ	18$		;IF ZERO, IS A SPECIFY-AST BLOCK - GO DO THAT
	BLT	12$		;IF NOT, IS IT NEGATIVE (SPECIAL TYPE)?
	MOVB	#'[,(R0)+	;MARK AREA DEFINED BY SIZE AS: '[.....]'
	SUB	#4,R1		;ADJUST FOR THE LEADING '['
	BLE	19$		;DONE IF ONLY 4 BYTES LONG
	CALL	MRKMP1		; ELSE INSERT THE '.......'
	.WORD	ASTFIL
	MOVB	#'],-(R0)	;CLOSE AREA W/ TRAILING ']'
	BR	19$		;OFF TO NEXT AST BLOCK
;
;HERE ON NEGATIVE AST BLOCK SIZES
12$:	CMPB	R1,#200		;IS IT FOR BUFFERED I/O?
	BNE	13$
	MOV	#BIOSTG,R1	;YES, MARK IT AS SUCH
	CALL	MOVSTG
	BR	19$		; & ADVANCE TO NEXT IN LIST
;
13$:	CMPB	R1,#300		;IS IT ACTUALLY AN OFFSPRING CONTROL BLOCK???
	BNE	19$		;IF NOT, I'M LOST - GOTO NEXT ONE
	CALL	MRKOCB		;YES, GO MARK IT W/ PARENT NAME
	BR	19$		;ON TO THE NEXT ONE
;
;HERE ON SPECIFY-AST BLOCK
18$:	MOVB	#'[,(R0)+	;MARK THESE W/ '[An]'
	MOVB	#'A,(R0)+
	MOVB	A.CBL+1(R3),R1	;GET THE AST TYPE CODE
	CALL	CNVASC		;CONVERT TO ASCII & INSERT IN MAP
	MOVB	#'],(R0)+	;CLOSE AREA
;
;HERE TO TRY FOR THE NEXT AST BLOCK IN LIST
19$:	MOV	(R3),R3		;GET NEXT LIST ENTRY
	BNE	MRKAST		; & PROCESS IF THERE IS ONE
20$:	RETURN			;END OF AST BLOCK PROCESSING
;===============================================
;
;MRKOCB: MARK AN OFFSPRING CONTROL BLOCK
;ENTRY W/ OCB ADDRESS IN R3
; ASSUMES R0 CONTAINS MAP ADDRESS ALREADY
MRKOCB:	MOVB	#OCBCHR,(R0)+	;MARK START
	MOV	R4,-(SP)	;SAVE R4
	MOV	O.PTCB(R3),R4	;GET PARENT TCB ADDRESS
	BEQ	10$		;OOPS, PARENT GONE
	CALL	GTTSKN		;INSERT PARENT NAME IN MAP
	BR	20$		;PICK UP CODE AFTER ALTERNATE PATH
;
10$:	MOV	O.STAT(R3),R1	;IT APPEARS THAT O.STAT BLOCK HAS PARENT NAME
	CALL	$C5TA		; ALTHOUGH NOT DOCUMENTED ANYWHERE
	MOV	O.STAT+2(R3),R1	;BUT IT'S BETTER THAN NOTHING
	CALL	$C5TA
20$:	MOV	(SP)+,R4	;RESTORE R4
	RETURN			;THAT'S IT - NO ROOM TO MARK CLOSE OF AREA
;===============================================

	.SBTTL	Data Area
;+
;DATA AREA
;-
;LIST OF POOL ANALYSIS ROUTINES FOR DISPATCH
THREAD:	.WORD	THREND		;POINTER TO CURRENT ENTRY

THRLST:	.WORD	STATCB		;TCB's / AD's / AsT's / OCB's
	.WORD	STACLQ		;CLOCK QUEUE CONTROL BLOCKS
	.WORD	STALOG		;ASN CONTROL BLOCKS
	.WORD	STAPAR		;PCB's / HDR's / WB's / SUB-PCB's
	.WORD	STAVCB		;VCB's / FCB's / VSCB's
	.WORD	STADCB		;DCB's / ICB's / UCB's / SCB's / I/O PKT's
	.WORD	STAMCR		;MCR CMD LINES
	.WORD	STAOPK		;UNUSED I/O PKT's
	.WORD	STAMOU		;MCB's
	.WORD	STACKP		;CHECKPOINT PCB's

    .IIF DF A$$CLI .WORD  STACPB  ; CLI Parser Block

THREND:	.WORD	0		;END OF THREADED ROUTINE LIST
;
CURPKT:	.WORD	0		;CURRENT I/O PACKET ADDRESS IN MAP
UNITNO:	.WORD	0		;SAVED UNIT NUMBER DURING UCB/SCB SCAN
BADPC:	.WORD	0		;PC WHERE TRAP OCCURRED
OKPS:	.WORD	0		;SAVED PSW BEFORE TRAP OCCURS
OKSP:	.WORD	0		; SAME FOR SP AFTER SWITCHING TO SYSTEM STATE
OLDODD:	.WORD	0		;ORIGINAL TRAP VECTOR CONTENTS
OLDMPV:	.WORD	0
POOLWD:	.WORD	0
FRGMNT:	.WORD	0
POOLAD:	.BLKW	1		;STARTING ADDRESS FOR PRINTOUT
MAPAD:	.BLKW	1		;STARTING MAP ADDRESS FOR SAME
MAPSIZ:	.WORD	0		;ACTUAL MAP SIZE IN SEGMENTS (4 BYTES EA.)
NAMFLD:	.WORD	0		;ADDRESS OF NAME-FIELD (TEMP. USE)
FRLIST:	.BLKW	2*MAXFRG
QIO:	QIOW$	IO.WVB,1,1,,,,<TEXTBF,0,40>
OUTBUF:				;REF. LABEL
TEXTBF:	.BLKW	40
GMCR:	GMCR$			;GET MCR LINE TO CLEAN POOL

GTIM:	GTIM$	DTEBUF		; Get Date & Time
DTEBUF:	.BLKW	8.	

	.NLIST	BEX		;DON'T NEED TO SEE ALL THE ASCII STRINGS
ODDMSG:	.ASCIZ	/Odd Address Trap @ PC/
MPVMSG:	.ASCIZ	/Mem. Prot. Violation @ PC/
FRGMSG:	.ASCIZ	/# Free Pool Fragments/
POOLMS:	.ASCIZ	/Total Words of Pool/
NFRMSG:	.ASCIZ	/Total Free Words/
SEGMSG:	.ASCIZ	/Free Segment List:/
DTEMSG:	.ASCIZ	<14>/d-mmm-yy   hh:mm/
MAPMSG:	.ASCII	/Pool Map................|...............|/
	.ASCIZ	/...............|.............../
IOP:	.ASCIZ	/<IO=DVn:>/
TTEXT:	.ASCIZ	/[FDX TT:]/
BIOSTG:	.ASCIZ	/[BIO TT:]/
PKTOPT:	.ASCIZ	/<Pkt Opt>/
HDRSTG:	.ASCIZ	/<Header /
DCBSTG:	.ASCIZ	/<DCB+UCB+SCB = /
VCBSTG:	.ASCIZ	/<VCB === /		; Modified for 11M-V4.0
VSCBTG:	.ASCIZ	/<VSCB = /		; Added for 11M-V4.0
VMVLTG:	.ASCIZ	/<MVL/			; Added for 11M-V4.0
VUVLTG:	.ASCIZ	/<UVL/			; Added for 11M-V4.0
CPBSTG:	.ASCIZ	/<CPB/			; Added for 11M-V4.0
FCBSTG:	.ASCIZ	/<FCB @/
TCBSTG:	.ASCIZ	/<TCB ====== /		; Modified for 11M-V4.0
MCRSTG:	.ASCIZ	/<MCR Line for /
CKPSTG:	.ASCIZ	/<CP>/
	.IFDF V$$D11
VDASTG:	.ASCIZ	/<VD/
VDBSTG:	.ASCIZ	/: EXT>/
	.ENDC
PDVSTG:	.ASCIZ	/:  )/
	.EVEN
	.REPT	8.		;LEADING PAD OF BLANKS
	.ASCII	/        /
	.ENDR
MAP::	.BLKB	6*1024.		;ENOUGH ROOM FOR 12.K WORDS OF POOL

	.END	OPA