.TITLE	SRDLST-LIST THE DIRECTORY
	.IDENT	/V2.1/		;27-FEB-77
	.nlist	bex,me,cnd
	.enabl	lc
;+
;
;**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
;
 
;Edits:
 
;No.	Date	By	Reason
;--- ---------	------	---------------------------------------------------
;+04 01-Mar-79	HRT	Added Y,N,G,Q to selective delete.
;+05 03-MAR-79	HRT	Added "Are You Sure" message to "GO".
;+06 03-Mar-79	HRT	Added R/O psects for sharable code.
;+07 05-Apr-79	HRT	Fixed bug caused by R/O psects.
;-

	.sbttl	SYSTEM MACRO CALLS
;
	.MCALL	FHDOF$,CALLR,DIR$,QIOW$,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

READ:	QIOW$	IO.RPR,1,17.,,IOSB$,,<LINBUF,1,,PRMPT,0>  ; +05

	.sbttl	Start Mainline code

	.PSECT	SRDLST,I,RO,REL		; +06

QBUF$:	.ASCII	<11><11><11>"[Y,N,G,Q] ? _"<10>	; +04 Prompt message
	QBUFS$=.-QBUF$
QBF1$:	.ASCII	<15><12><11>"Are you sure [Y/N] ? _"<10>  ; +05
	QBF1S$=.-QBF1$
	.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 
	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
 
;+07	The first time through the loop, there is no need to
;+07	check the last filename, since there wasn't a last
;+07	filename.
;+07	What's happening is that the task builder is placing the
;+07	start of the impure area on APR2. Then the first time through
;+07	the loop, aa segment fault will occur when SRD tries to match
;+07	the previous filename with the current. 

	MOV	R5,R1			; Get current filename pointer
	MOV	R5,R3			; COPY CURRENT NAME
	MOV	R3,-(SP)		; +07 Save current value of R3
	SUB	#D.FNAM,R3		; +07 Try to make it the same as R5
	CMP	DIRBF$,R3		; +07 First time through?
	BNE	2$			; +07 NE - nope, continue through
	ADD	#D.SIZ,R1		; +07 Point to next filename
	MOV	(SP)+,R3		; +07 Restore R3
	BR	CVAS			; +07 Go list it

2$:	MOV	(SP)+,R3		; +07 Restore R3
	SUB	#D.SIZ,R3		; BACK UP 1 ENTRY
	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
	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	#<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$:

	.sbttl	Selective Delete Processing
PUT1:
	BIT	#SDSW,SWMSK$		; ++003 SELECTIVE DELETE ?
	BNE	1$			; ++003 YES, LIST USING READ-WITH-PROMP
	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	#<<15*400>+12>,(R1)+	; ++003 Insert a CR-LF
100$:	MOVB	(R2)+,(R1)+		; ++003 COPY PROMPT
	SOB	R0,100$			; ++003 TILL END

	MOV	#QBUF$,R2		; +04 Point to question buffer
	MOV	#QBUFS$,R0		; +04 Get it's length
101$:	MOVB	(R2)+,(R1)+		; +04 move into place
	SOB	R0,101$			; +04 Loop till thru

	SUB	#PRMPT,R1		; ++003 CALC LENGTH
99$:	CLRB	LINBUF			; ERASE ANY PREVIOUS YES'S

	MOV	#PRMPT,READ+Q.IOPL+6	; +05 Set prompt address
	MOV	R1,READ+Q.IOPL+10	; +05 Set prompt length
	DIR$	#READ			; +05 Prompt for response
	MOV	LSTFDB+F.NRBD+2,R0	; ++003 
	TSTB	IOSB$			; ANY ERR-MUST BE EOF
	BGT	3$			; BR IF NO ERR
102$:	RETURN				; *** EXIT THIS RUN ###

3$:	BICB	#40,LINBUF		; +04 Convert to upper case

	CMPB	#'Y,LINBUF		; Was the answer YES ?
	BEQ	5$			; EQ - then delete the file

	CMPB	#'G,LINBUF		; +04 Was the answer GO?
	BNE	103$			; +04 NE - Check for quit.
	MOV	#QBF1$,READ+Q.IOPL+6	; +05 Get ready to ask if they're sure
	MOV	#QBF1S$,READ+Q.IOPL+10	; +05 Set prompt length
	DIR$	#READ			; +05 Prompt for response.
	TSTB	IOSB$			; +05 Any errors?
	BLE	102$			; +05 Yes, so leave
	BICB	#40,LINBUF		; +05 Convert to upper case
	CMPB	#'Y,LINBUF		; +05 Well, did they type yes?
	BNE	99$			; +05 No, go prompt again
	BIC	#SDSW,SWMSK$		; +04 Clear selective delete flag
	BIS	#DESW,SWMSK$		; +04 Set delete switch.
	BR	5$			; +08 And start to delete the files

103$:	CMPB	#'Q,LINBUF		; +04 Was the answer quit?
	BEQ	102$			; +04 Yes, quit now
	BR	UNPK1			; +04 Else go do the next file.

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 DIREC. 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 HIGHEST 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