.TITLE	POOLFL - GET POOL-FRAGMENT LIST
	.IDENT	/JN2.20/
;LAST MODIFIED 791020.
;WRITTEN BY J. NEELAND
;
	.LIST	MEB		;NEED TO SEE ALL CODE FOR DEBUGGING
	.ENABL	LC		;ALLOW LOWER-CASE I/O AND LISTING
;
	.MCALL	QIOW$,DIR$,EXIT$S,GMCR$
	.MCALL	F11DF$,UCBDF$,DCBDF$,TCBDF$,PCBDF$,SCBDF$
	F11DF$
	UCBDF$
	DCBDF$
	TCBDF$
	SCBDF$
;
	MAXFRG=100.
;
POOLFL::			;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 'UUUUU' FOR UNKNOWN/USED
	MOV	MAPSIZ,R2
	MOV	#'U,R1
5$:	MOVB	R1,(R0)+
	SOB	R2,5$
	CALL	$SWSTK,END	;GET ONTO SYSTEM STACK TO LOOK AT POOL
	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	'-		; 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

;+
;NOW MARK TCB'S W/ THEIR NAMES
;-
	MOV	$TSKHD,R4	;GET FIRST TCB
10$:	MOV	R4,R0		;COPY ADDR. FOR DISTRUCTIVE USE
	CALL	GTMOFF		;GET MAP OFFSET
	BCS	12$		;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	18$		;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
20$:	MOV	T.TCBL(R4),R4	;GET NEXT TCB
	BNE	10$		; UNTIL END OF LIST
;
ENDTCB:				;REF LABEL
;+
;NOW DO CLOCK-QUEUE CONTROL BLOCKS (AN EASY ONE)
;-
	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	15$		;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)+
15$:	MOV	C.LNK(R3),R3	;GET NEXT CONTROL BLOCK IF ANY
	BNE	10$		; AND MARK THAT ONE
;
ENDCLQ:				;REF LABEL
;+
;NOW MARK ASN CONTROL BLOCKS (ANOTHER EASY ONE)
;-
	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	15$		;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
15$:	MOV	L.LNK(R3),R3	;GET NEXT ASN BLOCK IF IT EXISTS
	BNE	10$
;
ENDLOG:				;REF LABEL

;+
;NOW TRY TO DO PARTITION-CONTROL-BLOCKS
;-
	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	PARSYS		;IGNORE 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
	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
	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	'#		; W/ '#######'
	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
;
PARSYS:	BIT	#PS.SYS,P.STAT(R3) ;IS THIS A SYSTEM-CONTROLLED PARTITION?
	BEQ	10$
	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
10$:	MOV	P.LNK(R3),R3	;GET NEXT MAIN PCB
	BNE	PARNXT		; UNLESS AT END OF LIST
	BR	PAREND		;THEN DONE W/ PCB'S
;
NTMAIN:	MOVB	#'/,(R0)+	;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)+
	MOVB	#':,(R0)+	;APPEND COLON TO SHOW A DEVICE NAME
	MOVB	#40,(R0)+	;FILL OUT W/ SPACES
	MOVB	#40,(R0)+
	BR	TRLPAR		; & PICK UP MAIN LINE W/ TRAILING PAREN
;
PAREND:				;REF. LABEL

;+
;NOW TRY TO PICK UP VOLUME-CONTROL-BLOCKS & FILE-CONTROL BLOCKS
;-
	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
	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)+
;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	NXTFCB		;SKIP TO NEXT ONE 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.
	MOVB	W.WISZ(R0),R1	;THEN GET THE # OF RETRIEVAL POINTERS
	ASL	R1
	ASL	R1		;CONVERT TO #BYTES IN THE POINTERS
	ADD	#<W.RTRV-W.CTL>,R1 ;ADJUST TO SIZE OF WHOLE WINDOW
	CALL	GTMOFF		;GET START OF WINDOW POINTER IN MAP
	BCS	NXTUNT		;SKIP THIS ONE IF OUTSIDE POOL
	MOV	R0,-(SP)	;SAVE POINTER
	CALL	MRKMP2		;MARK OFF USED WINDOW AREA
	.WORD	'=		; 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)+
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
;
VCBEND:				;REF. LABEL

	.IF DF	Q$$OPT
;+
;NOW GET ANY CURRENTLY UNUSED I/O PACKETS FROM I/O OPTIMIZATION
;-
	MOV	#$PKAVL,R2	;GET POINTER TO PACKET TAIL
	MOV	(R2)+,R0	;GET ADDRESS OF 1ST PACKET
	BEQ	OPKEND		;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
	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?
OPKEND:				;REF. LABEL
	.ENDC	;Q$$OPT

;+
;NOW FIND ANY DEVICE DRIVER DATA STRUCTURES IN POOL
; OR PERHAPS JUST INTERRUPT CONTROL BLOCKS
;-
	MOV	$DEVHD,R0	;GET START OF DCB'S
TSTDCB:	MOV	R0,-(SP)	;SAVE DCB PTR; R0 WILL BE USED DESTRUCTIVELY
	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
	CLR	R4		;INIT. TO SEARCH FOR NEW SCB ADDRS.
	MOV	D.UCB(R0),R3	;GET 1ST UCB
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
	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	NXTUCB		;IF NOT, GO TO NEXT UCB
;NOW LET'S MARK OFF AN ICB (OR POSSIBLY 2)
	MOV	R1,-(SP)	;SAVE R1 FOR MAIN-LINE CODE
	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
	CALL	MRKICB		;THIS MAY NOT BELONG, BUT BEST I CAN DO
CLEANS:	MOV	(SP)+,R1	;RESTORE R1
	MOV	(SP),R0		; & GET FRESH COPY OF R0 FROM STACK
NXTUCB:	ADD	D.UCBL(R0),R3	;ADVANCE UCB POINTER TO NEXT UCB
	SOB	R2,TSTSCB	; & DECR. COUNT OF REMAINING UCB'S
	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	'%		;FILL AREA W/ '%%%%%%%'
	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
	BNE	TSTDCB		;IF NOT AT END, BACK TO EXAMINE THIS NEW ONE
;+
;NOW LOOK FOR MCR LINES NOT YET READ
;-
	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	20$		;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
20$:	MOV	(R3),R3		;GET NEXT MCR LINE ADDRESS
	BR	10$		;AND GO TRY OUT THAT ONE
ENDMCR:				;REF. LABEL
;
XITSYS:	RETURN			;BACK TO USER STACK

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	#TEXTBF,QIO+Q.IOPL ;INIT. QIO TO 1ST BUFFER AREA
	MOV	FRGMNT,R1
	CALL	PRTNUM		;PRINT #FRAGMENTS
	MOV	POOLWD,R1
	ASR	R1		;CONVERT TO # WORDS
	CALL	PRTNUM		;PRINT POOL SIZE
	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
	SUB	#TEXTBF,R0	;CALC. LENGTH OF MSG
	MOV	R0,QIO+Q.IOPL+2 ;SET IN DIRECTIVE
	DIR$	#QIO		;PRINT SEGMENT INFO
	SOB	R5,PRSEG	;KEEP GOING UNTIL ALL SEGMENTS DONE
	MOV	R3,R1		;PRINT TOTAL OF FREE SEGMENTS
	CALL	PRTNUM
;NOW PRINT MAP IN ROWS OF 64 CHARS.
	MOV	#MAP,QIO+Q.IOPL	;START AT BEGINNING
	MOV	#64.,QIO+Q.IOPL+2 ;NORMAL RECORD SIZE
	MOV	MAPSIZ,R1	;OUTPUT ALL OF MAP AREA THAT'S POOL
PRTLUP:	SUB	#64.,R1		;;DECR. AMOUNT REMAINING TO PRINT
	BLE	10$		;LAST RECORD IF COUNT NOT POSITIVE
	DIR$	#QIO		;PRINT AN INTERMEDIATE RECORD
	ADD	#64.,QIO+Q.IOPL	;ADVANCE BUFFER POINTER
	BR	PRTLUP		; AND GO DO ANOTHER
;
10$:	ADD	#64.,R1		;ELSE RESTORE THE SMALLER SIZE
	MOV	R1,QIO+Q.IOPL+2	;SET IT,
	DIR$	#QIO		;AND PRINT IT AS LAST RECORD
	EXIT$S

;+
;SUBROUTINES
;-
PRTNUM:	MOV	#TEXTBF,R0	;SET START OF OUTPUT BUFFER
	CLR	R2		;SUPPRESS LEADING ZEROS
	CALL	$CBDMG		;CONVERT TO DECIMAL MAGNITUDE
	MOVB	#'.,(R0)+	;APPEND DECIMAL POINT
	SUB	#TEXTBF,R0	;CALC. LENGTH OF MESSAGE
	MOV	R0,QIO+Q.IOPL+2 ;SET IN DIRECTIVE PARAM. BLOCK
	DIR$	#QIO		;PRINT # FRAGMENTS
	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 MRKMP1 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 OFFSET NEGATIVE, ELSE CARRY CLEAR
	SUB	#$POOL,R0	;1ST GET ADDR. REL TO START OF POOL
	BHIS	10$		;LEGAL IF POSITIVE OFFSET
	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	#<'@-'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
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	40		;(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	4(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
	RETURN			;FINALLY DONE

;+
;DATA AREA
;-
POOLWD:	.WORD	0
FRGMNT:	.WORD	0
FRLIST:	.BLKW	2*MAXFRG
QIO:	QIOW$	IO.WVB,1,1,,,,<TEXTBF,0,40>
TEXTBF:	.BLKW	40
GMCR:	GMCR$			;GET MCR LINE TO CLEAN POOL
PKTOPT:	.ASCIZ	/<PKT OPT>/
HDRSTG:	.ASCIZ	/<HEADER /
DCBSTG:	.ASCIZ	/<DCB+UCB+SCB = /
VCBSTG:	.ASCIZ	/<VCB=/
FCBSTG:	.ASCIZ	/<FCB @/
TCBSTG:	.ASCIZ	/<TCB = /
MCRSTG:	.ASCIZ	/<MCR LINE FOR /
	.EVEN
MAP::	.BLKB	5*1024.		;ENOUGH ROOM FOR 10.K WORDS OF POOL
MAPSIZ:	.WORD	0		;ACTUAL MAP SIZE IN SEGMENTS (4 BYTES EA.)
NAMFLD:	.WORD	0		;ADDRESS OF NAME-FIELD (TEMP. USE)
;
	.END	POOLFL