.Title	FINDUIC
.ENABLE	DBG
.IDENT	/X01.06/

;FINDUIC.MAR - Programme to list all files by PPN

; Layout of File Header Block

FH.EAD	=^O40446		; Valid Header looks like this

F.HEAD	=0			; Header Offset
F.NUM	=^O10			; File # Offset
F.SEQ	=^O12			; Seq. # Offset
P.ROG	=^O74			; Prog # Offset
P.ROJ	=^O76			; Proj # Offset
F.NAM	=^O114			; FILNAM Offset
F.END	=^O140			; End  # Offset

; Layout of Node in Tree

L.LAST	=.-.			; Left Pointer
L.NEXT	=L.LAST+4		; Right Pointer
L.DATA	=L.NEXT+4		; Start of Data

; Define Job/Process Offsets

$JPIDEF

; Define Buffer Sizes

BUFLEN	=^O1000			; Length of Header Block
LINLEN	=^O100			; Length of Line Buffer

.MACRO	PRINT	X
	MOVL	X,R0
	TSTB	(R0)+
	BNEQ	.-3
	SUBL	X,R0
	MOVL	X,OTRAB+RAB$L_RBF
	MOVW	R0,OTRAB+RAB$W_RSZ
	$PUT	RAB=OTRAB
.ENDM

.MACRO	STORE	X
	MOVL	X,-(SP)
	CALLS	#1,STORE
.ENDM


.PSECT	CODE

.ENTRY	BEGIN,^M<R2,R3>
	JSB	GETCMD		; Get User's Command
	JSB	GETDSK		; Get Disk to Scan
	JSB	GETPPN		; Get UIC
	JSB	GETLST		; Get Listing Device
	JSB	OPEN		; Open [0,0]INDEXF.SYS
	JSB	SEARCH		; Scan [0,0]INDEXF.SYS for Files
	JSB	OTOPEN		; Open the Listing Device
	MOVAL	ROOT,-(SP)	; Print the Tree
	CALLS	#1,PRINT	;   (Recursive)
	JSB	CLOSE		; Close Input and Output
	$EXIT_S

GETCMD:	PUSHAL	INLEN		; 
	PUSHAL	PROMPT		;
	PUSHAL	LINDES
	CALLS	#3,G^LIB$GET_FOREIGN ; J=GET_FOREIGN(LINBUF,PROMPT,INLEN)
	BLBC	R0,10$
	MOVAL	LINBUF,R2	; R2 --> Next (First) character in LINBUF
	RSB

10$:	JMP	BOMB

GETDSK:	MOVAL	INNAME,R1	; R1 --> Filename Buffer
	TSTW	INLEN		; Null String?
	BEQL	5$
	CMPB	#^A%[%,(R2)	; [P,PN] Delimiter?
	BEQL	5$
	CMPB	#^A%/%,(R2)	; Option Delimiter?
	BEQL	5$
	BRW	10$
5$:	MOVAL	DNS0,R0		; Yes, then default Disk
	BRW	18$

10$:	CMPB	#^A%[%,(R2)	; Done?
	BEQL	15$
	CMPB	#^A%/%,(R2)
	BEQL	15$
	TSTL	INLEN		; Scanned Everything?
	BEQL	99$		; Yes -- then Syntax Error
	MOVB	(R2)+,(R1)+	; No - copy Byte of File Descriptor
	DECW	INLEN
	CMPB	#^A%:%,-1(R2)	; Colon is delimiter
	BEQL	15$
	BRW	10$

15$:	MOVAL	DNS1,R0		; R0 --> File Name String
18$:	MOVB	(R0)+,(R1)+
	BNEQ	18$
	SUBL	#INNAME,R1
	MOVB	R1,INFAB+FAB$B_FNS ; Install File Name Size in INFAB
	RSB

99$:	MOVL	#SS$_BADPARAM,R0
	JMP	BOMB

GETPPN:	DECW	INLEN
	BLSS	10$		; Null String
	CMPB	#^A%[%,(R2)+	; First Character must be [
	BNEQ	5$
	JSB	GETNUM		; Get Project Number
	MOVL	R1,PROJ		; Install It
	DECW	INLEN
	CMPB	#^A%,%,(R2)+	; Delimiter must be ,
	BNEQ	99$
	JSB	GETNUM		; Get Programmer Number
	MOVL	R1,PROG		; Install it
	DECW	INLEN
	CMPB	#^A%]%,(R2)+	; Delimiter must be ]
	BNEQ	99$
	RSB

5$:	INCW	INLEN
	CMPB	#^A%/%,-(R2)	; Option Designator?
	BNEQ	99$
10$:	$GETJPI_S	ITMLST=ITMLST
	RSB

99$:	MOVL	#SS$_BADPARAM,R0
	JMP	BOMB

GETNUM:	CLRL	R1		; Initialize Number
5$:	SUBB	#48,(R2)	; Convert Digit to Number
	BLSS	10$		;  (Invalid)
	CMPB	#7,(R2)
	BLSS	10$		;  (Invalid)
	MULL	#8,R1		; Shift previous number
	DECW	INLEN
	ADDB	(R2)+,R1	; Add in this Digit
	BRW	5$

10$:	ADDB	#48,(R2)	; Restore Line Buffer
	RSB			; Exit with R2 --> Delimiter

GETLST:	CMPB	#32,(R2)	; Scan for Spaces
	BNEQ	5$		;  (Not a Space)
	DECW	INLEN
	TSTB	(R2)+		; Skip over this Space
	BRW	GETLST

5$:	TSTW	INLEN		; Option Specified?
	BLEQ	20$		;  (No)
	MOVAL	OPTL,R1		; R1 --> Option String
10$:	DECW	INLEN
	CMPB	(R1)+,(R2)+	; Search until Delimiter
	BEQL	10$
	CMPB	#^A%:%,-1(R2)	; Found Colon Delimiter?
	BEQL	12$
	CMPB	#^A%=%,-1(R2)	; Found Equals Delimiter?
	BEQL	12$
	BRW	99$		; No Delimiter Found

12$:	MOVAL	OTNAME,OTFAB+FAB$L_FNA	; Insert Listing Filename
	MOVB	INLEN,OTFAB+FAB$B_FNS	; ...and File Name Length
	BEQL	99$		; Syntax Error

	MOVZWL	INLEN,R0		; R0  =  Bytes to Copy
	MOVAL	OTNAME,R1		; R1 --> Filename Buffer
15$:	MOVB	(R2)+,(R1)+		; Copy Filename
	SOBGTR	R0,15$
20$:	RSB

99$:	MOVL	#SS$_BADPARAM,R0	; Syntax Error
	JMP	BOMB

OPEN:	$OPEN	FAB=INFAB	; Open DSK1:[0,0]INDEXF.SYS
	BLBC	R0,10$
	$CONNECT	RAB=INRAB
	BLBC	R0,10$
	CLRL	TOTBLK		; Clear Total Blocks
	CLRL	TOTFIL		;  and  Total Files
	RSB

10$:	JMP	BOMB

SEARCH:	JSB	FETCH		; Read in block from Index File
	BLBC	R0,20$
	JSB	FILTER		; Scan for Header, right [P,PN]
	BLBC	R0,SEARCH
	JSB	GETDAT		; Print data from File Header
	BRW	SEARCH

20$:	RSB

FETCH:	$GET	RAB=INRAB	; Read in Block
	BLBS	R0,10$
	CMPL	#RMS$_EOF,R0	; Error - EOF?
	BEQL	10$
	JMP	BOMB		; No -- Complain

10$:	RSB

FILTER:	MOVL	#SS$_ACCONFLICT,R0 ; Assume Error
	MOVAL	BUFFER,R1	; R1 -- File Header
	CMPW	#FH.EAD,F.HEAD(R1)
	BNEQ	10$		; Not Header Block
	CMPW	PROJ,P.ROJ(R1)
	BNEQ	10$		; Project Numbers don't match
	CMPW	PROG,P.ROG(R1)
	BNEQ	10$		; Programmer Numbers don't match
	TSTW	F.NUM(R1)
	BEQL	10$		; File is Deleted
	MOVL	#SS$_NORMAL,R0	; File Header is OK
	INCL	TOTFIL		; Found Valid File
10$:	RSB

GETDAT:	MOVAL	BUFFER,R1	; R1 --> File Header
	MOVAL	LINBUF,R2	; R2 --> Output Buffer
	CLRB	F.END(R1)	; Clear End of Filename
	MOVAL	F.NAM(R1),R0	; R0 --> File Name in File Header

10$:	MOVB	(R0)+,(R2)+	; Move File Name Byte by Byte
	BNEQ	10$
	TSTB	-(R2)		; Backspace over Null
	MOVL	#^A%   (%,(R2)+	;    (
	MOVZWL	F.NUM(R1),R0	; File
	JSB	MAP		; Number
	MOVB	#^A%,%,(R2)+	;    ,
	MOVZWL	F.SEQ(R1),R0	; Sequence
	JSB	MAP		; Number
	MOVL	#^A%)   %,(R2)+	;   )

	MOVQ	INNAM+NAM$T_DVI,ZZNAM+NAM$T_DVI ; Install Device Identifier
	MOVQ	INNAM+NAM$T_DVI+8,ZZNAM+NAM$T_DVI+8

	MOVW	F.NUM(R1),ZZNAM+NAM$W_FID ; Install File Identifier
	MOVW	F.SEQ(R1),ZZNAM+NAM$W_FID+2
	CLRW	ZZNAM+NAM$W_FID+4

	$OPEN	FAB=ZZFAB	; Open File by File ID
	BLBC	R0,20$		;  (Couldn't)
	MOVL	ZZXAB+XAB$L_HBK,ZZALQ	; Return File Size
	TSTL	TOTBLK			; Total Blocks invalid?
	BLSS	15$
	ADDL	ZZXAB+XAB$L_HBK,TOTBLK	; No - Update Total Blocks
	INCL	TOTBLK			; Include File Header in Total
15$:	$CLOSE	FAB=ZZFAB
	BRW	30$

20$:	MOVL	#-1,ZZALQ		; Invalidate File Size
	MOVL	#-1,TOTBLK		; Invalidate Total Blocks

30$:	MOVL	ZZALQ,R0
	JSB	MAPD		; Print File Allocation
	MOVB	#^O15,(R2)+
	MOVB	#^O12,(R2)+
	CLRB	(R2)+		; End of Record
	STORE	#LINBUF		; Pack it away in Buffer
	RSB

MAP:	PUSHR	#^M<R1,R3>
	ADDL	#6,R2
	MOVL	#6,R3

10$:	MOVL	R0,R1
	BICL	#^C^O7,R1
	ADDL	#48,R1		; Convert to Octal Digit
	MOVB	R1,-(R2)	; Pack it away
	ASHL	#-3,R0,R0	; Shift in next digit
	SOBGTR	R3,10$
	ADDL	#6,R2		; Point at next free in Buffer
	POPR	#^M<R1,R3>
	RSB

MAPD:	TSTL	R0		; Invalid number?
	BLSS	35$
	PUSHR	#^M<R3,R4,R5>	; Save Registers
	CLRL	R5		; Clear Leading Zero flag
	MOVAL	LIST,R4		; R4 --> Divisor table

10$:	CLRL	R3		; R3  =  Digit

15$:	INCL	R3
	SUBL	(R4),R0		; Subtract Divisor
	BGEQ	15$
	ADDL	(R4)+,R0	; Compensate for
	DECL	R3		;  extra subtract
	BISL	R3,R5		; Update Leading Zero flag
	BNEQ	20$
	MOVB	#32,(R2)+	; Leading Zero -- suppress it
	BRW	25$
20$:	ADDB3	#48,R3,(R2)+	; Output Digit
25$:	TSTL	(R4)		; End of Divisor Table?
	BNEQ	10$
	TSTL	R5		; Was at least one digit printed?
	BNEQ	30$
	MOVB	#48,-1(R2)	; No -- force Zero output
30$:	POPR	#^M<R3,R4,R5>	; Restore Registers
	MOVB	#^A%.%,(R2)+	; Indicate decimal
	RSB

35$:	MOVQ	#^A%    ****%,(R2)+	; Invalid Number
	RSB

.ENTRY	STORE,^M<R2,R3,R4>
	MOVL	ROOT,R2		; R2 --> Node
	BNEQ	10$
	JSB	GETNOD		; No such node - handle Root as special case
	MOVL	R0,R2
	BRW	30$		; Initialize the new Node

10$:	MOVL	4(AP),R3	; Compare (AP) with (R2)
	MOVAL	L.DATA(R2),R4
12$:	CMPB	(R3)+,(R4)+	; Match?
	BEQL	12$		;  ...if so, try again
	BLSS	20$

	TSTL	L.NEXT(R2)	; (AP) > (R2)
	BLEQ	15$
	MOVL	L.NEXT(R2),R2	; Update R2
	BRW	10$

15$:	JSB	GETNOD		; Get new Node
	MOVL	R0,L.NEXT(R2)	; Insert new Node
	MOVL	L.NEXT(R2),R2	; R2 --> New Node
	BRW	30$		; Initialize the new Node

20$:	TSTL	L.LAST(R2)	; (AP) < (R2)
	BLEQ	25$
	MOVL	L.LAST(R2),R2	; Update R2
	BRW	10$

25$:	JSB	GETNOD		; Get new Node
	MOVL	R0,L.LAST(R2)	; Insert New Node
	MOVL	L.LAST(R2),R2	; R2 --> New Node
	BRW	30$

30$:	CLRL	L.LAST(R2)	; New Node, no L.LAST field
	CLRL	L.NEXT(R2)	;  ... or      L.NEXT field
	MOVL	4(AP),R0
	MOVAL	L.DATA(R2),R2
35$:	MOVB	(R0)+,(R2)+	; Copy Record into new Node
	BNEQ	35$
	RET

GETNOD:	MOVL	CURADR,R0	; R0 --> New Node address
	ADDL	#LINLEN,CURADR	; Update Current Address
	CMPL	CURADR,TOPADR	; Extend Task?
	BLSS	10$
	MOVL	R0,-(SP)	; Save R0
	$EXPREG_S	PAGCNT=#1,RETADR=RETADR
	BLBC	R0,99$
	MOVL	(SP)+,R0	; Restore R0
	TSTL	ROOT		; First call?
	BNEQ	10$
	MOVL	RETADR,ROOT	; Yes -- Initialize ROOT
	MOVL	RETADR,R0	;  ...and fix up R0
	ADDL	RETADR,CURADR	;  ...and CURADR
10$:	MOVL	RETADR+4,TOPADR	; Update TOPADR
	RSB

99$:	JMP	BOMB		; Error Extending Task

OTOPEN:	$CREATE		FAB=OTFAB ; Create Listing File
	BLBS	R0,10$
99$:	JMP	BOMB		; Can't create file
10$:	$CONNECT	RAB=OTRAB
	BLBC	R0,99$
	PRINT	#HEADR		; Print Header for List
	MOVAL	INNAME,R0	; R0 --> Input Filename
	MOVAL	H0,R2		; R2 --> Device Specifier
15$:	MOVB	(R0)+,(R2)+	; Copy Device Name
	CMPB	#^A%:%,-1(R2)	; Colon terminates
	BNEQ	15$
	CLRB	(R2)+		; Indicate End of Buffer
	PRINT	#H0		; Print Disk
	PRINT	#H1		;    [
	MOVL	PROJ,R0		; Install Project Number
	MOVAL	H2,R2
	JSB	MAP
	PRINT	#H2+3		; Skip 3 Leading Zeroes
	MOVL	PROG,R0		;  ...then Prog. Number
	MOVAL	H3,R2
	JSB	MAP
	PRINT	#H3+3		; Skip 3 Leading Zeroes
	$ASCTIM_S	TIMBUF=H4A
	PRINT	#H4		; Print Remainder of String
	RSB

.ENTRY	PRINT,^M<>
	TSTL	@4(AP)		; Test Argument
	BEQL	10$		;   (Null Tree)

	ADDL3	@4(AP),#L.LAST,-(SP)
	CALLS	#1,PRINT	; Call Print(L.LAST)

	ADDL3	@4(AP),#L.DATA,R1
	PRINT	R1		;   *** PRINT ***

	ADDL3	@4(AP),#L.NEXT,-(SP)
	CALLS	#1,PRINT	; Call Print(L.NEXT)

10$:	RET

CLOSE:	MOVL	TOTBLK,R0	; Summarize...
	MOVAL	SBLK,R2
	JSB	MAPD		; Total of XXXXXXX. Blocks in
	MOVL	TOTFIL,R0
	MOVAL	SFIL,R2
	JSB	MAPD		;  XXXXXXX. Files
	PRINT	#SUMARY
	$CLOSE	FAB=OTFAB	; Close Output File
	$CLOSE	FAB=INFAB	; Close Input File
	RSB

BOMB:	MOVL	R0,ERRTYP
	$PUTMSG_S	MSGVEC=ERRVEC,FACNAM=SCNAME
	$EXIT_S

.PSECT	DATA,LONG

INFAB:	$FAB	FNA=INNAME,FOP=NAM,RFM=FIX,MRS=BUFLEN,NAM=INNAM
INNAM:	$NAM
INRAB:	$RAB	FAB=INFAB,MBC=16,UBF=BUFFER,USZ=BUFLEN

OTFAB:	$FAB	FNM=<SYS$OUTPUT>
OTRAB:	$RAB	FAB=OTFAB

ZZFAB:	$FAB	FOP=NAM,NAM=ZZNAM,XAB=ZZXAB
ZZNAM:	$NAM
ZZXAB:	$XABFHC

ERRVEC:	.LONG	2		; Two Arguments
ERRTYP:	.LONG	0		; Error goes here
	.LONG	0		; Room for STV

PROJ:	.LONG	0		; Project Number
PROG:	.LONG	0		; Programmer Number

RETADR:	.BLKL	2		; Returned Addresses for Extend Task
ROOT:	.LONG	0		; Bottom of Record Buffer
CURADR:	.LONG	0		; --> Current Record
TOPADR:	.LONG	0		; Top of Record Buffer

TOTBLK:	.LONG	0		; Block Total for [P,PN]
TOTFIL:	.LONG	0		; File  Total for [P,PN]

ZZALQ:	.LONG	0		; Allocated Size of File

BUFFER:	.BLKB	BUFLEN		; Buffer for File Header
DNS0:	.ASCII	/DSK1:/
DNS1:	.ASCIZ	/[0,0]INDEXF.SYS/
HEADR:	.ASCII	<^O15><^O12><^O15><^O12>
	.ASCIZ	/   Scan of /
H0:	.BLKB	20		; Room for Device Specifier
H1:	.ASCIZ	/[/
H2:	.ASCIZ	/xxxxxx,/
H3:	.ASCIZ	/xxxxxx] on /
H4A:	.LONG	20		; String Descriptor for ASCTIM
	.LONG	H4
H4:	.BLKB	20		; Space for Date and Time
	.ASCII	<^O15><^O12><^O15><^O12>
	.ASCII	/    NAME                    FILE ID          SIZE/
	.ASCIZ	<^O15><^O12><^O15><^O12>
INNAME:	.BLKB	LINLEN		; File Name goes here...
INLEN:	.LONG	0		; Line Length
ITMLST:	.WORD	4		; Return Quadword
	.WORD	JPI$_GRP	; Project Number
	.LONG	PROJ
	.LONG	0
	.WORD	4		; Return Quadword
	.WORD	JPI$_MEM	; Programmer Number
	.LONG	PROG
	.LONG	0
	.LONG	0
LINDES:	.LONG	LINLEN		; Length of Line
	.LONG	LINBUF		; Address of Line
LINBUF:	.BLKB	LINLEN		; Line Buffer
LIST:	.LONG	1000000		; Table of Divisors for MAPD
	.LONG	0100000
	.LONG	0010000
	.LONG	0001000
	.LONG	0000100
	.LONG	0000010
	.LONG	0000001
	.LONG	0000000		; End of Table
OPTL:	.ASCII	%/OUTPUT%	; Option Designator String
OTNAME:	.BLKB	LINLEN		; Listing Filename goes here
PROMPT:	.ASCID	/FINDUIC>/
SCNAME:	.ASCID	/SCAN/
SUMARY:	.ASCII	<^O15><^O12>/     Total of/
SBLK:	.ASCII	/XXXXXXX. Blocks in/
SFIL:	.ASCIZ	/XXXXXXX. File(s)/<^O15><^O12>

.END	BEGIN