.TITLE	FHD
	.IDENT	/MRHV01/
	.SBTTL	INTRO PAGE
;
;	THIS PROGRAM IS DESIGNED TO LIST OUT THE FILE HEADER BLOCK OF A
;	GIVEN FILE
;
;CALLING PROCEEDURE
;
;
;MCR>FHD NNNNNN,MMMMMM		WHERE
;
;	NNNNNN,MMMMMM IS THE FILES (UNIQUE) FILE ID (AVAILABLE BY A FULL
;	PIP OR SRD LISTING
;
;
;
;
;
	.MCALL	QIOW$,DIR$,EXIT$S,GMCR$,FHDOF$
	.MCALL	FDBDF$,CLOSE$,FSRSZ$,NMBLK$,FDRC$A,FDBK$A
	.MCALL	READ$,OPNS$R,WAIT$,FDOP$A,HMBOF$
FHDOF$	DEF$L
HMBOF$	DEF$L
;
;DEFINE BOGUS OFFSET TO FILENAME FROM DISK SINCE ITS A LOT OF CRANKING
;OTHERWISE
F.FNAM=56
.PAGE
.SBTTL	THE CODE
;
;FIRST SET THINGS UP
;
START:	DIR$	#GETMCR		;GET MCR COMMAND LINE
	MOV	#GETMCR+G.MCRB+4,R0	;BUMP POINTER TO COMMAND PART
	JSR	PC,$COTB	;CONVERT FIRST FID NUMBER
	CMP	R2,#',		;TERMINATED ON "," ?
	BNE	222$		;BR IF NOT
	MOV	R1,FID		;SAVE FIRST PART OF FILE ID #
	JSR	PC,$COTB	;NOW CONVERT 2ND PART OF FID
	CMP	R2,#15		;TERMINATED ON A CARRIAGE RETURN
	BEQ	1$		;IT'S OK
	CMP	R2,#33		;OR AN ESCAPE
	BEQ	1$		;THAT'S OK TOO
222$:	JMP	SYNTER		;ANYTHING ELSE IS AN ERROR
1$:	MOV	R1,FID+2	;SAVE 2ND FID #
FIRST:
	OPNS$R	#FDB		;OPEN FILE (SHARED ACCESS, READ-ONLY)
	BCC	5$		;BR IF OK
	BR	REAERR		;REPORT READ ERROR
5$:	MOV	#2,BLOCKL	;SET UP BLOCK NUMBER OF HOME BLOCK
	MOV	#10000.,FDB+F.HIBK+2 ;FAKE A BLOCK NUMBER
	MOV	#10000.,FDB+F.EFBK+2 ;AND AN ENDFILE BLOCK NUMBER
		;CAUSE INDEX FILE HEADER HAS 0'S AND READ WILL BOMB
	READ$	#FDB,,,#BLOCKH	;READ HOME BLOCK
	BCS	ROPERR		;BRANCH IF FAILURE
	WAIT$			;WAIT FOR READ TO FINISH
	BCS	ROPERR		;BR IF FAILED
	ADD	READBF+H.IBSZ,BLOCKL ;ADD NUMBER OF BITMAP BLOCKS
	MOV	BLOCKL,OFFSET	;SAVE THIS OFFSET IF WE NEED IT
	INC	BLOCKL		;GET INDEX FILE HEADER BLOCK
	READ$	#FDB,,,#BLOCKH	;READ INDEX FILE HEADER BLOCK
	BCS	ROPERR		;BRANCH IF FAILURE
	WAIT$			;WAIT FOR READ TO FINISH
	BCS	ROPERR		;BR IF FAILED
10$:	CMP	READBF+F.FNAM,INDRAD ;IS THIS THE INDEX FILE
	BNE	ROPERR		;NO
	CMP	READBF+F.FNAM+2,EXFRAD ;FILE HEADER
	BNE	ROPERR		;NO
	MOV	FID,BLOCKL	;FIRST FILE ID IS BLOCK # IN INDEX FILE
	ADD	OFFSET,BLOCKL	;ADD OFFSET PREVIOUSLY FOUND
	READ$	#FDB,,,#BLOCKH	;READ BLOCK N OF INDEX FILE
	BCS	ROPERR
	WAIT$			;WAIT FOR READ
	BCS	ROPERR
	JMP	PRINT		;IF OK, PRINT FILE HEADER BLOCK
;
;
.PAGE
.SBTTL	ERROR CONDITIONS
;
;
ROPERR:				;READ ERROR WITH INDEX FILE OPEN
	CLOSE$	#FDB		;CLOSE IT OUT
;
;				;FAILURE WITH INDEX FILE NOT OPEN
REAERR:				;FAILED TO READ INDEX FILE
	MOV	#READFA,ERRQIO+Q.IOPL
	MOV	#READLN,ERRQIO+Q.IOPL+2
	DIR$	#ERRQIO		;SEND ERROR MESSAGE TO TI
	JMP	EXIT
SYNTER:			;SYNTAX OR BLOCK # ERROR
	MOV	#SYNERR,ERRQIO+Q.IOPL	;REPORT ERROR
	MOV	#SYNELN,ERRQIO+Q.IOPL+2
	DIR$	#ERRQIO
EXIT:	EXIT$S			;QUIT
.PAGE
.SBTTL	PRINT THE FILE HEADER BLOCK
;
PRINT:
	MOV	#READBF,R5	;R5 ALWAYS POINTS TO START OF BLOCK
	MOV	#ARGBLK,R0	;POINT R0 TO ARGUMENT BLOCK TO FILL IN
	MOV	H.FNUM(R5),(R0)+ ;PUT IN FILE ID NUMBERS
	MOV	H.FSEQ(R5),(R0)+
	MOVB	H.IDOF(R5),R1	;WORD OFFSET TO FILE ID AREA
	ASL	R1		;MAKE IT BYTE OFFSET
	ADD	R5,R1		;NOW POINTING AT ID AREA
	MOV	(R1)+,(R0)+	;FILL IN NAME
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+	;TYPE
	MOV	(R1)+,(R0)+	;AND VERSION
	MOV	#READBF,R4	;START OF BUFFER IN R4
	ADD	#H.PROJ,R4	;BUMP TO GROUP CODE ADDRESS
	MOV	R4,(R0)+	;FILL IN ADDRESS OF UIC BYTE VALUE
	DEC	R4		;BACK UP TO USER CODE
	MOV	R4,(R0)+	;AND FILL IN
	MOV	(R1)+,-(SP)	;SAVE REVISION NUMBER FOR NOW
	MOV	#2.,R2		;SET COUNT
	ADD	#13.,R1		;BUMP R1 TO CREATION DATE
11$:	MOV	R1,(R0)+	;SAVE POINTER TO DAY
	ADD	#2,R1
	MOV	R1,(R0)+	;AND MONTH
	ADD	#3,R1
	MOV	R1,(R0)+	;AND YEAR
	ADD	#2,R1
	MOV	R1,(R0)+	;AND HOUR
	ADD	#2,R1
	MOV	R1,(R0)+	;AND MINUTE
	ADD	#2,R1
	MOV	R1,(R0)+	;AND SECOND
	ADD	#2,R1
	SUB	#26.,R1		;BUMP BACK TO REVISION DATE
	SOB	R2,11$
	MOV	(SP)+,(R0)+	;AND PUT IN REVISION NUMBER
	MOV	#OUTBLK,R0	;SET UP CALL
	MOV	#MESS1,R1	;TO EDSMG
	MOV	#ARGBLK,R2
	JSR	PC,$EDMSG
	MOV	R1,ERRQIO+Q.IOPL+2 ;FILL IN LENGTH OF QIO
	MOV	#OUTBLK,ERRQIO+Q.IOPL ;AND START
	DIR$	#ERRQIO		;WRITE LINE
	MOV	#OUTBLK,R0	;SET UP AGAIN
	MOV	#MESS2,R1
	MOV	#ARGBL1,R2
	JSR	PC,$EDMSG
	MOV	R1,ERRQIO+Q.IOPL+2
	MOV	#OUTBLK,ERRQIO+Q.IOPL
	DIR$	#ERRQIO
.PAGE
.SBTTL	PRINT RETRIEVAL POINTERS
RETR:				;NOW GET RETRIEVAL POINTERS
	MOV	#READBF,R5	;POINT TO BUFFER AGAIN
	MOVB	H.MPOF(R5),R4	;WORD OFFSET TO MAP AREA
	ASL	R4		;MAKE IT BYTE OFFSET
	ADD	R5,R4		;NOW POINTS AT MAP AREA
	MOV	M.EFNU(R4),EFID	;SAVE EXTENSION FILE ID
	MOV	M.EFSQ(R4),EFID+2 ;AND SEQUENCE NUMBER
	MOVB	M.USE(R4),R5	;LOOP COUNT FOR RETRIEVAL POINTERS
	BIC	#177400,R5	;CLEAR POSSIBLE SIGN EXTENSION
	ASR	R5		;NOW HAVE # OF POINTERS
	BEQ	DONE		;SKIP THIS IF 0 LENGTH FILE
	ADD	#M.RTRV,R4	;R4 POINTS AT FIRST POINTER
22$:	MOV	#ARGBLK,R0	;POINT TO ARG BLOCK
	MOVB	(R4)+,R2	;GET HIGH BLOCK NUMBER
	MOVB	(R4)+,R3	;GET SIZE
	BIC	#177400,R3	;CLEAR POSSIBLE SIGN EXTEND
	INC	R3		;CORRECT SIZE
	MOV	R3,(R0)+	;PUT IN SIZE
	MOV	#DOTTAB,(R0)+	;ADDRESS OF ".<HT>" STRING
	MOV	R2,(R0)+	;PUT HIGH BLOCK # IN ARG BLOCK
	DEC	R3		;CHANGE SIZE TO OFFSET TO LAST BLOCK
	ADD	(R4),R3		;MAKE R3 LAST BLOCK #
	ADC	R2		;ADD CARRY TO HIGH BLOCK NUMBER JUST IN CASE
	MOV	(R4)+,(R0)+	;PUT IN LOW BLOCK NUMBER
	MOV	#TAB,(R0)+	;PUT IN "<HT>" ONLY
	MOV	R2,(R0)+	;PUT IN LAST BLOCK HIGH BLOCK NUMBER
	MOV	R3,(R0)+	;AND LAST BLOCK LOW BLOCK NUMBER
	MOV	#ARGBLK,R2	;POINT BACK AGAIN
	MOV	#MESS3,R1	;MESSAGE AREA
	MOV	#OUTBLK,R0
	JSR	PC,$EDMSG
	MOV	R1,ERRQIO+Q.IOPL+2
	DIR$	#ERRQIO		;WRITE A RETRIEVAL POINTER
	SOB	R5,22$		;AND DO N OF THEM
	TST	EFID		;WAS THERE AN EXTENSION FILE ?
	BEQ	DONE		;NO
	MOV	EFID,BLOCKL	;CHANGE TO EXTENSION FILE BLOCK NUMBER
	ADD	OFFSET,BLOCKL	;ADD OFFSET PREVIOUSLY FOUND
	READ$	#FDB,,,#BLOCKH	;READ BLOCK N OF INDEX FILE
	BCC	12$		;OK
	JMP	ROPERR
12$:	WAIT$			;WAIT FOR READ
	BCC	13$		;OK
	JMP	ROPERR
13$:	MOV	#OUTBLK,R0	;MASSAGE THE OUTPUT LINE
	MOV	#MESS4,R1
	MOV	#EFID,R2
	JSR	PC,$EDMSG
	MOV	R1,ERRQIO+Q.IOPL+2 ;UPDATE LENGTH
	DIR$	#ERRQIO		;REPORT EXTENSION FILE HEADER
	JMP	RETR		;AND DO MORE
DONE:	MOV	#FINMES,ERRQIO+Q.IOPL
	MOV	#FINLEN,ERRQIO+Q.IOPL+2
	DIR$	#ERRQIO		;WRITE FINAL LF MESSAGE
	CLOSE$	#FDB		;CLOSE INDEX FILE
	JMP	EXIT		;AND WE'RE DONE
.PAGE
.SBTTL	DATA AREAS
;
;GET MCR DPB
;
GETMCR:	GMCR$
;
;
;QIO FOR MESSAGES TO TI
;
ERRQIO:	QIOW$	IO.WVB,5,1,,,,<0,0,40>
;
;NOW POSSIBLE MESSAGES
;
SYNERR:	.ASCII	/*** FHD SYNTAX ERROR ***/
	SYNELN=.-SYNERR
	.EVEN
;
;
READFA:	.ASCII	/*** FHD FAILED TO FIND FILE HEADER ***/
	READLN=.-READFA
	.EVEN
;
FINMES:	.BYTE	12,12
	FINLEN=.-FINMES
;
;MISC VARIABLES
;
INDRAD:	.RAD50	/IND/
EXFRAD:	.RAD50	/EXF/
;
READBF:	.BLKB	1000		;ONE BLOCK READ BUFFER
;
OFFSET:	.WORD	0		;OFFSET TO INDEX FILE HEADER OF INDEX FILE
;
FID:	.WORD	0,0		;SAVE FILE ID'S HERE
;
EFID:	.WORD	0,0		;EXTENSION FILE ID'S HERE
.PAGE
.SBTTL	FCS DATA AREAS
;
;DATASET DESCRIPTOR
;
DSPT:	.WORD	DEVLEN,DEV	;DEVICE DESCRIPTOR
	.WORD	UICLEN,UIC	;DIRECTORY DESCRIPTOR
	.WORD	NAMELN,NAME	;NAME DESCRIPTOR
;
DEV:	.ASCII	/SY0:/
	DEVLEN=.-DEV
	.EVEN
;
UIC:	.ASCII	/[0,0]/
	UICLEN=.-UIC
	.EVEN
;
NAME:	.ASCII	/INDEXF.SYS;1/
	NAMELN=.-NAME
	.EVEN
;
;
;FCS STATUS BLOCK
;
STATUS:	.WORD	0,0
;
;2-WORD BLOCK DESTRIPTOR
;
BLOCKH:	.WORD	0
BLOCKL:	.WORD	0
;
;
	FSRSZ$	1			;ROOM FOR 1 FILE
FDB:	FDBDF$				;DEFINE FDB
	FDRC$A	FD.RWM!FD.RAN		;USE BLOCK READS
	FDOP$A	2,DSPT			;USE LUN 2, DSPT DESCRIBES FILE
	FDBK$A	READBF,1000,,,STATUS	;DEFINE BUFFER, SIZE AND STATUS AREA
.PAGE
.SBTTL	EDMSG DATA AREAS
;
MESS1:	.ASCII	/%2NFILE HEADER BLOCK FOR (%P,%P) /
	.ASCIZ	/%X OWNED BY [%B,%B]%2N/
	.EVEN
MESS2:	.ASCII	/CREATED ON %2A-%3A-%2A AT %2A:%2A:%2A%N/
	.ASCII	/REVISED ON %2A-%3A-%2A AT %2A:%2A:%2A  REV. %P%2N/
	.ASCII	/LIST OF RETRIEVAL POINTERS%N/
	.ASCIZ	/%NBLOCKS  FIRST           LAST%N/
	.EVEN
MESS3:	.ASCIZ	/%M%2A%M,%P%A%M,%P/	;SIZE,".<HT>" FIRST BL <HT> LAST BL
	.EVEN
MESS4:	.ASCIZ	/%NFILE HEADER EXTENDED IN (%P,%P)%N/
	.EVEN
DOTTAB:	.ASCII	/./
TAB:	.ASCII	/	/
	.EVEN
ARGBLK:	.BLKW	9.		;ROOM FOR FID,UIC,NAME,TYPE,VERS & OWNER UIC
ARGBL1:	.BLKW	30.		;ROOM FOR REST
;
OUTBLK:	.BLKB	1000		;OUTPUT BUFFER FOR EDMSG
;
	.END	START