.TITLE	BRD
	.IDENT	"V1.1"
	.NLIST	BEX
;
;   Author:	D. Mischler	19-JUN-88
;
;   This program will provide a directory listing of a BRU tape.
;   Many of the ideas in this program were stolen from a FORTRAN
;   program (BRUDIR) written by R. J. D. Kirkman.  This implemen-
;   tation fixes a couple of problems with named directories and
;   large numbers of files.
;
;   Command line format:
;
;	BRD>outfile=tape[/FU]
;
; V1.1	D. Mischler  07-SEP-88	Do not require volume label to be BACKUP.
;
CMDLUN	=	1		; Command input LUN for GCML.
CTRLEN	=	80.		; Length of all labels and control records.
IOEFN	=	1		; Event flag number for I/O operations.
MAXLEN	=	4144.		; Maximum BRU record length.
OUTLUN	=	4		; Output file unit number.
SMOTIM	=	120.		; Delay between IO.SMO requests (ticks).
TAPLUN	=	3		; Tape device unit number.
TILUN	=	2		; TI: unit number for output.

	.MCALL	ALUN$S,DIR$,EXST$,GTSK$S,MRKT$S,QIOW$S,WTSE$S
	.MCALL	CSI$,CSI$1,CSI$4,CSI$ND,CSI$SW
	.MCALL	GCML$,GCMLB$,GCMLD$,FCSMC$,FHDOF$

	CSI$			; Define CSI offsets and values.
	GCMLD$	DEF$L		; Define GCML offsets and bit values.
	FCSMC$			; Define common FCS macros.
	FHDOF$	DEF$L		; Define FILES-11 header format.
	FSRSZ$	1		; Initialize file storage region.
	.PAGE
;
;   Fatal error handling macro.
;
	.MACRO	FATAL	COND,MSGADR,?AROUND
$$$	=	.
	.IF IDN	<COND>,<CC>
	BCS	AROUND
	.ENDC
	.IF IDN	<COND>,<CS>
	BCC	AROUND
	.ENDC
	.IF IDN	<COND>,<EQ>
	BNE	AROUND
	.ENDC
	.IF IDN	<COND>,<LO>
	BHIS	AROUND
	.ENDC
	.IF IDN	<COND>,<NE>
	BEQ	AROUND
	.ENDC
	.IF EQ	.-$$$
	.ERROR	<Unimplemented condition>
	.ENDC
	.IF NB	<MSGADR>
	MOV	#MSGADR,R5
	.ENDC
	CALL	FATAL
AROUND:
	.ENDM	FATAL
	.PAGE
	.ASECT
;
;   BRU Backupset Control Block format.
;
	.=0
B.BAC:	.BLKB	12.		; Backupset name (ASCII).
B.VON:	.BLKW	1		; Backup volume set number (1st tape = 1).
B.VOL:	.BLKB	12.		; Disk volume label.
B.TIM:	.BLKW	8.		; GTIM$ format time & date of backup.
B.ISZ:	.BLKW	1		; Index file size in blocks.
B.MSZ:	.BLKW	2		; MFD ([0,0]) size in blocks.
B.DSZ:	.BLKW	2		; Disk size in blocks.
B.DSK:	.BLKB	2		; Disk device mnemonic (ASCII).
B.IFP:	.BLKW	1		; Index file position (0=BEG, 1=MID, 2=END).
	.BLKW	3		; Table of 3 free file ID's for BRU's use.
B.DAY:	.BLKB	7		; Day, month, year of backup (ASCII).
B.HR:	.BLKB	6		; Hour, minute, second of backup (ASCII).
	.BLKB	1		; Terminator (0).

;
;   BRU Directory Block format.
;
	.=0
D.IDNT:	.BLKB	4		; Should be .ASCIZ "UFD"
D.DID:	.BLKW	3		; Directory file ID, sequence, and volume.
D.FNAM:	.BLKW	3		; Directory file name.
D.FTYP:	.BLKW	1		; Directory file type.
D.FVER:	.BLKW	1		; Directory version number.
D.DLVL:	.BLKW	1		; Directory level (0=MFD, 1=UFD, ...?)
D.DFSZ:	.BLKW	2		; Directory file size in blocks.
D.OWN:	.BLKW	1		; Directory owner UIC.
D.PRO:	.BLKW	1		; Directory protection.
	.PAGE
	.PSECT	DATA,D,RW
;
;   Data definitions.
;
ALLOC:	.BLKW	2		; Blocks allocated in backup set.
BUSNUM:	.WORD	0		; Backup set number.
CSIBLK:	.BLKB	C.SIZE		; CSI control block.
CURALL:	.BLKW	2		; Blocks allocated in current directory.
CURCNT:	.BLKW	1		; Files in current directory.
CURUSD:	.BLKW	2		; Blocks used in current directory.
DIRCNT:	.BLKW	1		; Number of directories in backup set.
EOFCNT:	.BLKW	1		; Number of consecutive EOF marks.
EXSDPB:	EXST$	EX$SUC		; Exit with status DPB (success assumed).
FILCNT:	.BLKW	1		; Number of files in backup set.
FULLSW:	.WORD	0		; Full format request flag.
GCLBLK:	GCMLB$	,BRD,,CMDLUN	; Define GCML control block.
INUSE:	.BLKW	2		; Blocks used in backup set.
OUTBUF:	.BLKB	132.		; Output buffer.
OUTFDB:	FDBDF$			; Output file FDB.
	FDAT$A	R.VAR,FD.CR	; File attributes.
	FDRC$A	,OUTBUF		; Record access.
	FDOP$A	OUTLUN,CSIBLK+C.DSDS,OUTFNB,FO.WRT ; File open info.
OUTFNB:	NMBLK$	BRDOUTPUT,BRD,0,SY,0 ; Default filename block.
PROTBL:	.ASCII	"RWED"		; Protection type flags.
SPSAVD:	.BLKW	1		; Saved stack pointer.
SWTAB:	CSI$SW	FU,1,FULLSW	; /FU switch table.
	CSI$ND
TAPBUF:	.BLKB	MAXLEN		; Tape input buffer.
TAPISB:	.BLKW	2		; Tape I/O status block.
VOLUME:	.WORD	1		; Input volume expected.
	.PAGE
;
;   Text strings (error messages, etc.).
;
BCKLBL:	.ASCIZ	"Backup Set: "
BLKSTR:	.ASCIZ	". blocks in "
BSSLBL:	.ASCIZ	" Grand total of "
DIRLBL:	.ASCIZ	"Directory: ["
DRECTS:	.ASCIZ	". directories"
EBKSET:	.ASCIZ	"Backup set control block error"
EINDVC:	.ASCIZ	"Input device assignment error"
ENOBRU:	.ASCIZ	"Not a backup tape"
EOUTFI:	.ASCIZ	"Output file open error"
EQIORJ:	.ASCIZ	"QIO rejected"
ERWIND:	.ASCIZ	"Tape rewind error"
ESYNTX:	.ASCIZ	"Command syntax error"
ETAPRD:	.ASCIZ	"Tape read error"
ET4MAT:	.ASCIZ	"Tape format error"
EUFDXP:	.ASCIZ	"UFD record expected"
EWRONG:	.ASCIZ	"Tape out of sequence"
FILSTR:	.ASCIZ	". files"
NXTMSG:	.ASCIZ	"BRD - Please Mount Tape "
OWNLBL:	.ASCIZ	"]  Owner: ["
PROLBL:	.ASCIZ	"]  Protection: ["
SUMSTR:	.ASCIZ	" Total of "
SYSMSG:	.ASCIZ	"Bootable System Image: "
VOLLBL:	.ASCIZ	"  Volume: "
WHNLBL:	.ASCIZ	"  On: "
	.EVEN
	.PAGE
	.SBTTL	Main Program
	.PSECT	CODE,I,RO
;
;   Start here.
;
BRD:	MOV	SP,SPSAVD	; Save initial stack pointer.
	CALL	INIT		; Process command line, etc.
	CALL	NEWVOL		; Start reading from the first volume.
;
;   Here to begin reading a new backup set.
;
NEWBUS:	MOV	#"R1,R1		; Set up header record type code.
	CALL	RDTAPE		; Read a record from tape, OK?
	BCC	10$		; Yes, go on...
	TST	BUSNUM		; Has a valid backup set been read?
	FATAL	EQ,ENOBRU	; No, this is not a good tape.
	BR	BRD		; All finished: get next command...
;   Check backup set header records.
10$:	CMP	#CTRLEN,2(R5)	; Is the record length OK?
	BNE	20$		; No, forget it.
	CMP	#"HD,(R4)+	; Does it look like a header label?
	BNE	20$		; No, complain.
	CMP	R1,(R4)+	; Is it the correct HDRx label?
20$:	FATAL	NE,ET4MAT	; No, complain.
	ADD	#256.,R1	; Set up for next header record.
	CALL	RDTAPE		; Read next record, OK?
	BCC	10$		; Yes, check it out.
	CMP	R1,#"R3		; Did HDR1 and HDR2 (at least) check out?
	FATAL	LO,ET4MAT	; No, complain and exit.
;   Here to read and check the backup set control block.
	CALL	RDTAPE		; Read backup set control block, OK?
	FATAL	CS,ET4MAT	; No, complain and die.
	CMP	#CTRLEN,2(R5)	; Is record length correct?
	FATAL	NE,ET4MAT	; No, backup set error.
	CMP	B.VON(R4),VOLUME ; Is the volume number correct?
	FATAL	NE,EWRONG	; No, tell user it's the wrong tape.
	CMP	#1,VOLUME	; Is this the first tape?
	BNE	IGNORE		; No, don't output backup set control block.
	CALL	FMTBCK		; Format backup set control block for output.
	.PAGE
;
;   Ignore everything up to the next "HEAD" record.
;
IGNORE:	CALL	RDTAPE		; Read a record, EOF?
	BCS	EOVCHK		; Yes, check for possible end of volume.
	CMP	#CTRLEN,2(R5)	; Could this possibly be a "HEAD" record?
	BNE	IGNORE		; No, keep looking.
	MOV	#CTRLEN/4,R0	; Get length of record in "HEAD"s.
10$:	CMP	#"HE,(R4)+	; Does record look OK so far?
	BNE	IGNORE		; No, get next record.
	CMP	#"AD,(R4)+	; Does it still look OK?
	BNE	IGNORE		; No, get next record.
	SOB	R0,10$		; Check entire record.
;   Found "HEAD" record: output directory and file info.
DODIR:	CALL	RDTAPE		; Read a record, EOF?
	BCS	EOVCHK		; Yes, check for EOV.
	CMP	#CTRLEN,2(R5)	; Is this a file header block?
	BNE	20$		; Yes, take care of it.
	CMP	#"DA,(R4)	; Is this the data flag?
	BEQ	IGNORE		; Yes, ignore data blocks.
	CMP	#"UF,(R4)	; Is this a UFD record?
	FATAL	NE,ET4MAT	; No, complain and terminate.
	TST	DIRCNT		; First directory in this backup set?
	BEQ	10$		; Yes, do not summarize nothing.
	CALL	SUMDIR		; Summarize previous directory.
10$:	CALL	FMTDIR		; Format directory record.
	BR	DODIR		; Get next record.
;   Here to process a header block.
20$:	CALL	FMTHDR		; Format a file header.
	ADD	#512.,R4	; Point past current file header.
	SUB	#512.,2(R5)	; Is there another header in this block?
	BHI	20$		; Yes, format it too.
	BR	DODIR		; Get next record.

;
;   Here when an EOF is read.  Look for end of volume.
;
EOVCHK:	CALL	RDTAPE		; Read next record, another EOF?
	BCS	NXTAPE		; Yes, it's the end of this tape.
	CMP	#"EO,(R4)+	; Is record an EOF or EOV label?
	FATAL	NE,ET4MAT	; No, something is wrong...
	CMP	#"V1,(R4)	; Is record an EOV label?
	BEQ	NXTAPE		; Yes, get next tape.
	CALL	SUMDIR		; Summarize current directory.
	CALL	SUMBCK		; Summarize current backup set.
	INC	BUSNUM		; Count a complete backup set.
10$:	CALL	RDTAPE		; Read next record, EOF?
	BCC	10$		; No, keep reading.
	JMP	NEWBUS		; Check for another backup set.
;
;   Here when end of volume is reached in the middle of a backup set.
;
NXTAPE:	QIOW$S	#IO.RWD,#TAPLUN,#IOEFN,,#TAPISB ; Rewind the current tape.
	QIOW$S	#IO.RWU,#TAPLUN,#IOEFN,,#TAPISB ; Unload it, too.
	MOV	#OUTBUF,R0	; Point to output buffer.
	MOV	R0,R3		; Copy pointer.
	MOV	(PC)+,(R0)+	; Work on a new line.
	.BYTE	CR,LF
	MOVB	-1(R0),(R0)+	; Dump a blank line.
	MOV	#NXTMSG,R1	; Point to next tape request message.
	CALL	STRCPY		; Buffer it.
	INC	VOLUME		; Increment to next volume.
	MOV	VOLUME,R1	; Get next volume number.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBDMG		; Convert tape number to decimal.
	SUB	R3,R0		; Get length of message.
	QIOW$S	#IO.WVB,#TILUN,#IOEFN,,,,<R3,R0> ; Send it.
;   Wait for the next tape to be loaded.
10$:	QIOW$S	#IO.SMO,#TAPLUN,#IOEFN,,#TAPISB	; Attempt to mount new tape.
	CMPB	#IS.SUC,TAPISB		; Did IO.SMO succeed?
	BEQ	20$			; Yes, get going.
	MRKT$S	#IOEFN,#SMOTIM,#1	; Wait a few ticks.
	WTSE$S	#IOEFN
	BR	10$			; Try again.
;   Start reading from new volume.
20$:	CALL	NEWVOL		; Start new volume processing.
	JMP	NEWBUS		; Check labels and backup set control block.
	.PAGE
	.SBTTL	Program Initialization
;
;   Routine to initialize the program and process a command line.
;
INIT:	CLR	BUSNUM			; No backup sets have been processed.
	MOV	#1,VOLUME		; Expect tape 1 to be loaded.
	QIOW$S	#IO.DET,#TAPLUN,#IOEFN	; Make sure tape is detached.
	TST	OUTFDB+F.BDB		; Is an output file open?
	BEQ	10$			; No, don't try to close it.
	CLOSE$	#OUTFDB			; Close output file.
10$:	GCML$	#GCLBLK			; Get a command line, OK?
	BCS	EXIT			; No, exit.
	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; Analyze command syntax.
	FATAL	CS,ESYNTX		; Complain if an error is detected.
	CSI$4	#CSIBLK,INPUT,#SWTAB	; Parse for input device spec, OK?
	FATAL	CS,ESYNTX		; No, complain.
	MOV	#OUTFDB,R0		; Point to output file FDB.
	MOV	#OUTFDB+F.FNB,R1	; Point to filename block.
	MOV	#CSIBLK+C.DSDS,R2	; Point to dataset descriptor.
	CLR	R3			; Do not use a default filename block.
	MOVB	F.LUN(R0),-(SP)		; Save output file LUN.
	MOVB	#TAPLUN,F.LUN(R0)	; Make output FDB do double duty.
	CALL	.PRSDV			; Parse device specification.
	MOVB	(SP)+,F.LUN(R0)		; Restore output file LUN, all OK?
	FATAL	CS,EINDVC		; No, complain.
	QIOW$S	#IO.ATT,#TAPLUN,#IOEFN	; Attach the tape drive.
	MOV	#OUTFDB+F.FNB,R0	; Point to filename block.
	MOV	#<N.UNIT+2>/2,R1	; Get filename block length in words.
20$:	CLR	(R0)+			; Zero filename block.
	SOB	R1,20$
	CSI$4	#CSIBLK,OUTPUT		; Parse for output filespec, OK?
	FATAL	CS,ESYNTX		; No, complain.
	OPEN$W	#OUTFDB			; Open output file, OK?
	FATAL	CS,EOUTFI		; No, complain.
	RETURN
;
;   Terminate the task.
;
EXIT:	DIR$	#EXSDPB		; Exit with appropriate status.
	BPT
	.PAGE
	.SBTTL	Backup Set Control Block routines
;
;   Routine to format and output a backup set control block.
;
FMTBCK:	MOV	#OUTBUF,R1	; Point to output buffer.
	MOVB	#FF,(R1)	; Buffer a form feed.
	MOV	#1,R0		; Get record length.
	CALL	WROUT		; Write it.
	MOV	#OUTBUF,R0	; Point to output buffer.
	MOV	#BCKLBL,R1	; Point to backup set label.
	CALL	STRCPY		; Copy string into place.
	MOV	#TAPBUF+B.BAC,R1 ; Point to backup set name.
	CALL	STRCPY		; Append it to the buffer.
	MOV	#VOLLBL,R1	; Point to volume label string.
	CALL	STRCPY		; Append it to the buffer.
	MOV	#TAPBUF+B.VOL,R1 ; Point to disk volume label.
	CALL	STRCPY		; Append it.
	MOV	#WHNLBL,R1	; Point to "when" label.
	CALL	STRCPY		; Put it in place.
 	MOV	R4,R1		; Copy tape buffer address.
	ADD	#B.TIM,R1	; Point to GTIM$ format backup time.
	CALL	$DAT		; Format date.
	MOVB	#' ,(R0)+	; Delimit date and time.
	MOV	#3,R2		; Set format to HH:MM:SS.
	CALL	$TIM		; Format time.
	MOV	#OUTBUF,R1	; Point to output buffer.
	SUB	R1,R0		; Calculcate length of data.
	CALL	WROUT		; Write line to output file.
	CLR	DIRCNT		; Zero number of directories in backup set.
	CLR	FILCNT		; Zero number of files in backup set.
	CLR	ALLOC		; Zero blocks allocated in backup set.
	CLR	ALLOC+2
	CLR	INUSE		; Zero blocks used in backup set.
	CLR	INUSE+2
	RETURN
	.PAGE
;
;   Routine to format and output a backup set summary line.
;
SUMBCK:	MOV	#BSSLBL,R1	; Point to backup set summary label.
	CLR	R0		; Pretend it is of zero length.
	CALL	WROUT		; Write a blank line.
	MOV	#OUTBUF,R0	; Point to output buffer.
	CALL	STRCPY		; Buffer backup set summary label.
	MOV	#INUSE,R1	; Point to size in use.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Buffer blocks in use.
	MOVB	#'.,(R0)+	; Decimalize value.
	MOVB	#'/,(R0)+	; Delimit used/allocated.
	MOV	#ALLOC,R1	; Point to size allocated.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Buffer blocks allocated.
	MOV	#BLKSTR,R1	; Point to "blocks in" string.
	CALL	STRCPY		; Append it to summary line.
	MOV	FILCNT,R1	; Get number of files in backup set.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBDMG		; Buffer number of files.
	MOV	#FILSTR,R1	; Point to file string.
	CALL	STRCPY		; Append it.
	MOVB	#' ,(R0)+	; Set up an " in "
	MOVB	#'i,(R0)+
	MOVB	#'n,(R0)+
	MOVB	#' ,(R0)+
	MOV	DIRCNT,R1	; Get number of directories in backup set.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBDMG		; Buffer number of directories.
	MOV	#DRECTS,R1	; Point to ". directories" string.
	CALL	STRCPY		; Append it.
	MOV	#OUTBUF,R1	; Point to start of output buffer.
	SUB	R1,R0		; Get line length.
	CALLR	WROUT		; Dump line and return.
	.PAGE
	.SBTTL	Directory Block routines
;
;   Routine to format and output a directory record.
;
FMTDIR:	INC	DIRCNT		; Count a directory for current backup set.
	MOV	#DIRLBL,R1	; Point to directory label string.
	CLR	R0		; Set up a blank line.
	CALL	WROUT		; Dump a pair of blank lines.
	CALL	WROUT
	MOV	#OUTBUF,R0	; Point to output buffer.
	CALL	STRCPY		; Put directory label in buffer.
	MOV	R4,R3		; Copy tape buffer address.
	ADD	#D.FNAM,R3	; Point to RAD50 directory name.
	MOV	R0,-(SP)	; Save directory string address.
	MOV	(R3)+,R1	; Get first word of directory name.
	CALL	$C5TA		; Convert it to ASCII.
	MOV	(R3)+,R1	; Get second word.
	CALL	$C5TA		; Convert it too.
	MOV	(R3),R1		; Get last word.
	CALL	$C5TA		; Finish directory name conversion.
10$:	CMPB	#' ,-(R0)	; Is last character a blank?
	BEQ	10$		; Yes, check again.
	INC	R0		; Repair pointer.
	MOV	(SP),R2		; Point to start of directory string.
20$:	MOVB	(R2)+,R1	; Get a character from the string.
	SUB	#'0,R1		; Remove ASCII digit bias.
	CMP	R1,#7		; Is character an octal digit?
	BLOS	30$		; No, it must be a named directory.
	TST	(SP)+		; Throw away saved string address.
	BR	40$		; Terminate directory string and move on.
;   Check next character in directory string.
30$:	CMP	R2,R0		; All characters checked?
	BNE	20$		; No, keep checking.
	MOV	(SP)+,R0	; Restore directory string start address.
	MOV	R4,R3		; Copy tape buffer address.
	ADD	#D.FNAM,R3	; Point to RAD50 directory name.
	CALL	NUMDIR		; Convert group code.
	MOVB	#',,(R0)+	; Separate group and user codes.
	CALL	NUMDIR		; Convert user code.
40$:	MOV	#OWNLBL,R1	; Point to owner label string.
	CALL	STRCPY		; Append it.
	MOVB	D.OWN+1(R4),R1	; Get owner group code.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBTMG		; Format group code.
	MOVB	#',,(R0)+	; Separate group and user codes.
	MOVB	D.OWN(R4),R1	; Get owner user code.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBTMG		; Format user code.
	MOV	#PROLBL,R1	; Point to protection label.
	CALL	STRCPY		; Append it to the end.
	MOV	D.PRO(R4),R1	; Get directory protection word.
	CALL	PROFMT		; Format protection.
	MOVB	#'],(R0)+	; Terminate protection string.
	CLR	CURCNT		; Zero number of files for this directory.
	CLR	CURALL		; Zero blocks allocated for directory.
	CLR	CURALL+2
	CLR	CURUSD		; Zero blocks used for directory.
	CLR	CURUSD+2
	MOV	#OUTBUF,R1	; Point to output buffer.
	SUB	R1,R0		; Get line length in R0.
	CALL	WROUT		; Write directory line to output file.
	CLR	R0		; Set up a blank line.
	CALLR	WROUT		; Write it too, and return.
	.PAGE
;
;   Routine to format and output a directory summary line.
;
SUMDIR:	MOV	#SUMSTR,R1	; Point to summary line label.
	CLR	R0		; Assume it is of zero length.
	CALL	WROUT		; Dump a blank line.
	MOV	#OUTBUF,R0	; Point to output buffer.
	CALL	STRCPY		; Copy label into place.
	MOV	#CURUSD,R1	; Point to size in use.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Buffer blocks in use.
	MOVB	#'.,(R0)+	; Decimalize value.
	MOVB	#'/,(R0)+	; Delimit used/allocated.
	MOV	#CURALL,R1	; Point to size allocated.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Buffer blocks allocated.
	MOV	#BLKSTR,R1	; Point to "blocks in" string.
	CALL	STRCPY		; Append it to summary line.
	MOV	CURCNT,R1	; Get number of files in directory.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBDMG		; Buffer number of files.
	MOV	#FILSTR,R1	; Point to file string.
	CALL	STRCPY		; Append it.
	ADD	CURCNT,FILCNT	; Add files in directory to backup set total.
	ADD	CURALL,ALLOC	; Add blocks allocated to backup set total.
	ADD	CURALL+2,ALLOC+2
	ADC	ALLOC
	ADD	CURUSD,INUSE	; Add blocks used to backup set total.
	ADD	CURUSD+2,INUSE+2
	ADC	INUSE
	MOV	#OUTBUF,R1	; Point to start of output buffer.
	SUB	R1,R0		; Get line length.
	CALLR	WROUT		; Dump line and return.
	.PAGE
	.SBTTL	File Header routines
;
;   Routine to format a file header.
;
FMTHDR:	TSTB	S.HDHD+S.IDHD+M.ESQN(R4) ; Is this an extension header?
	BEQ	10$			 ; No, format it.
	RETURN
;   Header is not an extension of a previous header.
10$:	INC	CURCNT		; Count a file for the current directory.
	MOV	#OUTBUF,R0	; Point to output buffer.
	MOVB	#' ,(R0)+	; Start in just a little bit.
	MOV	R4,R3		; Copy file header address.
	ADD	#S.HDHD,R3	; Point to file identification area.
	MOV	(R3)+,R1	; Get first file name word.
	CALL	$C5TA		; Convert it to ASCII.
	MOV	(R3)+,R1	; Get middle file name word.
	CALL	$C5TA		; Convert it to ASCII.
	MOV	(R3)+,R1	; Get last file name word.
	CALL	$C5TA		; Convert it to ASCII.
	MOVB	#'.,(R0)+	; Separate name and type.
	MOV	(R3)+,R1	; Get file type word.
	CALL	$C5TA		; Convert it to ASCII.
	MOVB	#';,(R0)+	; Separate type and version.
	MOV	(R3),R1		; Get file version number.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBDMG		; Convert version number to decimal.
	MOV	#OUTBUF+22.,R1	; Get address of desired column.
	SUB	R0,R1		; Get number of padding blanks needed.
20$:	MOVB	#' ,(R0)+	; Stuff in a blank.
	SOB	R1,20$		; Do 'em all.
	MOV	R4,R1		; Copy file header address.
	ADD	#H.UFAT+10,R1	; Point to end of file block.
	TST	4(R1)		; Is entire "last" block free?
	BNE	30$		; No, end of file block is OK.
	SUB	#1,2(R1)	; Adjust EOF block downwards.
	SBC	(R1)
30$:	ADD	(R1),CURUSD	; Add to blocks in use.
	ADD	2(R1),CURUSD+2
	ADC	CURUSD
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Display blocks in use.
	MOVB	#'.,(R0)+	; Indicate blocks are decimal.
	MOV	R4,R1		; Copy file header address.
	ADD	#H.UFAT+4,R1	; Point to highest block allocated.
	ADD	(R1),CURALL	; Add to blocks allocated.
	ADD	2(R1),CURALL+2
	ADC	CURALL
	MOVB	#'/,(R0)+	; Delimit blocks used/allocated.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CDDMG		; Display blocks allocated.
	MOVB	#'.,(R0)+	; Indicate blocks are decimal.
	MOV	#OUTBUF+37.,R1	; Get address of desired column.
	SUB	R0,R1		; Get number of pad characters, all right?
	BHI	40$		; Yes, pad it out.
	MOV	#2,R1		; Compromise our positioning.
40$:	MOVB	#' ,(R0)+	; Stuff in a blank.
	SOB	R1,40$		; Do 'em all.
	MOVB	#' ,R1		; Assume file is discontiguous.
	TSTB	H.UCHA(R4)	; Is the file contiguous?
	BPL	50$		; No, dump the blank.
	MOVB	#'C,R1		; Get contiguous file indicator.
50$:	MOVB	R1,(R0)+	; Buffer it.
	MOVB	#' ,R1		; Assume file is not locked.
	BITB	#UC.DLK,H.UCHA(R4) ; Is file locked?
	BEQ	60$		; No, dump the blank.
	MOVB	#'L,R1		; Get locked file indicator.
60$:	MOVB	R1,(R0)+	; Buffer it.
	MOVB	#' ,(R0)+	; Pad out to next field.
	MOVB	#' ,(R0)+
	MOV	R4,R1		; Copy file header address.
	ADD	#S.HDHD+I.CRDT,R1 ; Point to ASCII creation date.
	CALL	ASCTIM		; Reformat time and date a little.
	TST	FULLSW		; Was a full listing requested?
	BEQ	99$		; No, dump it as it is.
	MOVB	#' ,(R0)+	; Space out a little.
	MOVB	#' ,(R0)+
	MOVB	#'(,(R0)+	; Open file ID.
	MOV	R0,R3		; Save current buffer pointer.
	MOV	H.FNUM(R4),R1	; Get file number.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBOMG		; Convert it to octal.
	MOVB	#',,(R0)+	; Buffer a comma.
	MOV	H.FSEQ(R4),R1	; Get file sequence number.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBOMG		; Convert it to octal.
	MOVB	#'),(R0)+	; Close file ID.
	SUB	R0,R3		; Get negative of characters buffered.
	ADD	#16.,R3		; Calculate number of blanks needed.
70$:	MOVB	#' ,(R0)+	; Buffer a blank.
	SOB	R3,70$		; Repeat as necessary.
	MOVB	#'[,(R0)+	; Open file owner.
	MOV	R0,R3		; Save buffer pointer.
	MOVB	H.PROJ(R4),R1	; Get owner group code.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBTMG		; Format group code.
	MOVB	#',,(R0)+	; Separate group and user codes.
	MOVB	H.PROG(R4),R1	; Get owner user code.
	CLR	R2		; Suppress leading zeroes.
	CALL	$CBTMG		; Format user code.
	MOVB	#'],(R0)+	; Close file owner.
	SUB	R0,R3		; Get negative of characters buffered.
	ADD	#10.,R3		; Get number of blanks needed.
80$:	MOVB	#' ,(R0)+	; Buffer a blank.
	SOB	R3,80$		; Repeat as necessary.
	MOVB	#'[,(R0)+	; Open file protection.
	MOV	R0,R3		; Save buffer pointer.
	MOV	H.FPRO(R4),R1	; Get file protection.
	CALL	PROFMT		; Format it.
	MOVB	#'],(R0)+	; Close file protection.
	SUB	R0,R3		; Get negative of characters buffered.
	ADD	#22.,R3		; Get number of blanks needed.
90$:	MOVB	#' ,(R0)+	; Space out to next field.
	SOB	R3,90$
	MOV	R4,R1		; Copy file header pointer.
	ADD	#S.HDHD+I.RVDT,R1	; Point to revision date.
	CALL	ASCTIM			; Reformat it a little.
	MOVB	#'(,(R0)+		; Open revision number.
	MOV	S.HDHD+I.RVNO(R4),R1	; Get revision number.
	CLR	R2			; Suppress leading zeroes.
	CALL	$CBDMG		; Convert to decimal ASCII.
	MOVB	#'.,(R0)+	; Decimalize it.
	MOVB	#'),(R0)+	; Close revision number field.
99$:	MOV	#OUTBUF,R1	; Point to output buffer.
	SUB	R1,R0		; Get line length.
	CALLR	WROUT		; Write it to the output file.
	.PAGE
	.SBTTL	Utility routines
;
;   Subroutine to reformat an ASCII time and date.
;
ASCTIM:	MOVB	(R1)+,(R0)+	; Copy day.
	MOVB	(R1)+,(R0)+
	MOVB	#'-,(R0)+	; Separate day and month.
	MOVB	(R1)+,(R0)+	; Copy month.
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	#'-,(R0)+	; Separate month and year.
	MOVB	(R1)+,(R0)+	; Copy year.
	MOVB	(R1)+,(R0)+
	MOVB	#' ,(R0)+	; Separate date and time.
	MOVB	(R1)+,(R0)+	; Copy hour.
	MOVB	(R1)+,(R0)+
	MOVB	#':,(R0)+	; Separate hour and minute.
	MOVB	(R1)+,(R0)+	; Copy minute.
	MOVB	(R1)+,(R0)+
	RETURN

;
;   Subroutine to expand the file protection word in R1 into ASCII (R0)+
;
PROFMT:	JSR	R5,.SAVR1	; Save registers R1 - R5.
	MOV	#4,R4		; Get outer loop count.
10$:	MOV	#4,R3		; Get inner loop count.
	MOV	#PROTBL,R2	; Point to protection flag table.
20$:	MOVB	(R2)+,(R0)+	; Assume access is allowed.
	ROR	R1		; Is current access actually allowed?
	BCC	30$		; Yes, it's OK.
	DEC	R0		; Remove protection flag from buffer.
30$:	SOB	R3,20$		; Perform all inner loop iterations.
	MOVB	#',,(R0)+	; Separate access categories.
	SOB	R4,10$		; Perform all outer loop iterations.
	DEC	R0		; Eliminate trailing comma.
	RETURN

;
;   Subroutine to format the group or member of a UIC directory.
;
NUMDIR:	MOV	(R3)+,R1	; Get directory name word.
	MOV	R0,-(SP)	; Save string section address.
	CALL	$C5TA		; Convert name word to ASCII.
	MOV	(SP)+,R2	; Recover string section address.
	MOV	#2,R1		; Get maximum number of digits to remove.
10$:	CMPB	#'0,(R2)	; Is leading digit a zero?
	BNE	20$		; No, exit.
	MOVB	1(R2),(R2)	; Get rid of leading zero.
	MOVB	-(R0),1(R2)
	SOB	R1,10$		; Keep going if possible.
20$:	RETURN

;
;   Routine to copy an ASCIZ string (R1)+,(R0)+
;
STRCPY:	MOVB	(R1)+,(R0)+	; Copy a byte, is it the end?
	BNE	STRCPY		; No, keep going.
	DEC	R0		; Back up over terminator.
	RETURN
	.PAGE
	.SBTTL	Input Device routines
;
;   Routine to start reading a new input volume.
;
NEWVOL:	QIOW$S	#IO.RWD,#TAPLUN,#IOEFN,,#TAPISB	; Rewind the tape.
	FATAL	CS,ERWIND
	CLR	EOFCNT		; No tape marks have been seen.
	CALL	RDTAPE		; Read first record, OK?
	FATAL	CS,ETAPRD	; No, complain.
	CMP	#CTRLEN,2(R5)	; Is length OK for a volume label?
	BNE	SKPSYS		; No, see if there is a bootable system.
	CMP	#"VO,(R4)+	; Is this a VOL1 label?
	BNE	VOLERR		; No, get rid of it.
	CMP	#"L1,(R4)	; Check second half too.
	BNE	VOLERR
	CALL	RDTAPE		; Read boot block, OK?
	FATAL	CS,ENOBRU	; Nope, give up.
	CMP	#512.,2(R5)	; Is boot block length OK?
VOLERR:	FATAL	NE,ENOBRU	; No, complain.
	RETURN
;   Check for and skip over a bootable system.
SKPSYS:	CMP	#1,VOLUME	; Is this the first tape?
	BNE	VOLERR		; No, complain.
	CMP	#512.,2(R5)	; Is length correct for a system label?
	BNE	VOLERR		; No, complain and exit.
	MOV	#OUTBUF,R0	; Point to output buffer.
	MOV	#SYSMSG,R1	; Point to system image text.
	CALL	STRCPY		; Copy it into place.
	MOV	#12.,R1		; Get length of label.
10$:	MOVB	(R4)+,(R0)+	; Copy system label name to buffer.
	SOB	R1,10$
	MOV	#OUTBUF,R1	; Point to line to be output.
	SUB	R1,R0		; Get line length.
	CALL	WROUT		; Dump it.
20$:	CALL	RDTAPE		; Read next record, EOF?
	BCS	30$		; Yes, look for HDR1 and HDR2 labels.
	CMP	#512.,2(R5)	; Is record length correct?
	BEQ	20$		; Yes, get next record.
	BNE	VOLERR		; Volume must not be a backup tape.
;   Found EOF, assume backup set labels follow.
30$:	RETURN

;
;   Routine to read a block from tape.
;   On exit:	R4 points to buffer, R5 points to I/O status block.
;		The carry will be set if a tape mark was read.
;
RDTAPE:	CMP	EOFCNT,#2	; Has the end of the tape been reached?
	BHIS	20$		; Yes, make it very clear.
	MOV	#TAPBUF,R4	; Point to tape input buffer.
	MOV	#TAPISB,R5	; Point to tape I/O status block.
	QIOW$S	#IO.RLB,#TAPLUN,#IOEFN,,R5,,<R4,#MAXLEN>
	FATAL	CS,EQIORJ
	CMPB	#IS.SUC,(R5)	; Was the read successful?
	BNE	10$		; No, check it out.
	CLR	EOFCNT		; This is a real record.
	RETURN
;   An error of some kind was returned.
10$:	CMPB	#IE.EOF,(R5)	; End of file mark?
	FATAL	NE,ETAPRD	; No, complain and die.
	INC	EOFCNT		; Count consecutive tape marks.
20$:	SEC			; Indicate a tape mark was read.
	RETURN
	.PAGE
	.SBTTL	Output routines
;
;   Routine to write a line to the output file.
;   On entry:	R0 contains length, R1 points to line.
;
WROUT:	JSR	R2,$SAVVR	; Save registers R0 - R2.
	MOV	R0,R2		; Copy line length.
	PUT$	#OUTFDB,R1,R2	; Write record to output file.
	RETURN

;
;   Routine to output an error message and exit.
;   On entry:	R5 points to ASCIZ error message.
;
FATAL:	MOV	#OUTBUF,R0	; Point to output buffer.
	MOV	R0,R4		; Make another copy.
	MOV	(PC)+,(R0)+	; Start on a new line.
	.BYTE	CR,LF
	SUB	#36.,SP		; Allocate space for a GTSK$ buffer.
	MOV	SP,R3		; Point to it.
	GTSK$S	R3		; Get task parameters.
	MOV	(R3)+,R1	; Get first task name word.
	CALL	$C5TA		; Convert it to ASCII.
	MOV	(R3),R1		; Get second task name word.
	CALL	$C5TA		; Convert it to ASCII too.
	ADD	#36.,SP		; Delete GTSK$ buffer.
	MOVB	#' ,(R0)+	; Delimit name and error message.
	MOVB	#'-,(R0)+
	MOVB	#' ,(R0)+
10$:	MOVB	(R5)+,(R0)+	; Copy a message character, done yet?
	BNE	10$		; No, keep going.
	DEC	R0		; Back up over null.
	SUB	R4,R0		; Get length of buffer.
	QIOW$S	#IO.WVB,#TILUN,#IOEFN,,,,<R4,R0>
	MOV	#EX$ERR,EXSDPB+E.XSTS ; Set exit status for later.
	MOV	SPSAVD,SP	; Clean all junk off stack.
	JMP	BRD		; Get next command line, etc.

	.END	BRD