.TITLE	CPA - CRASH POOL ANALYZER

	.IDENT	/JN4.0E/

	.LIST	MEB		; Need to see all code for debugging
	.ENABL	LC		; Allow lower-case I/O and listing


; Written by J. Neeland
;
; Modified 27-Jan-80 by Wayne R. Graves
;		Run on 3.2 & from crash dumps
;		Protection from writing out of map area
;		Handle the null task properly
;		Increased vcb label by 6 words
;		Increased tcb label by 4 words
;		Use FCS for listing rather than QIO's (output to a file)
;		Added mount control blocks
;		Added checkpoint pcb
;		Added minor tests for validity of data
;		Corrected size of window blocks
;		Added support for Stammerjohn's vd: driver
;
; MODIFIED 800419. BY J. NEELAND 
;		TO BE APPROX. EQUIV TO OPA (ONLINE POOL ANALYZER)
; 
; Modified 800818 by C.H. Stockley
;		Fixed handling of Dynamic Region Sub-Partitions
;
; Modified 801121 by D.C. Pulsipher
;		Add receive packets
;		RECEIVE DATA		; T.RCVL
;		RECEIVE BY REFERENCE	; T.RRFL
;
;		CHECK FOR VERY BAD HEADER LENGTH ; SIZCHK
;
;		MARK FORK BLOCKS	; FORKBLOCK
;
; Modified 810518 by D.C. Pulsipher
;		Fix Driver and Dynamic Partition handling
;		 to ignore Header pointer
;
; Modified 21-SEP-82 by C.H.Stockley
;		For RSX11M-V4.0		TCB's  VCB's
;					VSCB's MVL's  UVL's
;					CPB's

	.MCALL	QIOW$,DIR$,EXIT$S
	.MCALL	F11DF$,MTADF$,UCBDF$,DCBDF$,TCBDF$,PCBDF$,SCBDF$

 V$$D11=0  	; Handle VD: Virtual Disk Driver


; define lun to be used for gcml<can't be 5 if command file used>
INLUN=1		; Lun for input file
OUTLUN=2	; Lun for output file
GCMLUN=4
TILUN=5		; Terminal lun
TIEVF=5		; Terminal event flag

ASTFIL='.
ERRFIL='=
FREFIL='-
HDRFIL='=
ICBFIL=' 
UCBFIL='=
WBFIL='=

DYNCHR='~
OCBCHR='&
SUBCHR='/

	.MCALL	FSRSZ$,FDBDF$,FDRC$A,FDBK$A,FDOP$A,NMBLK$,FDAT$A,FDOF$L
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND
	.MCALL	FINIT$,OPEN$R,CLOSE$,READ$,WAIT$,OPEN$W,PUT$S

.MACRO	MSGOUT	MESSAG
	.NLIST
	.PSECT	$$$MSG
	$$$=.
	.ASCIZ	^MESSAG^
	.PSECT
	.LIST
	CALL	OUTMSG
	.WORD	$$$
.ENDM

	F11DF$
	MTADF$
	UCBDF$
	DCBDF$
	TCBDF$
	SCBDF$
 
	MAXFRG=100.		; Max # of pool fragments handled
; Switch Definitions
	MF.HLP=1		; /HE switch mask
	MF.TCB=4		; /TC -- Skip TCB's
	MF.CKP=^O10		; /CP -- Skip Checkpoint PCB's (Both kinds)
	MF.CLQ=^O20		; /CQ -- Skip Clock Queue
	MF.PCB=^O40		; /PC -- Skip PCB's
	MF.HDR=^O100		; /HD -- Skip Task Headers
	MF.WB=^O200		; /WB -- Skip Window blocks (in both places)
	MF.MVL=^O400		; /MV -- Skip Mounted Volume Scan
	MF.VCB=^O1000		; /VC -- Skip VCB's
	MF.VSC=^O2000		; /VS -- Skip VSCB's
	MF.DEV=^O4000		; /DV -- Skip Device stuff (DCB, UCB, SCB, etc.)
	MF.SCB=^O10000		; /SC -- Skip SCB's
	MF.ICB=^O20000		; /IC -- Skip ICB's
	MF.FRG=^O40000		; /FR -- Skip Free Fragment List
;
	POLSIZ=120000		; Area reserved for copy of EXEC, up to
				;  top of pool
	FIRSTH=51000		; Size of first large chunk to read
	FIRSTB=FIRSTH/512.	; Number of blocks in firsth
	SECONH=44000		; Second large chunk to read
	SECONB=SECONH/512.	; Number of blocks in second chunk
	VECSIZ=512.		; Size of vector area to read in
				; Should be on a block boundry

; buffer
;
bufi0=2000
	.BLKB	POLSIZ		; Leave space for copy of EXEC including POOL
	.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
;	(ctasknm)			Checkpointed file 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	CPA Entry Point
 
CPA::				; Entry point for Crash Pool Analyzer
	CALL	GCMLIN		; Go asn file names
	.NLIST	MEB		; Don't expand FCS calls
	MOV	#1,BKVB+2	; Initialize block number
	READ$	#FDB,#BUFI0,#VECSIZ,#BKVB ; get a buffer full
	BCC	10$		; If C set error
	IOT
	1
10$:
	WAIT$	#FDB,#10.;,IOST
	BCC	20$		; If C set error
	IOT
	2
20$:
	ADD	#<BUFI0+VECSIZ>/512.,BKVB+2 ; Skip block 2-3
	READ$	#FDB,#BUFI0+VECSIZ,#FIRSTH,#BKVB ; get a buffer full
	BCC	15$		; If C set error
	IOT
	1
15$:
	WAIT$	#FDB,#10.;,IOST
	BCC	25$		; If C set error
	IOT
	2
25$:
	ADD	#FIRSTB,@#BKVB+2 ; Now for second half
	READ$	#FDB,#BUFI0+VECSIZ+FIRSTH,#SECONH,#BKVB ; Second half starts
				;  after end of 1st transfer
	BCC	30$		; If C set error
	IOT
	3
30$:
	WAIT$	#FDB,#10.;,IOST
	BCC	300$		; If C set error
	IOT
	4
300$:
	CLOSE$	#FDB
	MSGOUT <Transfer Complete>
	.LIST	MEB		; Restore expansion for debugging
;
POOLST:	MOV	#64.,R0		; Clear 64. bytes in front of map area
	MOV	MAP,R1		;  used for prettier output format
1$:	MOVB	#40,-(R1)
	SOB	R0,1$
	MOV	@#$EXSIZ,R0	; Calc. total pool space
	.ENABL	LSB
	CMP	R0,#120000	; Check that it's a valid value
	BHI	2$		; Can't do anything if not valid
	BIT	#1,R0		; Also must be even
	BNE	2$
	SUB	#$POOL,R0
	MOV	R0,POOLWD	; Save value
	BGT	OKSIZ		; Top had better be larger than bottom
2$:	MSGOUT	<*** Bad top of pool - fatal>
FATXIT:	EXIT$S

OKSIZ:	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
5$:	MOVB	#'?,(R0)+
	SOB	R2,5$
	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

; Now lets do some checking for validity

	CMP	R2,#$POOL	; Is the segment below pool bottom ?
	BLO	20$		; If yes, branch
	CMP	R2,@#$EXSIZ	; Is it above upper limit ?
	BLO	30$		; OK if below
20$:	MSGOUT <*** Pool list out of range> ; Put out error message & end poolst
	BR	ENDFRE		; Use what we have
30$:	BIT	#1,R2		; Is it an even address ?
	BEQ	40$		; If yes, branch
	MSGOUT <*** Pool list bad link> ; Put out error message & end poolst
	BR	ENDFRE		; Use what we have
40$:	SUB	#$POOL,R0	; Calc. addr. relative to start of pool
	MOV	R2,(R5)+	; Save rel. address
	CMP	2(R2),@#POOLWD	; Is size of pool segment smaller then pool ?
	BMI	50$		; If yes, branch
	MSGOUT	<*** Pool list segment too large> ; Error msg & end poolst
	BR	ENDFRE		; Use what we have
50$:	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
	.DSABL	LSB
	.PAGE
	.SBTTL Task Control Blocks
;+
; Now mark TCB's w/ their names
;-
	.ENABL	LSB
	MOV	$TSKHD,R4	; Get first TCB
	BIT	#MF.TCB,FLGWD1
	BNE	ENDTCB
10$:	MOV	R4,R0		; Copy addr. for distructive use
	ASR	R0		; Check for odd address
	BCS	ENDTCB		; Quit chain if so
	CALL	GTMOFA		; Get map offset
	BCS	20$		; 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	#A.TCBL,R0	; Adjust to beginning of block
	ASR	R0		; Check for odd address
	BCS	185$
	CALL	GTMOFA		; 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

;Check for 'simple' AST control blocks

185$:	MOV	T.SAST(R4),R3	; Are there any specified AST control blocks?
	BEQ	19$		; No if pointer is zero
	CALL	MRKAST		; Go mark them off.
19$:	MOV	T.ASTL(R4),R3	; Are there any ACTIVE AST blocks queued?
	BEQ	20$
	CALL	MRKAST		; Go mark them off too.
20$:
	MOV	T.OCBH(R4),R3	; Look for Offspring Control Blocks.
	BEQ	205$
201$:	MOV	R3,R0		; GET A COPY FOR DESTRUCTIVE USE
	ASR	R0		; Check for odd address
	BCS	205$
	CALL	GTMOFA		; Get the offset from beginning of pool
	BCS	20$		; Ignore if outside of pool
	CALL	MRKOCB		; Go mark the OCB.
	MOV	(R3),R3		; Get next the one in the list
	BNE	201$		;  & process it. (if there is one)
205$:
	MOV	T.RCVL(R4),R0	; Receive queue? ; T.RCVL
	BEQ	25$		; None -- proceed with next TCB ; T.RCVL
21$:
	MOV	R0,R3		; Save a copy ; T.RCVL
	ASR	R0		; Check for odd address ; T.RCVL
	BCS	25$		; T.RCVL
	CALL	GTMOFA		; Get address in map ; T.RCVL
	BCS	25$		; Continue if not in pool ; T.RCVL
	MOVB	#'/,(R0)+	; T.RCVL
	CALL	GTTSKN		; Copy in task name ; T.RCVL
	MOVB	#'D,(R0)+	; T.RCVL
	MOVB	#'\,(R0)+	; T.RCVL
	MOV	(R3),R0		; Get next message ; T.RCVL
	BNE	21$		; Go back if more messages ; T.RCVL
25$:					; T.RCVL
	MOV	T.RRFL(R4),R0	; Receive BY REF queue? ; T.RRFL
	BEQ	27$		; None -- proceed with next TCB ; T.RRFL
26$:				; T.RRFL
	MOV	R0,R3		; Save a copy ; T.RRFL
	ASR	R0		; Check for odd address ; T.RRFL
	BCS	27$		; T.RRFL
	CALL	GTMOFA		; Get address in map ; T.RRFL
	BCS	27$		; Continue if not in pool ; T.RRFL
	MOVB	#'/,(R0)+	; T.RRFL
	CALL	GTTSKN		; Copy in task name ; T.RRFL
	MOVB	#'R,(R0)+	; T.RRFL
	MOVB	#'\,(R0)+	; T.RRFL
	MOV	(R3),R0		; Get next message ; T.RRFL
	BNE	26$		; Go back if more messages ; T.RRFL
27$:					; T.RRFL
	; Checkpointed file Sub-partition Control Block

	BIT	#TS.CKP,T.STAT(R4)	; Is it checkpointed?
	BEQ	271$			;  No
	BIT	#TS.OUT,T.STAT(R4)	; Is it out-of-memory?
	BEQ	271$			;  No
	BIT	#MF.CKP,FLGWD1
	BNE	271$
	MOV	T.PCB(R4),R0		; PCB address
	ASR	R0			; Check for odd address
	BCS	271$			; Ignore if Odd
	CALL	GTMOFA			; Convert to Map address
	BCS	271$			; Outside of Map
	MOVB	#'(,(R0)+		; Tag as "(cxxxxxx)"
	MOVB	#'c,(R0)+
	CALL	GTTSKN			; Copy in Task name
	MOVB	#'),(R0)+		; Add terminator

271$:
	MOV	T.TCBL(R4),R4	; Get next TCB
	BEQ	ENDTCB		; Until end of list
	TST	T.TCBL(R4)	; Is this the null task
	BNE	10$		; If no continue
; 
ENDTCB:				; Ref. label
	.DSABL	LSB
	.PAGE
	.SBTTL	Clock-Queue Control Blocks
; +
; Now do clock-queue control blocks (an easy one)
; -
	.ENABL	LSB
	MOV	$CLKHD,R3	; Get first control block
	BEQ	ENDCLQ		; Maybe there aren't any????
	BIT	#MF.CLQ,FLGWD1
	BNE	ENDCLQ
10$:

; Check for odd link address

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** Clock que bad link>	; Put out error message
	BR	ENDCLQ		; End clq scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If yes, branch
	MSGOUT	<*** Clock que link out of range> ; Put out error message
	BR	ENDCLQ		; And end clq check
120$:	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
	.DSABL	LSB

	.SBTTL	ASN Control Blocks
;+
;Now mark asn control blocks (another easy one)
;-
	.ENABL	LSB
	MOV	$LOGHD,R3	; Get 1st one
	BEQ	ENDLOG		; If it exists, else skip out
10$:

; Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** ASN cb bad link> ; Put out error message
	BR	ENDLOG		; End ASN control block scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If yes,branch
	MSGOUT	<*** ASN cb link out of range> ; Put out error message
	BR	ENDLOG		;  and end ASN check
120$:	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
	.DSABL	LSB
	.PAGE
	.SBTTL	CLI Parser Blocks  '<CPBn>'
;+
;Now mark CLI Parser Blocks
;-
     .IF DF	A$$CLI

	.ENABL	LSB
	CLR	R2		; Initialize CLI count
	MOV	#$CPTBL+2,R3	; Point to 1st alternate CLI in table
	BEQ	ENDCPB		;   Done if zero

10$:	

; Time for a check

	BIT	#1,(R3)		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** CPB cb bad link> ; Put out error message
	BR	115$		; Try next one
100$:	CMP	(R3),@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If yes,branch
	MSGOUT	<*** CPB cb link out of range> ; Put out error message
115$:	INC	R2		; Bump CLI count
	TST	(R3)+		; Bump pointer to next CLI entry
	BR	20$		;  Try next CPB
120$:	
	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:				; Ref. Label

	.DSABL	LSB
	.ENDC		;A$$CLI
	.PAGE
	.SBTTL	Partition Control Blocks
;+
;Now try to do partition-control-blocks
;-
	.ENABL	LSB
	MOV	$PARHD,R3	; Get pointer to 1st PCB

; Should we even consider this?

	BIT	#MF.PCB,FLGWD1
	BEQ	PARNXT
	JMP	ENDPAR		; No.
PARNXT:

; Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** PCB bad link>	; Put out error message
	JMP	ENDPAR		; End pcb scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If yes, branch
	MSGOUT	<*** PCB link out of range> ; Put out error message
	JMP	ENDPAR		;  and end PCB scan
120$:	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
XFRNAM:	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

	BIT	#MF.HDR,FLGWD1
	BNE	PARSYS
	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 this really the TCB for this PCB?
	BNE	PARSYS		; If NE, no.

;	TST	P.ATT(R3)	; Attached?
;	BEQ	PARSYS		;  If EQ, NO -- No task here.  ???

	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 its length
	CALL	GTMOFF		; Get offset into map
	BCS	PARSYS		; If C set, wasn't in pool area
	BIT	#176000,R1	; Check for HEADER length >2000 bytes ; SIZCHK
	BNE	PARSYS		; Not likely, SKIP it ; SIZCHK
	MOV	R0,-(SP)	; Save start offset address
	CALL	MRKMP2		; Mark the whole header area
	.WORD	HDRFIL		; W/ Fill character
	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+2,R2	;MOVE POINTER TO 1ST WINDOW POINTER
GTWB:	MOV	(R2)+,R0	;GET WINDOW ADDRESS
	BEQ	NOWB		;SKIP IF NO WINDOW
	BIT	#1,R0		;CHECK IF APPROX. VALID ADDRESS
	BNE	NOWB		;IGNORE IF NOT
	BIT	#MF.WB,FLGWD1
	BNE	NOWB
	CALL	MRKWB		;GOOD ONE, GO MARK IT IN MAP
NOWB:	TST	(R2)+		;SKIP TO NEXT WINDOW BLOCK
	DEC	(SP)		;DECR. COUNT OF LUNS TO TEST
	BNE	GTWB		; & TRY ANOTHER
ENDHDR:	TST	(SP)+		;REMOVE EXHAUSTED COUNT FROM STACK
 
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	ENDPAR		; Then done w/ pcb's
 
NTMAIN:	MOVB	#SUBCHR,(R0)+	; Mark as a sub-partition cntl block
	BIT	#PS.DRV,P.STAT(R3) ; Is this a driver subpartition?
	BNE	20$
	BIT	#PS.COM,P.STAT(R3) ; Is this a Dynamic Region subpartiton?
	BNE	30$
	CALL	GPTSKN		; No, put in task name
	BR	TRLPAR		; & pick up main line w/ trailing paren.
 
20$:	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)+
	MOVB	#'),(R0)+	; and append trailing paren.
	BR	PARSYS		; Then process next partition.
 
30$:	TSTB	-(R0)		; Change "/" to "~" for dynamic reg.
	MOVB	#'~,(R0)+
	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:				; Ref. label
	.DSABL	LSB
	.PAGE
	.SBTTL	Volume-Control-Blocks
;+
;Now try to pick up 	volume-set-control-blocks (magtape) or
;			volume-control-blocks & file-control blocks
;-
	.ENABL	LSB
	MOV	$DEVHD,R3	; Start with the list of devices

; Should we skip Mounted Volume stuff?

	BIT	#MF.MVL,FLGWD1
	BEQ	CHKDEV
	JMP	ENDVCB		; Yes.
CHKDEV:

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** DCB bad link>	; Put out error message
	JMP	ENDVCB		; End vcb scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If no, branch
	MSGOUT	<*** DCB link out of range> ; Put out error message
	JMP	ENDVCB		;  and end VCB check
120$:	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	10$		; If not, go try for another device
	BIT	#DV.F11,U.CW1(R2) ; Is it FILES-11?
	BNE	20$		; If yes branch
10$:	JMP	NXTDEV		; If no, try another device
20$:	BITB	#US.MNT,U.STS(R2) ; Okay, is it actually mounted
	BEQ	30$		; If yes branch
	JMP	NXTUNT		; If no, check the next unit
30$:	BIT 	#DV.SQD,U.CW1(R2)	; Is it a sequential (Magtape) device
	BEQ	40$			; If not set, No
	JMP	GTVSCB			; If set, get VSCB instead

40$:	BIT	#MF.VCB,FLGWD1
	BEQ	41$
	JMP	NXTUNT
41$:
	MOV	U.VCB(R2),R0	; Aha!, got one.  get address of VCB
	ASR	R0		; Check for odd address
	BCS	FNDFCB		; End chain if so
	CALL	GTMOFA		; 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
	MOV	R1,-(SP)	; Insert in map
	MOVB	R1,(R0)+
	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
	ASR	R0		; Check for Odd address
	BCS	ENDVDS		; Ignore if Odd
	CALL	GTMOFA		; 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
	CALL	MAPOUT		; Now for the stacked unit #
	MOV	#VDBSTG,R1	; Point to ending ': ext>'
	CALL	MOVSTG		; Stuff it
ENDVDS:
	.ENDC			; V$$D11

	.DSABL	LSB

	.SBTTL	File Control Blocks

;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
	ASR	R0		; Check for odd address
	BCS	GETWB		; If so, try something else
	CALL	GTMOFA
	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.
	BIT	#MF.WB,FLGWD1
	BNE	NXTUNT
	CALL	MRKWB

NXTUNT:	ADD	R4,R2		; Advance to next UCB
	DEC	R5		;  until no more units
	BEQ	NXTDEV		; If none left branch
	JMP	TSTUCB
NXTDEV:	MOV	(R3),R3		; Move to next device in chain
	BEQ	ENDVCB		; Zero ends it
	JMP	CHKDEV		; And go check if it's a FILES-11 type
 
	.PAGE
	.SBTTL	Volume-Set-Control-Block (Magtape)

GTVSCB:		; Get VSCB for Magtape

	BIT	#MF.VSC,FLGWD1
	BNE	NXTUNT
	MOV	U.VCB(R2),R0	; Get address of VSCB 
	ASR	R0		; Check for odd address
	BCS	NXTUNT		; End chain if so
	CALL	GTMOFA		; 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

	MOV	R1,-(SP)	; ????  Why save this on the Stack  ?????

	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
	ASR	R0		; Check for odd address
	BCS	20$		; If so try Unmounted Volume list
	CALL	GTMOFA		; 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
	ASR	R0		; Check for odd address
	BCS	NXTUNT		; If so try next Unit
	CALL	GTMOFA		; Get offset in Map
	BCS	NXTUNT		; Ignore if outside Pool
	MOV	#VUVLTG,R1	; Mark '<UVL'
	CALL	MOVSTG

	BR	NXTUNT		; Next UCB

ENDVCB:				; Ref. label

	.PAGE
	.SBTTL	Unused I/O Packets

	.IF DF	Q$$OPT
;+
;Now get any currently unused I/O packets from I/O optimization
;-
	.ENABL	LSB
	MOV	#$PKAVL,R3	; Get pointer to packet tail
	MOV	(R3)+,R0	; Get address of 1st packet
	BEQ	ENDOPK		; Done if none avail.
	MOVB	(R3),R2		; Get count of packets avail.
OPKLUP:	MOV	R0,R3		; Save copy of r0

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** IO pkt bad link>	; Put out error message
	JMP	ENDOPK		; End opk scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLOS	120$		; If no, branch
	MSGOUT	<*** IO pkt link out of range> ; Put out error message
	JMP	ENDOPK		; And end opk scan
120$:	CALL	GTMOFF		; Convert to offset in map
	BCS	ENDOPK
	MOV	#PKTOPT,R1	; Get string address to insert in map
	CALL	MOVSTG		; Insert '<Pkt Opt>'
	MOV	(R3),R0		; Get next packet address
	SOB	R2,OPKLUP	; Any left to do?
ENDOPK:				; Ref. label
	.DSABL	LSB
	.ENDC	; Q$$OPT
	.PAGE
	.SBTTL	Device Driver DATA Structures & Interrupt Control Blocks
;+
;Now find any device driver data structures in pool
; or perhaps just interrupt control blocks
;-
	.ENABL	LSB
	MOV	$DEVHD,R0	; Get start of DCB's
	BIT	#MF.DEV,FLGWD1
	BEQ	TSTDCB
	JMP	ENDDCB
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) ; Pseudo device?
	BEQ	13$		; NO -- Continue
	JMP	NXTDCB		; YES -- Get the next one
13$:	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
	CLR	R4		; Init. to search for new SCB addrs.
TSTSCB:

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** SCB bad link>	; Put out error message
	BR	110$		; End data structures scan
100$:	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If no, branch
	MSGOUT	<*** SCB link out of range> ; Put out error message
110$:	TST	(SP)+		; Pop DCB off stack
	JMP	ENDDCB		; And end data structure scan
120$:

;;;	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
	BIT	#MF.SCB,FLGWD1	; Skip this stuff?
	BNE	NXTUCB

;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
	BIT	#1,R5		;Odd address?
	BEQ	12$		; NO
	MSGOUT	<*** ODD I/O packet link>
	BR	DOVEC
12$:	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
11$:	MOVB	(R1)+,(R0)+
	DEC	(SP)
	BNE	11$
	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
	ADD	#BUFI0,R5	; Add offset of buffer for crash dumps
	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)

	BIT	#MF.ICB,FLGWD1
	BNE	NXTUCB
	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
NXTUCB:	MOV	(SP),R0		; Get a fresh copy of DCB from stack
	ADD	D.UCBL(R0),R3	; Advance UCB pointer to next UCB
	INC	UNITNO
	DEC	R2		;  & decr. count of remaining UCB's
	BNE	TSTSCB
	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
	ASR	R0		; Check if address is odd
	BCS	NXTDCB		; Quit if so
	CALL	GTMOFA		; Convert to offset in pool map
	BCS	NXTDCB		; Give up if bad
	MOV	R0,-(SP)	; Save start of area
	CALL	MRKMP2
	.WORD	UCBFIL		; Fill area w/ UCBFIL character
	DEC	R0		; Back up one char
	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 end, branch
	JMP	TSTDCB		; If not at end, back to examine this new one
ENDDCB:				; Ref. label
	.DSABL	LSB
	.PAGE
	.SBTTL Fork Blocks

;+
; Now mark active FORK BLOCKS.
;-
FORKQ:
	MOV	$FRKHD,R0	; Get FORK LIST HEAD ; FORKBLOCK
10$:
	MOV	R0,R3		; Save FORK BLOCK ADDRESS ; FORKBLOCK 
	BEQ	50$		; If EQ, no blocks in queue ; FORKBLOCK
	CMP	R0,#$POOL	; In POOL?			; FORKBLOCK
	BLO	40$		;  If not, go on.		; FORKBLOCK
	CMP	R0,#12000	;				; FORKBLOCK
	BHIS	40$		;				; FORKBLOCK
	ASR	R0		; Even address? ; FORKBLOCK
	BCS	40$		; If not, go on ; FORKBLOCK
	CALL	GTMOFA		; Get map address ; FORKBLOCK
	MOVB	#'F,(R0)+	; MARK "FB" ; FORKBLOCK
	MOVB	#'B,(R0)+	; FORKBLOCK
	MOV	(R3),R0		; Get next FORK BLOCK ; FORKBLOCK
	BNE	10$		; Go back if more ; FORKBLOCK
	BR	50$		;				; FORKBLOCK
50$:				; FORKBLOCK
	BR	FRKEND		; FORKBLOCK
40$:
	MSGOUT	<*** Bad FORK BLOCK link>			; FORKBLOCK
FRKEND:				; FORKBLOCK
	.PAGE
	.SBTTL	MCR Command Lines
;+
;Now look for MCR lines not yet read
;-
	.ENABL	LSB
	MOV	$MCRCB,R3	; Get listhead for MCR lines of tasks
10$:

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** MCR line bad link> ; Put out error message
	BR	ENDMCR		; End MCR scan
100$:	MOV	R3,R0		; Get copy for distructive use
	BEQ	ENDMCR		; Quit if no new line
	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If no, branch
	MSGOUT	<*** MCR line link out of range> ; Put out error message
	BR	ENDMCR		; And end MCR check
120$:	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
	.DSABL	LSB

	.SBTTL	Mount Control Blocks
;+
;Now look for mount control blocks
;-
	.ENABL	LSB
	MOV	$MOULS,R3	; Get listhead for mount control blocks
10$:

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** Mount block bad link> ; Put out error message
	BR	ENDMOU		; End mcb scan
100$:	MOV	R3,R0		; Get copy for distructive use
	BEQ	ENDMOU		; Quit if no new block
	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If no, branch
	MSGOUT	<*** Mount block link out of range> ; Put out error message
	BR	ENDMOU		; And end mcb check
120$:	CALL	GTMOFF		; Get offset into pool map
	BCS	20$		; Skip if somewhow not in pool
	MOVB	#'<,(R0)+	; Mark mount blocks with <M
	MOVB	#'M,(R0)+	; Finish off with ending delimiter
20$:	MOV	(R3),R3		; Get next mount control block address
	BR	10$		; And go try out that one
ENDMOU:				; Ref. label
	.DSABL	LSB

	.SBTTL	Checkpoint File PCB's
;+
;Now look for checkpoint file pcb
;-
	.ENABL	LSB
	BIT	#MF.CKP,FLGWD1
	BNE	ENDCKP
	MOV	$CFLPT,R3	; Get pointer to first checkpoint file PCB
10$:

;Time for a check

	BIT	#1,R3		; Is it odd ?
	BEQ	100$		; If not, branch
	MSGOUT	<*** CKP PCB bad link> ; Put out error message
	BR	ENDCKP		; End CKP scan
100$:	MOV	R3,R0		; Get copy for distructive use
	BEQ	ENDCKP		; Quit if no new block
	CMP	R3,@#$EXSIZ	; Is link above pool ?
	BLO	120$		; If no, branch
	MSGOUT	<*** CKP PCB link out of range> ; Put out error message
	BR	ENDCKP		;  and end
120$:	CALL	GTMOFF		; Get offset into pool map
	BCS	20$		; Skip if somewhow not in pool
	MOV	#CKPSTG,R1	; Put '<CP>' in map
	CALL	MOVSTG
20$:	MOV	P.SUB(R3),R3	; Get next checkpoint SUB-PCB address
	BR	10$		;  and go try out that one
ENDCKP:				; Ref. label
	.DSABL	LSB
	.PAGE
	.SBTTL	Display Data
;+
;Done with pool scan - now display all the information
;-
	BIT	#MF.FRG,FLGWD1
	BNE	FRGEND
	MOV	FRGMNT,R2
	MOV	#FRGMSG,R1	; Set for message about fragments
	MOV	PC,R3		; Set R3 not zero 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		; Set R3 not zero for decimal conversion
	CALL	PRMSNM
FRGEND:

	.SBTTL	Print Map
;+
;Now print map in rows of 64 chars.
;-
	MOV	#TEXTBF,R0	; First output the command line
	MOV	GCLBLK+G.CMLD,R2 ;   Get the size
	MOV	GCLBLK+G.CMLD+2,R1 ; and the address,
	MOVB	#14,(R0)+	;    insert a <FF>,
1$:	MOVB	(R1)+,(R0)+	;    move the command into the output buffer,
	SOB	R2,1$
	CALL	OUTIT		;    and write it.
2$:
	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
; 
	CLOSE$	#FDBOUT		; CLOSE OUTPUT FILE
	EXIT$S			; The end
	.PAGE
	.SBTTL	Subroutines
;+
;Subroutines
;-
;=================================================
;PRMSNM:  Print message w/ trailing #
; 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 for user reuse

OUTIT:	SUB	#TEXTBF,R0	; Calc. length of message
	MOV	R0,LEN		; Save length for PUT$S
	PUT$S	#FDBOUT,#TEXTBF,LEN ; Output to file system
	RETURN

LEN:	.BLKW	1		; Storage for length
;=================================================
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:				; Checking now done in mapout
	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: Entered w/ pool address in R0
; Exit w/ map address in R0
; Return w/ carry set & no-op if offset negative, else carry clear
; GTMOFA: alternate entry w/ address/2 in R0
GTMOFA:	ASL	R0		; Convert back to full address
GTMOFF:	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$:	MOV	R1,-(SP)	; Insert into map
	CALL	MAPOUT		; Use safe write
	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
;  R0 & R1 are destroyed

	MOV	4(SP),R1		; Retrieve DCB address from stack
	MOVB	D.NAM(R1),ICBER1+4	; Put device name in error msgs
	MOVB	D.NAM(R1),ICBER2+4
	MOVB	D.NAM+1(R1),ICBER1+5
	MOVB	D.NAM+1(R1),ICBER2+5

	MOV	(R5),R1		; Get address of ICB
	BIT	#1,R1		; Is it odd?
	BEQ	10$		;  If not, branch
	MOV	#TEXTBF,R0	; Output ICB error msg
	MOV	#ICBER1,R1
	CALL	MOVSTG
	CALL	OUTIT
	BR	20$		; Return

10$:	CMP	(R1)+,#207	; Look for standard end of ICB
	BNE	10$
	SUB	(R5),R1		; Calculate size of ICB
	CMP	R1,#400		; Check for unreasonable length
	BLO	15$		;  Go ahead and process
	MOV	#TEXTBF,R0	; Output ICB error msg
	MOV	#ICBER2,R1
	CALL	MOVSTG
	CALL	OUTIT
	BR	20$		; Return
	
15$:	MOV	(R5),R0		; Get start addr. into R0
	CALL	VFYADR		; Check that address is valid
	BCS	20$
	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	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
20$:	RETURN			; Finally done
;=================================================
;VFYADR: verify that address in R0 is even and inside pool
; returns carry clear if OK, else carry set
VFYADR:	BIT	#1,R0		; Check for odd address
	BNE	20$		; Return failure if odd
	CMP	R0,$EXSIZ	; Above pool?
	BHI	20$		; Skip if yes
	CMP	R0,#$POOL	; Below?
	BLO	20$		; Skip if yes
	CLC			; Return OK indication
	RETURN
20$:	SEC			; Return BAD indication
	RETURN
;=================================================
;OUTMSG: subroutine to print a message on TI: via QIO
; called by: JSR  PC,OUTMSG
;	     .WORD  STGADR
; where STGADR is address of ASCIZ string to print
OUTMSG:	MOV	@0(SP),QIO+Q.IOPL ; Get address of string to print
	CLR	QIO+Q.IOPL+2	; Zero the length to print
	MOV	QIO+Q.IOPL,TEMADR ; Get temporary copy of address
80$:	TSTB	@TEMADR		; At end of string?
	BEQ	88$		; Out of loop if so
	INC	TEMADR		; No, bump pointer
	INC	QIO+Q.IOPL+2	;  and count
	BR	80$
;
88$:	DIR$	#QIO		; Issue the QIO
	ADD	#2,(SP)		; Move return past parameter
	RETURN
;=================================================
MRKWB:	MOVB	W.WISZ(R0),R1	; Then get the # of retrieval pointers
	MUL	#6,R1		; Convert to #bytes in the pointers
	ADD	#<W.RTRV-W.CTL>,R1 ; Adjust to size of whole window
	ASR	R0		; Check for odd address
	BCS	XITWB		; Skip if so
	CALL	GTMOFA		; 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 WBFIL character
	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
;=================================================
	.ENABL	LSB
MRKAST:
	BEQ	20$		; Return if no more in list.
	MOV	R3,R0		;
	CALL	VFYADR		; Check that it points to something in pool
	BCS	20$		; If not, can't follow this
	ASR	R0		; Check for odd address
	BCS	20$		; Quit chain if so
	CALL	GTMOFA		; Get address in map
	BCS	19$		; Go to next possible one if out of pool.
	TST	A.CBL(R3)	; What type is it?
	BNE	11$		;
	MOV	#TTEXT,R1	; Mark it as associated w/ FDX TT:
	CALL	MOVSTG
	BR	19$		; And go get the next one.
11$:	MOVB	A.CBL(R3),R1	; Check for size/type
	BEQ	18$		; If EQ, it is a "Specify AST" Block
	BLT	12$		; If LT, it is a special type
	MOVB	#'[,(R0)+	; Mark block as "[...]"
	SUB	#4,R1		; Adjust remaining size.
	BLE	19$		;  DONE?
	CALL	MRKMP1		; Put in the rest of the fill characters
	.WORD	ASTFIL
	MOVB	#'],-(R0)	; Close the area
	BR	19$		;  and go get the next one.
;
; Here on negative AST block sizes
12$:
	CMPB	R1,#200		; Buffered I/O?
	BNE	13$
	MOV	#BIOSTG,R1	; Yes. Mark it
	CALL	MOVSTG
	BR	19$		;  and go get the next one.
;
13$:	CMPB	R1,#300		; Is it an OCB?
	BNE	15$		; If not, ignore it.
14$:	CALL	MRKOCB		; Yes. Mark it w/ name of parent
	BR	19$		;  and go get next one
;
; Here on unrecognized AST types.
15$:	MSGOUT	<*** Unrecognized AST type encountered>
	BR	19$
;
; Here on SPECIFY AST blocks
18$:	MOVB	#'[,(R0)+
	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 the area.
	BR	19$
;
19$:	MOV	(R3),R3		; See if there's another AST block
	BNE	MRKAST		;  & go process it.
20$:
	RETURN
	.DSABL	LSB
;=================================================
; MRKOCB marks an Offspring Control Block
;	Entry w/OCB address in R3, MAP address in R0
MRKOCB:	MOVB	#OCBCHR,(R0)+		; Mark start w/ OCBCHR
	MOV	R4,-(SP)		; Save R4
	MOV	O.PTCB(R3),R4		; Get parent TCB address.
	BEQ	10$			; Parent gone.
	CALL	GTTSKN			; Insert parent name in MAP.
	BR	20$
;
10$:	MOV	O.STAT(R3),R1	; It appears that O.STAT has parent name
	CALL	$C5TA
	MOV	O.STAT+2(R3),R1
	CALL	$C5TA
20$:	MOV	(SP)+,R4		; Restore R4.
	RETURN				; That's it. (No room to close area)

;=================================================

	.PAGE
	.SBTTL MAPOUT - Handle safe writes
;
; MAPOUT
; Entry	MOV(B)	#char,-(SP)		; Put a char on stack
;	CALL	MAPOUT			; Call routine
;
; Return
;	If successful R0 is incremented
;	All other registers unmodified
;
; Purpose:
;	Unless you've written a routine that runs with a tkb /pr(:4,:5)
;	you don't know how easy it is to crash a running system. This
;	is an attempt to limit the area in which this routine can write
;	in monitor space. Some will laugh, but this will work on unmapped
;	systems. Better laugh then cry when you crash/WRG
;
MAPOUT:
	CMP	R0,MAP			; Is R0 < start or write area ?
	BLO	10$			; If yes ignore the request
	CMP	R0,MAPEND		; Is R0 >= end of write area ?
	BHI	10$			; If yes ignore the request
	MOVB	2(SP),(R0)+		; Must be safe, write it out
10$:
	MOV	(SP)+,(SP)		; Clean up the stack
	RETURN
	.PAGE
	.SBTTL GCMLIN - Command line handler and file opening

	.NLIST	MEB
;
	.ENABL	LSB
GCMLIN:	FINIT$			; Re-entrant routines must init fsr
PROMPT:	CLOSE$	#FDB		; Ensure its not open
	CLOSE$	#FDBOUT		; Output too
	CLR	FLGWD1		; Clear flag word
	GCML$	#GCLBLK		; Prompt and get command line
	BCC	1$		; Check for retrieval error or ctrl/z
	CMPB	#GE.EOF,G.ERR(R0) ; Eof on input ?
	BNE	1$		; If not then continue on
	EXIT$S			; Otherwise exit
;
1$:	TST	GCLBLK+G.CMLD	; Null command line?
	BEQ	PROMPT		; If so, re-prompt
PARSE:	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; Validate line
	BCS	2$		; Syntax error ?
;
	CSI$2	#CSIBLK,INPUT,#SWTABL	; Parse command line
;	BCS	2$
	BCC	3$
;
2$:	MSGOUT	<Syntax error>
	JMP	PROMPT
;
3$:	BIT	#MF.HLP,FLGWD1	; /HE switch specified?
	BNE	7$		; Branch if yes
;
	OPEN$R	#FDB		; Open input file
	BCC	25$		; Br if found
	CSI$2	#CSIBLK,OUTPUT,#SWTABL	; OK, now find output filespec.
	BIT	#MF.HLP,FLGWD1	; /HE switch specified?
	BNE	7$		; Branch if yes
31$:	MSGOUT	<Input file not found>
	JMP	PROMPT		; Go prompt again
;
25$:	CSI$2	#CSIBLK,OUTPUT,#SWTABL	; OK, now find output filespec.
	BCS	1$
	OPEN$W	#FDBOUT		; Open output file
	BCC	30$		; Br if found
	MSGOUT	<Can't open output file>
	JMP	PROMPT		; Go prompt again
30$:	RETURN
;
; For /HE
7$:	MSGOUT	<No HELP available at this time.>
	JMP	PROMPT
;
	.DSABL	LSB

	.SBTTL Data area
;+
;Data area
;-
;
; First messages
;
.NLIST BEX
FRGMSG:	.ASCIZ	/# Free Pool Fragments/
POOLMS:	.ASCIZ	/Total Words of Pool/
NFRMSG:	.ASCIZ	/Total Free Words/
SEGMSG:	.ASCIZ	/Free Segment List:/
MAPMSG:	.ASCII	<12><12>/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>/
VDASTG:	.ASCIZ	/<VD/
VDBSTG:	.ASCIZ	/: EXT>/
ICBER1:	.ASCIZ	/*** dv: Interrupt Vector contains ODD address./
ICBER2: .ASCIZ	/*** dv: ICB length error./
;
	.EVEN
	.LIST BEX
;
; The following area contains all areas written to by this program
;
MQIO:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<,,40,,>
;
;
	FDOF$L			; Define fdb offsets
;
	FSRSZ$	2		; 1 file will be open
				; 1 gmcl file can be open
;
FDB:	FDBDF$			; Allocate 140 byts for fdb
	FDRC$A	FD.RWM		; Read$/write$ block i/o
	FDBK$A	BUFI0,42000,,10. ; Init record access section of fdb
	FDOP$A	INLUN,CSIBLK+C.DSDS,FILEIN ; Init file open section of FDB
				; Lun 1, dataset descriptor supplied dynamically
				; By CSI, default filename block
FILEIN:	NMBLK$	CLEAN,CDA,,SY,0	; Default filetype 

FDBOUT:	FDBDF$			; Make an fdb
	FDAT$A	R.VAR,FD.CR	; Initialize file attributes
	FDOP$A	OUTLUN,CSIBLK+C.DSDS,FILEOU ; Initialize file open section
;
FILEOU:	NMBLK$	CPA,CPA,,SY,0	; Default filetype 
RBUF:	.BLKW	41.
IOST:	.BLKW	2		; I/O status return
BKVB:	.BLKW	2
;
GCLBLK:	GCMLB$	1,CPA,RBUF,GCMLUN ; Initialize gcml control block

	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE		; Create control block
;
SWTABL:	CSI$SW	HE,MF.HLP,FLGWD1,SET		; Define /he switch
	CSI$SW	TC,MF.TCB,FLGWD1,CLEAR,NEG
	CSI$SW	CP,MF.CKP,FLGWD1,CLEAR,NEG
	CSI$SW	CQ,MF.CLQ,FLGWD1,CLEAR,NEG
	CSI$SW	PC,MF.PCB,FLGWD1,CLEAR,NEG
	CSI$SW	HD,MF.HDR,FLGWD1,CLEAR,NEG
	CSI$SW	WB,MF.WB,FLGWD1,CLEAR,NEG
	CSI$SW	MV,MF.MVL,FLGWD1,CLEAR,NEG
	CSI$SW	VC,MF.VCB,FLGWD1,CLEAR,NEG
	CSI$SW	VS,MF.VSC,FLGWD1,CLEAR,NEG
	CSI$SW	DV,MF.DEV,FLGWD1,CLEAR,NEG
	CSI$SW	SC,MF.SCB,FLGWD1,CLEAR,NEG
	CSI$SW	IC,MF.ICB,FLGWD1,CLEAR,NEG
	CSI$SW	FR,MF.FRG,FLGWD1,CLEAR,NEG
	CSI$ND			; End of switch definitions
;
QIO:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<TEXTBF,0,40>
FLGWD1:	.WORD	0		; Flag Word
TEMADR:	.WORD	0		; temporary storage of string address
CURPKT:	.WORD	0		; Current I/O packet address in map
UNITNO:	.WORD	0		;Saved unit no. during UCB/SCB scan
POOLAD:	.BLKW	1		; Starting address for printout
MAPAD:	.BLKW	1		; Starting map address for same
POOLWD:	.WORD	0
MAP:	.WORD	$CMFIN+64.	; Pointer to area to be overwritten w/ map
MAPEND:	.WORD	$CMFIN+6*1024.+64. ; End of map area (allows 12. KW pool)
FRGMNT:	.WORD	0
FRLIST:	.BLKW	2*MAXFRG
NAMFLD:	.WORD	0		; Address of name-field (temp. use)
MAPSIZ:	.WORD	0		; Actual map size in segments (4 bytes ea.)
TEXTBF:	.BLKW	40		; Text buffer
	.END	CPA