.TITLE	SRDLST-LIST THE DIRECTORY
	.IDENT	/V2.5/		;05 12-NOV-76
;+
;
;**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
	BIT	#FUSW,SWMSK$	;FULL LISTING?
	BEQ	UNPACK		;IF EQ NO
	CALL	PRTHDG		;PRINT DIRECTORY HEADING
	BIS	#HDSW,SWMSK$	;SHOW THAT IT HAS BEEN PRINTED
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	#LINBUF,R0	;POINT TO START OF BUFFER
	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	#LINBUF,R1	;POINT TO NAME
	CALL	MATCH		;MATCH ANYONE?
	BCC	FOUND		; IF CC SUCCESSFUL MATCH

FAILED:	BIT	#NESW,SWMSK$	;NEGATED TESTS?
	BNE	CKDATE		;IF NE YES
	BR	UNPACK		;GET NEXT
FOUND:	BIT	#NESW,SWMSK$	;NEGATED TESTS?
	BEQ	CKDATE		; IF EQ NO
	BR	UNPACK		;GET NEXT
CKDATE:
	BIT	#<FUSW!DASW>,SWMSK$	;FULL LISTING, OR DATE SELECT?
	BEQ	CKD1		;BR IF NO
10$:	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
	CALL	PUTLST		;OUTPUT FILE NAME
	JMP	UNPACK		;NEXT ENTRY
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
	TST	R2		; ERROR CONVERTING DATE?
	BEQ	LSTENT		; IF EQ YES
	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
	CALL	PRTHDG		;PRINT HEADING FOR DIRECTORY
	.DSABL	LSB
LSTE1:	BIS	#<HDSW!FLSW>,SWMSK$	;FLAG AS PRINTED
	BIT	#<FUSW!BESW!AFSW>,SWMSK$ ;FULL LISTING
	BEQ	60$		;BR IF NO
	MOV	#LINBUF,R1	;START OF LINE BUFFER
	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	#LINBUF,(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
	BEQ	5$		;02 BR IF SHOULD DELETE
	CMPB	#<'Y+40>,LINBUF	;02 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) ;03 IS FIRST FREE BYTE 0
	BNE	10$		;03 IF NO-PROCEED
	DEC	R1		;03 IF YES-DONT COUNT THIS BLOCK IN SIZE
10$:	CALL	$CBDMG		;03 CHANGE SIZE TO ENGLISH
	MOV	<F.HIBK-<F.EFBK+2>>(R4),R1 ;GET HIEST ALLOCATED
	MOVB	#'.,(R0)+	;PUNCT
	MOVB	#'/,(R0)+	;INSERT A SEPARTOR
	CLR	R2		;ZERO SUPPRESS
	CALL	$CBDMG		;COVERT AND RETURN
	MOVB	#'.,(R0)+	;PUNCT
	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		;04 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	#LINBUF,R0 ;FIND LENGTH OF LINE
	MOV	R0,R1		;COPY LENGTH
	PUT$S	#LSTFDB,#LINBUF,R1	;WRITE THE LINE
	BCC	10$
	FERR	PUTE		;???CAN'T DO PUT???
10$:	MOV	#LINBUF,R0	;RESET BUFFER ADDRESS
	RETURN
PRTHDG:	CALL	$SAVAL		;SAVE ALL REGISTERS FOR THIS HACK
	MOV	#HEADBF,R0	;GET HEADING BUFFER
	BIT	#SPSW,SWMSK$	;05 THIS LISTING GETTING SPOOLED?
	BEQ	4$		;05 BR IF NO
	MOV	(PC)+,(R0)+	;05 INSERT A FORM FEED
	.BYTE	15,14		;05 CR/FF
4$:				;05 REFERENCE TAG
	MOV	#" *,(R0)+	;FLAG NEW ENTRY
	MOV	#"* ,(R0)+	;THAT MAKES LISTING EASIER TO READ
	MOV	<UFDFDB+F.FNB+N.DVNM>,(R0)+ ;01 COPY DEVICE NAME INTO LISTING
	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;01 GET UNIT NUMBER
	ASR	R1
	ASR	R1
	ASR	R1		;01 DIVIDE BY 10(OCTAL)
	BEQ	6$		;01 BR IF UNIT LESS THAN 10(OCTAL)
	ADD	#'0,R1		;01 MAKE PRINTABLE
	MOVB	R1,(R0)+	;01 INSERT INTO LISTING
6$:	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;01 GET UNIT BACK
	BIC	#177770,R1	;01 REDUCE TO <0-7>
	ADD	#'0,R1		;01 ADD IN ASCII BIAS
	MOVB	R1,(R0)+	;01 INSERT IN LISTING
	MOVB	#':,(R0)+	;01 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$+15.> ;FINISH DATE?
	BLO	10$		;BR IF NO
	SUB	#HEADBF,R0	;COMPUTE LINE LENGTH
	MOV	R0,R1		;COPY IT TO R1
	PUT$S	#LSTFDB,#HEADBF,R1 ;WRITE LINE
	BCC	15$		; IF CC NO ERROR
	FERR	PUTE
15$:	RETURN

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
	.END