.TITLE	SRDLST-LIST THE DIRECTORY
	.IDENT	/V2.1/		;27-FEB-77
;+
;
;**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.
;	++001 EDIT TO LIST HEADER OF EMPTY DIRECTORYS
;
;-
;
;SYSTEM MACRO CALLS
;
	.MCALL	FHDOF$,CALLR,DIR$,QIO$S,WTSE$S,PUT$S
	FHDOF$	DEF$L
LST::
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/
	.EVEN
 
;
SRDLST::
;DIRECTORY IS SORTED,NOW GENERATE LISTING
;
LSTDIR:
	BIC	#HDSW,SWMSK$	;FLAG HEADER NOT PRINTED
	MOV	DIRBF$,R5	;SET START OF DIRECTORY BUFFER
	BR	UNP1	;++001 GO DO HEADER THEN COME BACK AND DO FILES
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	CVAS		;BR IF NO
	TST	SVNUM$		;EXPLICIT ONE
	BNE	10$		;YES
	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	CVAS		;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$:
	MOV	SVNUM$,R1	;GET VERSION TO SELECT
	CMP	<D.VER-D.FNAM>(R5),R1 ;VERSION CORRECT ?
	BNE	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	LSTFDB+F.NRBD+2,R1 ;SET START OF NAME
	CALL	MATCH			;++002
	BCC	FOUND			;++002 SUCESS IN EVERY ( WELL NEARLY )
					;++002  ... PACKET.
 
FAILED:	BIT	#NESW,SWMSK$	;++002 NEGATED TESTS ?
	BNE	CKDATE		;++002 YES
	JMP	UNPACK		;++002 NO, GET NEXT F-S TO TRY
 
FOUND:	BIT	#NESW,SWMSK$	;++002 NEGATED TESTS ?
	BEQ	CKDATE		;++002 NO
	JMP	UNPACK		;++002 YES
 
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$:	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
	MOV	R5,-(SP)	;++001 PUSH R5
	MOV	DIRBF$,R5 	;++001 MOV BUFFER START TO R5
	TST	(R5)		;++001 BUFFER EMPTY
	BNE	1$		;++001 BUFFER NOT EMPTY BRANCH
	TST	(SP)+		;++001 POP STACK
	JMP	UNPACK		;++001 GO BACK TO BEGIN
1$:	MOV	(SP)+,R5	;++001 POP R5
	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
	BEQ	LSTENT		;++002 YES, GOODIE
	JMP	UNPK0		;++002 NO, RATS
	.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
	BIT	#SPSW,SWMSK$	;LISTING BEING SPOOLED ?
	BEQ	4$		;NO
	MOV	(PC)+,(R0)+	;YES, PLANT A ...
	.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 THE DEVICE NAME
	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;GET THE UNIT NUMBER
	ASR	R1		;DIV BY 10(8)
	ASR	R1		;...
	ASR	R1		;...
	BEQ	6$		;BR IF UNIT # < 10(8)
	ADD	#'0,R1		;TURN IT INTO ASCII
	MOVB	R1,(R0)+	;PUT IT IN O/P BUFFER
6$:	MOV	<UFDFDB+F.FNB+N.UNIT>,R1 ;GET IT AGAIN
	BIC	#^C<7>,R1	;MAKE IT 0-7
	ADD	#'0,R1		;TURN IT INTO ASCII
	MOVB	R1,(R0)+	;PUT IN O/P BUFFER
	MOVB	#':,(R0)+	;PLANT USUAL DELIMITER
	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	#<DASW!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:
	BIT	#SDSW,SWMSK$	;++003 SELECTIVE DELETE ?
	BNE	1$		;++003 YES, LIST USING READ-WITH-PROMPT
	CALL	PUTLST		;OUTPUT THE LINE
	BIT	#DESW,SWMSK$	;DELETE ?
	BNE	5$		;YES - GO DO IT
	BR	UNPK1		;++003 NO - GO GET NEXT ONE
 
1$:
	MOV	LSTFDB+F.NRBD+2,R2 ;++003 LOCATE FILE-SPEC FOR O-P
	SUB	R2,R0		;++003 CALC. LENGTH
	MOV	#PRMPT,R1	;++003 INITIALIZE PROMPT BUFFER
	MOV	(PC)+,(R1)+	;++003
	.BYTE	15,12		;++003 PROMPT ON NEW LINE
100$:	MOVB	(R2)+,(R1)+	;++003 COPY PROMPT
	SOB	R0,100$		;++003 TILL END
	MOVB	#' ,(R1)+	;++003 POP THE QUESTION
	MOVB	#'?,(R1)+	;++003
	MOVB	#' ,(R1)+	;++003
	SUB	#PRMPT,R1	;++003 CALC LENGTH
	CLRB	LINBUF		;ERASE ANY PREVIOUS YES'S
	QIO$S	#IO.RPR,#1,#17.,,#IOSB$,,<#LINBUF,#1,,#PRMPT,R1,#0>
	WTSE$S	#17.
	MOV	LSTFDB+F.NRBD+2,R0	;++003
	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$		;YES
	CMPB	#'Y!40,LINBUF	;NO, LOWER-CASE PERHAPS ?
	BNE	UNPK1
5$:	MOV	R5,R0		;COPY PLACE 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) ;FIRST FREE BYTE 0 ?
	BNE	10$		;NO, PROCEED
	DEC	R1		;YES, DON'T COUNT THIS BLOCK
10$:	CALL	$CBDMG		;CONVERT TO ASCII
	MOV	<F.HIBK-<F.EFBK+2>>(R4),R1 ;GET HIEST ALLOCATED
	MOVB	#'.,(R0)+	;SHOW THAT # IS DECIMAL
	MOVB	#'/,(R0)+	;INSERT A SEPARTOR
	CLR	R2		;ZERO SUPPRESS
	CALL	$CBDMG		;CONVERT
	MOVB	#'.,(R0)+	;ADD THE DECIMAL INDICATOR
	RETURN			;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		;ZERO SUPRESS 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