.TITLE	SRDLST-LIST THE DIRECTORY
	.IDENT	/4.0/		; 1-SEP-1977
;+
; 
; **SRD--SORT DIRECTORY
; 
; THIS MODULE CREATS A SELECTIVE LISTING OF THE FILE
; 
; 
; THIS TASK WILL SORT A RSX11M DIRECTORY
; THEN CREATE A LISTING WITH MANY SELECTION OPTIONS
; 
; THIS IS THE MAIN ROUTINE, AND IS PURE.
; 
; 
;-
; 
; SYSTEM MACRO CALLS
; 
	.MCALL	FHDOF$,CALLR,DIR$,QIOW$S,WTSE$S,PUT$S
	FHDOF$	DEF$L
DTSTR:	.BYTE	40,2,'-,3,'-,2,' ,2,':,2,' ,0
	.EVEN
FUTABL:
	.BYTE	H.UFAT+F.EFBK+2	; FCS'S END OF FILE
	.BYTE	12.,40,40	; SIZE,LEADING CHAR,TRAILING CHAR
	.WORD	SIZECV		; CONVERTION ROUTINE
	.BYTE	H.PROG,10.,'[,']
	.WORD	UICCV	; OWNER UIC CONVERSTION
	.BYTE	H.FNUM,16.,'(,')	; FILE NUMBER
	.WORD	FIDCV
	.BYTE	H.FPRO,22.,'[,']
	.WORD	FPROCV
	.WORD	0		; END OF TABLE
; 
FPSTR:	.ASCIZ	/RWED/
TERMRS:	.ASCII	\.;\		; FILE-NAME FIELD TERMINATORS
	.EVEN
; 
SRDLST::
; DIRECTORY IS SORTED,NOW GENERATE LISTING
; 
LSTDIR:
	BIC	#HDFL,FLAGS$	; FLAG HEADER NOT PRINTED
	MOV	DIRBF$,R5	; SET START OF DIRECTORY BUFFER
UNPACK:	CMP	R5,F.BKDS+2+UFDFDB ; PAST END OF BUFFER?
	BHIS	10$		; BR IF YES
	TST	(R5)		; ANY THING REMAINING TO UN-PACK?
	BNE	UNP1		; CONTINUE
10$:	RETURN
 
UNP1:	MOV	R5,READHD+Q.IOPL ; SET FILE ID POINTER INCASE HEADER IS NEEDED
	MOV	LSTFDB+F.NRBD+2,R0 ; SET TO POINT AT START OF REC
	ADD	#D.FNAM,R5	; POINT AT FILE-NAME PORTION
10$:	BIT	#HVSW,SWMSK$	; SELECTING VERSIONS HIGHER THAN?
	BEQ	CVAS		; BR IF NO
	MOV	LVNUM$,R1	; GET LOWEST VERSION TO SELECT
	BNE	20$		; BR IF USER GAVE VALUE
	MOV	#2,R1		; ELSE USE 2 AS LOW LIMIT
20$:	CMP	<D.VER-D.FNAM>(R5),R1 ; VERSION HIGH ENOUGH?
	BHIS	CVAS		; BR IF SELECTING THIS VERSION
	ADD	#<D.SIZ-D.FNAM>,R5 ; ADVACE POINTER TO NEXT ENTRY
	BR	UNPACK		; AND LOOK AT NEXT
; 
; CONVERT DIRECTORY ENTRY TO ASCII
; 
CVAS:	MOV	#3,R3		; NUMBER OF WORDS IN NAME
20$:	MOV	(R5)+,R1	; GET A RADIX-50 WORD
	CALL	$C5TA		; CONVERT TO ASCII
	DEC	R3		; COUNT NUMBER OF ENTRIES DONE
	BGT	20$		; BR IF STILL DOING NAME
	BMI	30$		; BR IF JUST DID TYPE
	MOVB	#'.,(R0)+	; SEPARATE NAME AND TYPE
	BR	20$		; ---AND DO TYPE
30$:
	MOVB	#';,(R0)+	; SEPARATE TYPE AND VERSION
	MOV	(R5)+,R1	; NOW GET VERSION
	CLR	R2		; SET ZERO SUPPRESS FLAG
	CALL	$CBOMG		; CONVERT TO ASCII
	BIT	#SESW,SWMSK$	; IS THIS A SELECTIVE LIST?
	BEQ	CKVRSN		; BR IF NO-CK FOR VERSION SELECTION
	MOV	#SEBUF$,R2	; SET SELECTION STRING ADDRESS
	MOV	#TERMRS,R3	; SET FIELD TERMINTORS
	MOV	LSTFDB+F.NRBD+2,R1 ; SET START OF NAME
MATCH:
	TSTB	(R2)		; END OF MATCH STRING?
	BNE	5$		; BR IF NOT END
	BIT	#NESW,SWMSK$	; END-SELECT OR SELECT NOT?
	BNE	UNPACK		; BR HERE IF SELECT NOT
	BR	CKVRSN		; CK VERSION IF SELECT
5$:	CMPB	(R2),(R3)	; IS THIS FIELD TERMINATOR?
	BNE	20$		; BR IF NO
10$:	CMPB	(R1)+,(R3)	; ADVANCE OVER ANY REMAINING FIELD
	BNE	10$
	INC	R3		; SET TO NEXT TERMINATOR
	BR	40$		; GO RESUME SCAN
20$:	CMPB	#'?,(R2)	; IS THIS WILD CARD CHARACTER
	BEQ	30$		; YES-THAT ALWAYS MATCHES
	CMPB	#'*,(R2)	; CHECK OTHER WILD CHARACTER
	BEQ	30$		; THAT MATCHES ALSO
	CMPB	(R2),(R1)	; IS THIS A SELECTED ITEM
	BNE	50$		; BR ON MATCH FAIL
30$:	INC	R1		; STEP TO NEXT CHAR
40$:	INC	R2		; STEP TO NEXT TARGET
	BR	MATCH		; CONTIUE MATCHING
50$:
	BIT	#NESW,SWMSK$	; TRUE OR NEGATE SELECT
	BEQ	UNPACK		; BR IF TRUE SELECT
;
; SEE IF VERSION SELECTION IS REQUIRED
;
CKVRSN:	BIT	#SVSW,SWMSK$	; VERSION SELECTION NEEDED?
	BEQ	CKDATE		; BR IF NO-PROCEED WITH DATE
	MOV	R5,R3		; COPY PLACE IN DIRECTORY
	SUB	#<5*2>,R3	; BACK UP OVER THE NAME FIELD
	MOV	R3,R2		; MAKE A COPY OF THAT
	SUB	#D.SIZ,R2	; AND BACK THAT UP TO PRVIOUS ENTRY
	MOV	#4,R1		; LENGTH OF NAME AND TYPE
10$:	CMP	(R2)+,(R3)+	; NAMES MATCH?
	BNE	20$		; BR IF NO MATCH
	SOB	R1,10$		; LOOP?
	INC	VRSNS$		; COUNT UP THE NUMBER OF EXTRA VERSIONS OF FILE
	MOV	VRSCT$,R1	; GET PURG THRESHOLD
	BNE	12$		; BR IF A VALUE IS PRESENT
	INC	R1		; ELSE MAKE IT ONE
12$:	BIT	#PUSW,SWMSK$	; SELECTING VERSIONS FOR PURGE?
	BNE	14$		; BR IF PURGING
	CMP	VRSNS$,R1	; PRINTED ENOUGH OF THIS FILE NAME?
	BLO	CKDATE		; BR IF SELECT THIS VERSION
	BR	UNPACK		; ELSE FORGET THIS FILE
14$:	CMP	VRSNS$,R1	; ENOUGH VERSIONS TO REQUIRE A DELETE?
	BHIS	CKDATE		; BR IF YES- CHECK FOR DATE MATCH
	BR	UNPACK		; ELSE UNPACK THE NEXT
20$:	CLR	VRSNS$		; ZERO NUMBER OF VERSIONS OF FILE SEEN
	BIT	#PUSW,SWMSK$	; FILES NOT SAME NAME - CHECK FOR PURGE
	BEQ	CKDATE		; IF NOT PURGING-CONTINUE SELECTING THIS FILE
UNPK0:	BR	UNPACK		; UN PACK THE NEXT
 
CKDATE:	BIT	#<FUSW!DASW>,SWMSK$ ; FULL LISTING, OR DATE SELECT?
	BEQ	CKD1		; BR IF NO
10$:	CLR	HDBUF$		; ZERO THIS WORD FOR FCP
	DIR$	#READHD		; READ THE FILE HEADER
	BCC	20$
	CALL	$ALERR
	BR	10$
20$:	TSTB	IOSB$		; DID READ WORK?
	BGT	CKD1		; BR IF YES
	DIAG	HDRE		; HEADER READ ERR
	BR	PTNAM		; PRINT NAME OF FILE
CKD1:
	MOVB	HDBUF$,R1	; GET OFFSET TO IDENT AREA IN HEADER
	ASL	R1		; MAKE AWORD OFFSET
	ADD	#HDBUF$+I.CRDT,R1  ; POINT AT CREATION DATE
	MOV	R1,R3		; SAVE THIS ADDRESS
	BIT	#DASW,SWMSK$	; DOING DATESELCTION?
	BEQ	LSTENT		; NO-LIST IT
	CALL	CNVDAT		; CONVERT DATE TO INTEGER
	MOV	DABUF$,R1	; GET TARGET
	BIT	#AFSW,SWMSK$	; AFTER DATE SELECTION
	BNE	10$		; BR IF YES
	BIT	#BESW,SWMSK$	; BEFORE DATE?
	BEQ	20$		; BR IF NO
	MOV	R2,-(SP)	; EXCHANGE
	MOV	R1,R2		; 
	MOV	(SP)+,R1	; R1 AND R2
10$:	CMP	R2,R1		; 
	BHI	LSTENT		; BR IF NOT
20$:	CMP	R1,R2		; DATES THE SAME
	BNE	UNPK0		; NO!-FORGET THIS ONE!
 
	.ENABLE	LSB
 
LSTENT:	BIT	#HDFL,FLAGS$	; HAS HEADER BEEN LISTED?
	BNE	LSTE1		; BR IF YES
	BIS	#<HDFL!FLFL>,FLAGS$  ; FLAG AS PRINTED
	SUB	#D.SIZ,R5	; BACK UP TO DO THIS 1 AGAIN
	MOV	LSTFDB+F.NRBD+2,R0 ; RESET POINTER TO TOP OF BUFFER
	BIT	#SPSW,SWMSK$	; THIS LISTING GETTING SPOOLED?
	BEQ	4$		; BR IF NO
	MOV	(PC)+,(R0)+	; INSERT A FORM FEED
	.BYTE	15,14		; CR/FF
4$:	MOV	#" *,(R0)+	; FLAG NEW ENTRY
	MOV	#"* ,(R0)+	; THAT MAKES LISTING EASIER TO READ
	MOV	<UFDFDB+F.FNB+N.DVNM>,(R0)+ ; COPY DEVICE NAME INTO LISTING
	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ; GET UNIT NUMBER
	ASR	R1
	ASR	R1
	ASR	R1		; DIVIDE BY 10(OCTAL)
	BEQ	6$		; BR IF UNIT LESS THAN 10(OCTAL)
	ADD	#'0,R1		; MAKE PRINTABLE
	MOVB	R1,(R0)+	; INSERT INTO LISTING
6$:	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ; GET UNIT BACK
	BIC	#177770,R1	; REDUCE TO <0-7>
	ADD	#'0,R1		; ADD IN ASCII BIAS
	MOVB	R1,(R0)+	; INSERT IN LISTING
	MOVB	#':,(R0)+	; NOW DELINIT DEVICE NAME
	MOVB	#'[,(R0)+	; SET UIC DELIMITER
	MOV	UFDFDB+F.FNAM,R1 ; GET DIRECTORY NAME
	CALL	20$		; CONVERT GROUP NAME TO ENGLISH
	MOVB	#',,(R0)+	; SEPARATE GROUP & USER
	MOV	UFDFDB+F.FNAM+2,R1 ; GET OTHER HALF OF NAME
	CALL	20$		; CONVERT PROGRAMMER NUMBER
	MOVB	#'],(R0)+	; TERMINATE UIC
	MOVB	#' ,(R0)+	; SEPARATE
	MOV	#DATIM$,R1	; POINT AT DATE & TIME
10$:	MOVB	(R1)+,(R0)+	; FILL IN DATE
	CMP	R1,#<DATIM$+16.> ; FINISH DATE?
	BLO	10$		; BR IF NO
PTNAM:	CALL	PUTLST		; PRINT THAT
	CALLR	UNPACK		; DO FILE LISTING AGAIN
20$:	MOV	R0,-(SP)	; SAVE START POINT
	CALL	$C5TA		; CHANGE TO ENGLISH
	MOV	(SP)+,R2	; GET TOP OF LIST
	DEC	R0		; BACK UP TO LAST CHAR IN STRING
30$:	CMPB	R2,R0		; ALL DONE?
	BHIS	50$		; BR IF DONE
	CMPB	#'0,(R2)	; LEADING ZERO?
	BNE	50$		; BR IF NO
	MOVB	1(R2),(R2)	; MOVE UP STRING
	MOVB	2(R2),1(R2)	; ...
	DEC	R0		; SHORTEN STRING
	BR	30$		; TRY FOR MORE
50$:	INC	R0		; RESET POINTER PAST STRING
	RETURN
	.DSABL	LSB
LSTE1:	BIT	#<FUSW!BESW!AFSW>,SWMSK$ ; FULL LISTING
	BEQ	60$		; BR IF NO
	MOV	LSTFDB+F.NRBD+2,R1; START OF LINE BUF
	ADD	#20.,R1		; POINT AT END OF NAME FIELD
	MOV	#DTSTR,R2	; DATE-TIME FORMAT STRING
2$:	MOVB	(R2),(R0)+	; SPACE FILL
	CMP	R0,R1		; FULL?
	BLO	2$		; BR WHEN FIELD NOT FULL
	MOVB	(R2)+,(R0)+	; ONE MORE
4$:	MOVB	(R2)+,R1	; GET NEXT SIZE
	BEQ	8$
6$:	MOVB	(R3)+,(R0)+	; COPY DATE
	SOB	R1,6$		; COUNT FIELD
	MOVB	(R2)+,(R0)+	; TERMINATOR
	BR	4$
8$:
	BIT	#FUSW,SWMSK$	; REALLY BIG LISTING
	BEQ	PUT1		; LIST THAT MUCH
	MOV	#FUTABL,R3	; FORMAT TABLE ADDRESS
10$:	MOVB	(R3)+,R4	; PICK UP NEXT OFFSET
	BEQ	60$		; BR WHEN END
	ADD	#HDBUF$,R4	; ADJ FOR ADDRESS OF BUFFER
	MOVB	(R3)+,R1	; PICK UP SIZE OF FIELD
20$:	MOV	R1,R2		; COPY THAT
	ADD	R0,R2		; FIND HOW BIG THE LINE WILL BE
	MOV	LINSZ$,-(SP)	; PUSH MAX SIZE OF RECORD
	ADD	LSTFDB+F.NRBD+2,(SP) ; ADD IN START OF RECORD
	CMP	R2,(SP)+	; WILL IT GET TOO BIG?
	BLOS	30$		; BR IF NO
	CALL	PUTLST		; WRITE IT OUT
	MOV	(PC)+,(R0)+	; INSERT SOME SPACE
	.BYTE	40,40		; 2 SPACES
	BR	20$		; TRY AGAIN
30$:	MOV	R2,-(SP)	; PUSH END OF BUFFER
	MOVB	(R3)+,(R0)+	; INSERT LEADING CHAR
	BNE	40$		; BR IF NOT A NULL
	DEC	R0		; BACK UP OVER NULL
40$:	MOVB	(R3)+,-(SP)	; SAVE TRAILING CHAR FOR LATER
	MOV	(R4)+,R1	; PICK UP 16 BIT ARG
	CALL	@(R3)+		; DISPATCH TO ROUTINE
	MOVB	(SP)+,(R0)+	; COPY TRAILING CHAR
	MOV	(SP)+,R1	; GET END OF FIELD ADDRESS
50$:	CMP	R0,R1		; IS RECORD UP TO END OF FIELD
	BHIS	10$		; BR WHEN FIELD IS FULL
	MOVB	#40,(R0)+	; SPACE FILL
	BR	50$		; TRY AGAIN
60$:
PUT1:
	CALL	PUTLST		; OUTPUT THE LINE
	BIT	#SDSW,SWMSK$	; DOING SELECTIVE DELETE?
	BEQ	UNPK1		; BR IF NO
	BIT	#DESW,SWMSK$	; ALWAYS DELETE
	BNE	5$		; YES-DON'T BOTHER TO ASK
	CLRB	LINBUF		; ERASE ANY PREVIOUS YES'S
	QIOW$S	#IO.RVB,.MOLUN,#EFN1,,#IOSB$,,<#LINBUF,#4>
	TSTB	IOSB$		; ANY ERR-MUST BE EOF
	BGT	3$		; BR IF NO ERR
	RETURN			; *** EXIT THIS RUN ###
3$:	CMPB	#'Y,LINBUF	; ANSWER YES
	BEQ	5$		; BR IF SHOULD DELETE
	CMPB	#<'Y+40>,LINBUF	; LOWER CASE Y?
	BNE	UNPK1
5$:	MOV	R5,R0		; COPY PLCE IN DIRECTORY BUFFER
	MOV	#UFDFDB+F.FNB+N.FVER+2,R1 ; POINT AT FILE NAME BLOCK END
	MOV	#8.,R2		; SET NUMBER OF WORDS IN DIRECTORY ENTRY
10$:	MOV	-(R0),-(R1)	; COPY THE DATA
	SOB	R2,10$		; DO ALL
	MOV	#UFDFDB,R0	; POINT AT FDB PROPER
	MOV	SAVDID,F.FNB+N.DID(R0) ; RESTORE
	MOV	SAVDID+2,F.FNB+N.DID+2(R0) ; DIRECTORY ID
	MOV	SAVUNM,F.FNB+N.UNIT(R0) ; DEVICE UNIT NUMBER
	MOV	SAVDVN,F.FNB+N.DVNM(R0) ; ---AND FINALLY NAME
	CALL	.DLFNB
	BCC	UNPK1		; BR IF DELETE WORKED
	DIAG	FDEL		; ISSUE DIAGNOSTIC MESSAGE
UNPK1:
	CALLR	UNPACK		; DO THE NEXT
; 
SIZECV:
	CLR	R2		; SET ZERO SUPPRESS FLAG
	TST	<F.FFBY-<F.EFBK+2>-2>(R4) ; IS FIRST FREE BYTE 0
	BNE	10$		; IF NO-PROCEED
	DEC	R1		; IF YES-DONT COUNT THIS BLOCK IN SIZE
10$:	CALL	$CBDMG		; CHANGE SIZE TO ENGLISH
	MOV	<F.HIBK-<F.EFBK+2>>(R4),R1 ; GET HIEST ALLOCATED
	MOVB	#'/,(R0)+	; INSERT A SEPARTOR
	CLR	R2		; ZERO SUPPRESS
	CALLR	$CBDMG		; COVERT AND RETURN
; 
UICCV:	MOV	R1,-(SP)	; SAVE UIC
	CLRB	R1		; REMOVE PROGRAMMER NUMBER
	SWAB	R1		; GET PROGECT INTO LO BYTE
	CLR	R2		; SUPPRESS ZERO'S
	CALL	$CBOMG		; CONVERT THAT MUCH
	CLR	R1		; GET READY FOR UNSIGNED---
	BISB	(SP)+,R1	; MOVE BYTE OF PROGRAMMER NUMBER
	CLR	R2		; ZERO SUPPRESS
	MOVB	#',,(R0)+	; SEPARATE WITH COMMA
	CALLR	$CBOMG		; COVERT FOR OUTPUT
; 
FIDCV:
	CLR	R2		; SUPPRESS ZEROS
	CALL	$CBOMG		; CONVERT TO OCTAL
	MOVB	#',,(R0)+	; SEPARATE
	MOV	(R4),R1	; GET SEQ NUMBER
	CLR	R2		; SET ZERO SUPPRESS AGAIN!
	CALLR	$CBOMG		; CONVERT THAT
; 
FPROCV:
	MOV	#4,R2		; NUMBER OF FILELDS TO CONVERT
10$:	MOV	#FPSTR,R3	; FORMAT STRING
20$:	ASR	R1		; MOVE 1 BIT INTO C
	BCS	30$		; BR IF NOT ACTIVE
	MOVB	(R3),(R0)+	; INSERT A DESRIPTOR CHAR
30$:	INC	R3		; ADJ FORMAT STRING
	TSTB	(R3)		; END OF LIST
	BNE	20$		; BR IF NO
	MOVB	#',,(R0)+	; INSERT A SEPARATOR
	SOB	R2,10$		; LOOP?
	DEC	R0		; NO-BACK UP OVER LAST COMMA
	RETURN
; 
; PUTLST---PUT A RECORD INTO LISTING FILE
; 
PUTLST:
	SUB	LSTFDB+F.NRBD+2,R0 ; FIND LENGTH OF LINE
	MOV	R0,LSTFDB+F.NRBD ; SET LENGTH INTO FDB
	PUT$S	#LSTFDB		; WRITE THE LINE
	BCC	10$
	FERR	PUTE		; ???CAN'T DO PUT???
10$:	MOV	F.NRBD+2(R0),R0 ; GET RECORD BUFFER
	RETURN
	.END