.TITLE	FCB
;	PROGRAM FCB FILE CONTROL BLOCK
;	WRITTEN BY:	FRANK PENNER
;			JULY 1979
;	MODIFIED:	OCTOBER 1979 DISABLE CONTEXT SWITCHING RSX-11M V3.2
;			August 1983 for M+
;	THIS PRIVILEGED TASK WILL DISPLAY THE FCB'S FOR ALL
;	THE OPEN FILES ON A GIVEN DEVICE
;	TO USE, TYPE:
;		FCB DB0:
;	WHERE DB0: IS THE DEVICE
	.MCALL	QIOW$,EXIT$S,DIR$,ALUN$
	.MCALL	TCBDF$,CALL,RETURN,GMCR$
	.MCALL	DCBDF$,F11DF$,HDRDF$,HWDDF$,PCBDF$,UCBDF$
	.MCALL	FHDOF$
	TCBDF$				;DEFINE TCB OFFSETS
	DCBDF$				;DEFINE DCB OFFSETS
	F11DF$				;DEFINE F11 OFSETS (VCB,FCB,WINDOW)
	HDRDF$				;DEFINE TASK HEADER OFFSETS
	HWDDF$				;DEFINE HARDWARE OFFSETS
	PCBDF$				;DEFINE PCB OFFSETS
	UCBDF$				;DEFINE UCB OFFSETS
	FHDOF$	DEF$L			;DEFINE FILE-HEADER BLOCK OFFSETS LOCAL
GMCR:	GMCR$
	DEVNAM	=GMCR+G.MCRB+4		;START OF TYPED INPUT DEVICE NAME
IOST:	.BLKW	2			;I/O STATUS BLOCK
QIODPB:	QIOW$	IO.WLB,TLUN,TEFL,,IOST,,<OUTBUF,0,VFC>
	TLUN=	5
	TEFL=	2
	VFC=	40
OUTBUF:	.BLKB	256.
READLB:	QIOW$	IO.RLB,DLUN,DEFL,,IOST,,<HEDBUF,LEN,,BLKH,BLKL>
	DLUN=	1
	DEFL=	1
	BLKH=	0
	BLKL=	1
	LEN=	512.
HEDBUF:	.BLKB	512.
LUN:	ALUN$	DLUN,0,0
ARGBLH:	.BLKW	2			;space for open files, LRU
HSTRNG:	.ASCII	/Trans Cnt= %M  LRU= %M/<15><12>
	.ASCIZ	/FCB ADD				ACC  LOCK WRIT/
ISTRNG:	.ASCIZ	/%45<%40<%35<%16<%P%S[%O,%O]%16>%X%35>%M%40>%M%45>%M/
	.EVEN
ARGBLE:	.WORD	0			;ending arg blk
POOLF:	.WORD	0			;pool FCBs
ACPF:	.WORD	0			;ACP FCBs
LRUF:	.WORD	0			;LRU FCBs
ESTRNG:	.ASCIZ	/Total= %M   Pool= %M  ACP= %M  LRU= %M/
	.EVEN
SAVEM0:	.BLKW	1			;SPACE TO SAVE MEMORY
SAVEM1:	.BLKW	1			;MANAGEMENT REGISTERS
SAVEM2:	.BLKW	1			;APR'S 0,1, AND 2
F11AP0:	.BLKW	1			;SPACE TO KEEP APR'S
F11AP1:	.BLKW	1			;TO MAP F11ACP
F11AP2:	.BLKW	1			;FOR VOLUME IN QUESTION
	.EVEN
START:
	DIR$	#GMCR			;PICK UP COMMAND LINE
	BCC	.+6			;C CLEAR IS SUCESS
	JMP	ERROR			;GET COMMAND LINE ERROR
	MOV	#DEVNAM,R0		;PUT ADDRESS OF TYPED INPUT IN R0
	MOV	(R0)+,LUN+A.LUNA	;PUT TYPE ASCII DEV NAME IN ATT LUN DPB
	CALL	$COTB			;CONVERT ASCII NUM IN R0 BUF ADD TO BIN
	CMPB	#':,R2			;DEVICE SPEC TERMINATED BY : ?
	BEQ	.+6			;YES SO PROCEED
	JMP	ERROR			;NO, SO ERROR
	MOV	R1,LUN+A.LUNU		;PUT BINARY DEV UNIT IN ASSIGN LUN DPB
	DIR$	#LUN			;DO ASSIGN LUN DIRECTIVE
	BCC	.+6			;C CLEAR MEANS DEVICE IS IN SYSTEM
	JMP	ERROR			;C SET MEANS ERROR
	MOVB	#1,$CXDBL		;DISABLE CONTEXT SWITCHING
	MOV	@#UISAR6,SAVEM0		;SAVE MEMORY MANAGEMENT REGISTERS
	MOV	$SAHDB,@#UISAR6		;map task header
	MOV	$SAHPT,R0		;GET OUR HEADER ADDRESS
	MOV	H.LUN(R0),R1		;SINCE ASS LUN, 1ST ADD IN LUT IS UCB
	MOV	SAVEM0,@#UISAR6		;RESTORE MEMORY MANAGEMENT REGISTERS
	CLRB	$CXDBL			;RENABLE CONTEXT SWITCHING
	BITB	#US.MNT,U.STS(R1)	;IS VOLUME MOUNTED
	BEQ	.+6			;YES, SO CONTINUE
	JMP	ERROR			;NO, SO ERROR
	MOV	U.ACP(R1),R3		;POINT R3 TO TCB OF ACP OF DEV
	MOV	T.OFF(R3),R2		;get offset to task image in partition
	MOV	T.PCB(R3),R3		;POINT R3 TO PCB FOR ACP
	MOV	P.REL(R3),R3		;GET PHYSICAL START OF ACP
	ADD	R2,R3			;include offset
	MOV	#F11AP0,R2		;POINT R2 TO SPACE TO SAVE ACP MAP
	MOV	R3,(R2)+		;SAVE APR 0 TO MAP F11ACP
	ADD	#200,R3			;BUMP UP TO NEXT 4K
	MOV	R3,(R2)+		;ALSO APR 1
	ADD	#200,R3			;BUMP UP TO NEXT 4K
	MOV	R3,(R2)+		;3 APR'S FOR 10K F11ACP
	MOV	U.VCB(R1),R0		;PUT ADDRESS OF VOLUME CONTROL BLOCK R0
	MOV	#ARGBLH,R2		;set address for collection of info
	MOV	V.TRCT(R0),(R2)+	;grab transaction count
	MOVB	V.LRUC(R0),(R2)		;grab LRU count
	MOV	V.FCB(R0),R1		;PUT ADDRESS OF 1ST FCB IN R1
	MOV	#ARGBLK,R2		;PUT ADDRESS OF ARGBLK IN R2
	CLR	R3			;USE R3 TO COUNT # OF FILES
PROLOP:					;BEGINNING OF FCB PROCESSING LOOP
	INC	R3			;ONE MORE FILE, SO INC TALLY
	MOV	R1,(R2)+		;PUT FCB ADDRESS IN ARGBLK
	CMP	#120000,R1		;IS ADDRESS OF FCB IN F11ACP ?
	BHI	2$			;NO, SO BRANCH
	INC	ACPF			;tally a ACP FCB
	MOVB	#1,$CXDBL		;DISABLE CONTEXT SWITCHING
	MOV	@#UISAR0,SAVEM0		;SAVE MEMORY MANAGEMENT REGISTERS
	MOV	@#UISAR1,SAVEM1		;PAR FOR APR'S 0 AND 1
	MOV	@#UISAR2,SAVEM2		;AND APR 2
	MOV	F11AP0,@#UISAR0		;REMAP TO F11 ACP
	MOV	F11AP1,@#UISAR1		;THESE WORDS HAVE PAR FOR F11ACP
	MOV	F11AP2,@#UISAR2		;AND APR 2 FOR 10 K F11ACP
	MOV	@#UISDR1,@#UISDR0	;give full mapping
	SUB	#120000,R1		;SUBTRACT 120000 SO WE USE APR 0 AND 1
	JSR	PC,FCBSAV		;GO DO SAVE FCB INFORMATION
	MOV	SAVEM0,@#UISAR0		;RESTORE MEMORY MANAGEMENT REGISTERS
	MOV	SAVEM1,@#UISAR1		;POINT PAR'S 0 AND 1 BACK TO EXEC
	MOV	SAVEM2,@#UISAR2		;AND APR 2
	CLRB	$CXDBL			;RENABLE CONTEXT SWITCHING
	BR	3$			;SKIP PAST NO RE-MAP CODE
2$:
	INC	POOLF			;tally a pool FCB
	JSR	PC,FCBSAV		;GO DO SAVE FCB INFORMATION
3$:
	TST	R1			;IS NEXT FCB A VALID LINK?
	BNE	PROLOP			;NON ZERO SO VALID PTR TO NEXT FCB
	MOV	R3,ARGBLE		;save total number of FCBs
	MOV	#OUTBUF,R0		;ADDRESS OF OUTPUT BUFFER FOR EDMSG
	MOV	#HSTRNG,R1		;INPUT STRING FOR EDMSG
	MOV	#ARGBLH,R2		;PUT ADDRESS OF ARGBLK IN R2 FOR EDMSG
	CALL	$EDMSG			;CALL EDIT MESSAGE ROUTINE
	MOV	R1,QIODPB+Q.IOPL+2	;SIZE OF MESSAGE TO PRINT
	DIR$	#QIODPB			;PRINT OUT PRINT HEADING ON TERMINAL
	MOV	#ARGBLK,R2		;PUT ADDRESS OF ARGBLK IN R2 FOR EDMSG
PRTLOP:
	TST	(R2)+			;BUMP ARGBLK PTR PAST FCB ADDRESS
	MOV	(R2)+,READLB+Q.IOPL+6.	;PUT HIGH BLOCK # IN DPB
	MOV	(R2),READLB+Q.IOPL+8.	;PUT OTHER LOW BLOCK # IN DPB
	TST	-(R2)			;BACK UP ARGBLK POINTER
	DIR$	#READLB			;READ FILE HEADER BLOCK
	MOVB	HEDBUF+H.PROJ,(R2)+	;PUT PROJECT # IN ARG BLK
	MOVB	#0,(R2)+		;ROUND ARGBLK POINTER TO EVEN WORD
	MOVB	HEDBUF+H.PROG,(R2)+	;PUT PROGRAMMER # IN ARG BLK
	MOVB	#0,(R2)+		;ROUND ARGBLK POINTER TO EVEN WORD
	MOV	#HEDBUF+S.HDHD,R0	;PUT ADDRESS OF FILESPEC IN R0
	MOV	#5,R1			;PUT # OF WORDS TO TRANSFER IN R1
1$:	MOV	(R0)+,(R2)+		;FILESPEC FROM HEADER BLK TO ARGBLK
	SOB	R1,1$			;DO WHOLE FILESPEC
	SUB	#16.,R2			;RESET R2 TO BEGINNING OF PACKET
	MOV	#OUTBUF,R0		;ADDRESS OF OUTPUT BUFFER FOR EDMSG
	MOV	#ISTRNG,R1		;INPUT STRING FOR EDMSG
	CALL	$EDMSG			;CALL EDIT MESSAGE ROUTINE
	MOV	R1,QIODPB+Q.IOPL+2	;SIZE OF MESSAGE TO PRINT
	DIR$	#QIODPB			;PRINT OUT INFO ON TERMINAL
	SOB	R3,PRTLOP		;PRINT OUT ALL LUNS
	MOV	#OUTBUF,R0		;ADDRESS OF OUTPUT BUFFER FOR EDMSG
	MOV	#ESTRNG,R1		;INPUT STRING FOR EDMSG
	MOV	#ARGBLE,R2		;PUT ADDRESS OF ARGBLK IN R2 FOR EDMSG
	CALL	$EDMSG			;CALL EDIT MESSAGE ROUTINE
	MOV	R1,QIODPB+Q.IOPL+2	;SIZE OF MESSAGE TO PRINT
	DIR$	#QIODPB			;PRINT OUT PRINT HEADING ON TERMINAL
ERROR:
EXIT:	EXIT$S
FCBSAV:					;SAVE FCB SUBROUTINE
	BIT	#FC.DIR,F.NWAC(R1)	;is FCB in LRU?
	BEQ	1$			;if equal no
	INC	LRUF			;count an LRU FCB
1$:	MOV	F.HDLB(R1),(R2)+	;SAVE HIGH HEADER-BLOCK # IN ARGBLK
	MOV	F.HDLB+2(R1),(R2)+	;SAVE LOW HEADER-BLK # IN ARGBLK
	ADD	#10.,R2			;SKIP 5 WORDS OF ARG BLK
	MOVB	F.NACS(R1),(R2)+	;SAVE ACCESS COUNT IN ARGBLK
	TSTB	(R2)+			;POINT ARGBLK TO WORD 
	MOVB	F.NLCK(R1),(R2)+	;SAVE # OF LOCKS COUNT
	TSTB	(R2)+			;POINT ARGBLK TO WORD 
	MOVB	F.NWAC(R1),(R2)+	;SAVE # OF WRITE ACCESSORS
	TSTB	(R2)+			;POINT ARGBLK TO WORD 
	MOV	F.LINK(R1),R1		;POINT R1 TO NEXT FCB
	RTS	PC			;END OF SAVE FCB SUBROUTINE
					;data down here so APR 6
	MAX=300.			;MAX OF 300 OPEN FILES
ARGBLK:	.BLKW	MAX*11.			;11 WORDS FOR EACH ARGBLK PACKET
	.END	START