.TITLE	SRDLST-LIST THE DIRECTORY
	.IDENT	/V2.1/		;15-JUN-76                                      ;**NEW**
;+                                                                              ;**-1
;
;**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$,QIO$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	#HDSW,SWMSK$	;FLAG HEADER NOT PRINTED
	MOV	DIRBF$,R5	;SET START OF DIRECTORY BUFFER
UNPACK:	TST	(R5)		;ANY THING REMAINING TO UN-PACK?
	BNE	UNP1		;CONTINUE
	RETURN
	.ENABL	LSB
UNP1:
	MOV	R5,READHD+Q.IOPL ;SET FILE ID POINTER INCASE HEADER IS NEEDE
	MOV	LSTFDB+F.NRBD+2,R0 ;SET TO POINT AT START OF REC
	ADD	#D.FNAM,R5	;POINT AT FILE-NAME PORTION
	BIT	#SVSW,SWMSK$	;ONLY 1 VERSION WANTED?
	BEQ	10$		;BR IF NO
	MOV	R5,R3		;COPY CURRENT NAME
	SUB	#D.SIZ,R3	;BACK UP 1 ENTRY
	MOV	R5,R1		;GET CURRENT AGAIN
	MOV	#4,R2		;SIZE OF NAME
5$:	CMP	(R3)+,(R1)+	;NAMES THE SAME?
	BNE	10$		;BR IF NO-LIST IT
	SOB	R2,5$		;DO ALL 4
7$:	ADD	#<D.SIZ-D.FNAM>,R5  ;SAME NAME-FORGET IT!
UNPK0:	BR	UNPACK		;TRY NEXT
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?
	BLO	7$		;BR IF NO-TRY NEXT
;
	.DSABL	LSB
;
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	CKDATE		;BR IF NO-CK FOR DATE 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	CKDATE		;CK DATE 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
CKDATE:
	BIT	#<FUSW!DASW>,SWMSK$	;FULL LISTING, OR DATE SELECT?
	BEQ	CKD1		;BR IF NO
10$:				;REFERENCE LABEL
;
;		SEE NOTE IN SRDINI IN "SRTDIR"
;	CLR	HDBUF$		;ZERO THIS WORD FOR FCP	I;+++001
	DIR$	#READHD		;READ THE FILE HEADER
	BCC	20$
	CALL	$ALERR
	BR	10$
20$:	WTSE$S	#EFN1
	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	#HDSW,SWMSK$	;HAS HEADER BEEN LISTED?
	BNE	LSTE1		;BR IF YES
	BIS	#<HDSW!FLSW>,SWMSK$	;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
	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      ;**NEW**
	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;GET UNIT NUMBER                       ;**NEW**
	ASR	R1                                                              ;**NEW**
	ASR	R1                                                              ;**NEW**
	ASR	R1			;DIVIDE BY 10(OCTAL)                    ;**NEW**
	BEQ	1$		;BR IF UNIT LESS THAN 10(OCTAL)                 ;**NEW**
	ADD	#'0,R1		;MAKE PRINTABLE                                 ;**NEW**
	MOVB	R1,(R0)+	;INSERT INTO LISTING                            ;**NEW**
1$:	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;GET UNIT BACK                         ;**NEW**
	BIC	#177770,R1	;REDUCE TO <0-7>                                ;**NEW**
	ADD	#'0,R1		;ADD IN ASCII BIAS                              ;**NEW**
	MOVB	R1,(R0)+	;INSERT IN LISTING                              ;**NEW**
	MOVB	#':,(R0)+	;NOW DELINIT DEVICE NAME                        ;**NEW**
	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
	QIO$S	#IO.RVB,MOLUN,#17.,,#IOSB$,,<#LINBUF,#4>
	WTSE$S	#17.
	TSTB	IOSB$		;ANY ERR-MUST BE EOF
	BGT	3$		;BR IF NO ERR
	RETURN			;*** EXIT THIS RUN ###
3$:	CMPB	#'Y,LINBUF	;ANSWER YES
	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
	CALL	$CBDMG		;CONVERT TO ASCII
	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
	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