.TITLE	SRDLST-LIST THE DIRECTORY
;
;**SRD--SORT DIRECTORY
;
;THIS MODULE CREATS A SELECTIVE LISTING OF THE FILE
;
;
; THIS TASK WILL SORT A RSX11 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,GCMLD$,QIOW$S
	FHDOF$	DEF$L
	GCMLD$
DTSTR:	.BYTE	40,2,'-,3,'-,2,' ,2,':,2,':,2,' ,0
EQFLG:	.BYTE	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
CLMFLD:	.BLKW	2	;FIELD HOLDS CONTINOUS,LOCKED AND MULTIPLE
VRSNS$:	.WORD	0
DIRBMP:	.WORD	10	;BUMPING SIZE USED IN AVER
LEN1:	.WORD	0	;RECORD EXACT LENGTH OF ASCII NAME
LEN2:	.WORD	0	;RECORD EXACT LENGTH OF ASCII NAME.TYP.VER STRING
QBUF$:	.ASCII	" [Y/N/G/Q] ? _"<10>	; /SD PROMPT MESSAGE SUFFIX
QBUFS$=.-QBUF$
QBF1$:	.ASCII	<15><12><11>"ARE YOU SURE [Y/N] ? _"<10>  ; GO VERIFICATION MSG
QBF1S$=.-QBF1$
	.EVEN
SRDLST::
	BIT	#<OVSW!NVSW>,SWMS1$	;SELECTIVE VERSIONS?
	BNE	1$		; YES  BRANCH AROUND THIS JUMP
	JMP	NORMAL			; NO  PROCESS AS NORMAL
;   SOME FANCY FOOTWORK... BECAUSE /OV,/NV, AND /PU NEED DIRECTORY SORTED
;    BY ASCENDING NAME,TYPE,VERSION. WILL PERFORM A SECOND SORT BY USERS
;    SPECIFICATIONS.
1$:	MOV	R0,-(SP)		;SAVE R0
	MOV	DIRBF$,R5		;SET START OF DIR.BUFFER
	TST	SVNUM$		;IF SVNUM$ = 0
	BNE	SUNPAK
	INC	SVNUM$		; USE DEFAULT OF 1
SUNPAK:	TST	(R5)		;ANYTHING LEFT TO UNPACK?
	BNE	SUNP1		; YES    BRANCH
	BIC	#<OVSW!NVSW>,SWMS1$	;CLEAR SWITCHES
	BIC	#SESW,SWMSK$
	BIS	#SRSW,SWMS1$		;BE SURE TO SORT
	MOV	(SP)+,R0	;RESTORE R0
	CALL	SRDSRT		;COMPRESS AND SORT SELECTED FILES
	JMP	NORMAL		;PROCESS AS NORMAL
SUNP1:	CLR	VRSNS$
	ADD	#D.FNAM,R5	;POINT TO FILE-NAME PORTION
	MOV	LSTFDB+F.NRBD+2,R0	;WRITE REC INTO LSTFDB
	MOV	#3,R3
20$:	MOV	(R5)+,R1	;GET A RAD50 WORD
	CALL	$C5TA		;CONVERT TO ASCII
	DEC	R3
	BGT	20$		;BR IF STILL ON NAME
	BMI	30$		;BR IF JUST DID TYPE
	MOVB	#'.,(R0)+	;SEPERATE NAME AND TYPE
	BR	20$
30$:	MOVB	#';,(R0)+	;SEPERATE TYPE AND VERSION
	MOV	(R5)+,R1	;NOW GET VERSION
	CLR	R2
	CALL	$CBOMG		;CONVERT TO ASCII
	BIT	#SESW,SWMSK$	;IS THIS A SELECTIVE LIST?
	BEQ	CKVRSN		;  NO   GO CHECK VERSIONS
	MOV	#SEBUF$,R2
	MOV	LSTFDB+F.NRBD+2,R1
	CALL	MATCH
	BCC	SFOUND
SFAIL:	BIT	#NESW,SWMSK$	;NEGATED TESTS?
	BNE	CKVRSN		; YES
	BR	FLAGIT		; NO  FLAG THAT WE DON'T WANT THIS ONE
SFOUND:	BIT	#NESW,SWMSK$	;NEGATED TESTS?
	BEQ	CKVRSN		; NO
	BR	FLAGIT		; YES  FLAG IT - WE DON'T WANT IT

CKVRSN:	INC	VRSNS$		;COUNT # VERSIONS
	MOV	R5,R3
	SUB	#12,R3		;BACK UP TO START OF NAME
	MOV	R3,R2
	ADD	#D.SIZ,R2	;R2 PTS. NEXT DIR. ENTRY
8$:	MOV	#4,R1		;#WORDS TO MATCH
10$:	CMP	(R2)+,(R3)+	;NAMES MATCH??
	BNE	20$		; NO   EXIT LOOP
	SOB	R1,10$		;LOOP
	INC	VRSNS$		;ANOTHER VERSION
	SUB	#10,R3		;BACKUP START OF ORIG.
	ADD	DIRBMP,R2	;BUMP TO START OF NEXT ENTRY
	BR	8$		;KEEP MATCHING
20$:	SUB	#D.SIZ,R5	;BACKUP TO START OF ORIG. REC.
	BIT	#OVSW,SWMS1$	;IF WORKING WITH OLD VERSIONS
	BNE	30$		; BRANCH    OTHERWISE NEW VERSIONS
	CMP	VRSNS$,SVNUM$	;IF HAVE <= # WANT
	BLE	25$		;  PUT WHAT HAVE
	SUB	SVNUM$,VRSNS$	;CALCULATE # TO SKIP
	MOV	VRSNS$,R2
23$:	CLR	(R5)		;FLAG THIS ENTRY - WE DON'T WANT IT
	INC	NUMFT		;COUNT # FILES OMITTED
	ADD	#D.SIZ,R5	;BUMP TO NEXT ENTRY
	SOB	R2,23$
	MOV	SVNUM$,VRSNS$
25$:	CLR	R2
	MOV	VRSNS$,R3	;JUMP OVER VERSION ENTRIES TO KEEP
	MUL	#D.SIZ,R3	;#VERSIONS * D.SIZ = JUMP
	ADD	R3,R5		;ADD JUMP TO POINTER
	BR	SUNPAK		;GET NEXT DIR. ENTRY
30$:	CMP	#-1,SVNUM$	;COLLECTING OLD VERSIONS
	BNE	35$
	ADD	#D.SIZ,R5	;IF OV:-1 JUMP OVER THIS FIRST ONE
	MOV	VRSNS$,R2	; AND FLAG THE REST
	DEC	R2
	BEQ	SUNPAK		;IF ONLY 1 VERSION  GET NEXT DIR. ENTRY
	BR	38$
35$:	MOV	VRSNS$,R2
	MOV	VRSNS$,R3	;#HAVE - #EXEMPT = #JUMP
	SUB	SVNUM$,R3
	BLE	38$
	CLR	R2
	MUL	#D.SIZ,R3	;#JUMP * D.SIZ = JUMP
	ADD	R3,R5		;ADD JUMP TO POINTER
	MOV	SVNUM$,R2
38$:	CLR	(R5)		;FLAG THIS ENTRY - WE DON'T WANT IT
	INC	NUMFT		;COUNT # FILES OMITTED
	ADD	#D.SIZ,R5	;BUMP TO NEXT DIR. ENTRY
	SOB	R2,38$
	JMP	SUNPAK
FLAGIT:	SUB	#D.SIZ,R5
	CLR	(R5)		;FLAG THIS ENTRY
	INC	NUMFT		; COUNT # FILES OMITTED
	ADD	#D.SIZ,R5	;BUMP TO NEXT DIR. ENTRY
	JMP	SUNPAK
NORMAL:	MOV	#LINBUF,LSTFDB+F.NRBD+2
	MOV	DIRBF$,R5	;SET START OF DIRECTORY BUFFER
UNPACK:	TST	(R5)		;ANY THING REMAINING TO UN-PACK?
	BNE	UNP1		;CONTINUE
QUITR:	BIT	#PRSW,SWMS1$		;IF USING PROCESSOR SKIP OVER THIS
	BNE	2$
	MOV	#FILMSG,R0	; LIST OUT FILE COUNTS
	MOV	NUMFS,R1
	BNE	1$	; DON'T SHOW ZERO SELECTED IF WILDCARD UIC
	TST	NXUIC$
	BNE	2$
1$:	MOV	#33012,R2
	CALL	$CBTA
	MOV	#FTMSG,R0
	MOV	NUMFT,R1
	MOV	#33012,R2
	CALL	$CBTA
	TST	UFDFDB+F.BDB	; IS DIRECTORY STILL OPEN ???
	BNE	21$		; YES--DON'T PRINT TOTALS YET
	PUT$S	#LSTFDB,#FILMSG,#FMLEN
; SHOW SELECTED BLOCKS USED/ALLOCATED
	MOV	#SBAREA,R0
	MOV	#TBLKU,R1
	CLR	R2
	CALL	$CDDMG
	MOVB	#'.,(R0)+
	MOVB	#'/,(R0)+
	MOV	#TBLKA,R1
	CLR	R2
	CALL	$CDDMG
	MOVB	#'.,(R0)+
	MOV	R0,R2
	SUB	#SBMSG,R2
	PUT$S	#LSTFDB,#SBMSG,R2
21$:	MOV	#LINBUF,LSTFDB+F.NRBD+2
2$:	RETURN
;
UNP1:	INC	NUMFT		;INCREMENT #FILES LOOKED AT
	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
	BIT	#SVSW,SWMSK$	;ONLY 1 VERSION WANTED?
	BEQ	HIGHVR		;BR IF NO
	CMP	<D.VER-D.FNAM>(R5),SVNUM$	;CORRECT VERSION?
	BEQ	CVAS		;YES  GO ON
	ADD	#<D.SIZ-D.FNAM>,R5	;BUMP TO NEXT ENTRY
	BR	UNPACK
;
HIGHVR:	BIT	#HVSW,SWMS1$	;HIGHER VERSIONS WANTED?
	BEQ	CVAS		;BR IF NO
	MOV	SVNUM$,R1	;GET LOWEST VERSION TO SELECT
	BNE	10$		;BR IF VALUE GIVEN
	MOV	#2,R1		;ELSE USE 2 AS LOW LIMIT
10$:	CMP	<D.VER-D.FNAM>(R5),R1	;VERSION HIGH ENOUGH?
	BHIS	CVAS		;BR IF SELECTING THIS VERSION
	ADD	#<D.SIZ-D.FNAM>,R5	;ADVANCE POINTER TO NEXT ENTRY
	JMP	UNPACK
CVAS:	MOV	#3,R3		;NUMBER OF WORDS IN NAME
10$:	MOV	(R5)+,R1	;GET A RADIX-50 WORD
	CALL	$C5TA		;CONVERT TO ASCII
	SOB	R3,10$		;GET ALL OF NAME
12$:	CMPB	#40,-(R0)	;BACKUP OVER BLANKS
	BEQ	12$
	INC	R0		;POINT TO 1ST EMPTY LOC.
	MOV	R0,LEN1		;STORE EXACT END OF FILENAME
	MOVB	#'.,(R0)+	;SEPERATE NAME AND TYPE
	MOV	(R5)+,R1	;GET RAD50 TYPE
	CALL	$C5TA		;CONVERT TO ASCII
	MOVB	#';,(R0)+	;SEPARATE TYPE AND VERSION
	MOV	(R5)+,R1	;NOW GET VERSION
	CLR	R2		;SET ZERO SUPPRESS FLAG
	CALL	$CBOMG		;CONVERT TO ASCII
	MOV	R0,LEN2		;STORE EXACT END OF ASCII STRING
	BIT	#SESW,SWMSK$	;IS THIS A SELECTIVE LIST?
	BEQ	HDREAD		;BR IF NO-CK FOR VERSION SELECTION
	MOV	#SEBUF$,R2	;SET SELECTION STRING ADDRESS
	MOV	LSTFDB+F.NRBD+2,R1 ;SET START OF NAME
	CALL	MATCH
	BCC	FOUND
;
FAILED:	BIT	#NESW,SWMSK$	;NEGATED TESTS ?
	BNE	HDREAD		; YES
	JMP	UNPACK		; NO, GET NEXT F-S TO TRY
;
FOUND:	BIT	#NESW,SWMSK$	;NEGATED TESTS ?
	BEQ	HDREAD		; NO
	JMP	UNPACK		; YES
	.PAGE
HDREAD:				;ALWAYS READ HEADER SO CAN PICK UP BLOCKS
10$:	CLR	HDBUF$		;ZERO THIS WORD FOR FCP
	DIR$	#READHD		;READ THE FILE HEADER
	BCC	20$
	CALL	$ALERR
	BR	10$
20$:	WTSE$S	#EFN1
	CMPB	IOSB$,#IS.SUC	; OKAY?
	BEQ	CKCLM
;
	CMPB	IOSB$,#IE.SQC	; FILE ID/SEQ NUMBER CHECK
	BNE	25$
	DIAG	SQCHK
	BR	40$
;
25$:	CMPB	IOSB$,#IE.PRI	; PRIV
	BEQ	30$
	DIAG	HDRE		; SOME OTHER ERROR
	BR	40$
;
30$:	DIAG	HDPRV
40$:	CALL	PUTLST
	JMP	UNPACK
CKCLM:	BIT	#<FUSW!DASW!LISW>,SWMSK$   ;FULL LISTING OR DATE SELECT?
	BNE	10$
	BIT	#<COSW!LOSW!MUSW>,SWMS1$   ;SELECT CONTIG,LOCKED OR MULTI?
	BEQ	LSTENT
10$:	MOV	#"  ,CLMFLD	;BLANK CLM FILE CHARACTERISTICS
	MOV	#"  ,CLMFLD+2	;  FIELD
	MOVB	HDBUF$+H.UCHA,R1  ;GET USER-CONTROLLED FILE CHARACTERISTICS
	BITB	#COFLAG,R1	;IS CONTIGOUS FLAG SET?
	BEQ	20$		; NO  BRANCH
	MOVB	#'C,CLMFLD	;INSERT CONTIGOUS SYMBOL
	BR	30$		;PROCEED
20$:	BIT	#COSW,SWMS1$	;CONTIGUOUS SWITCH SPECIFIED?
	BNE	REJECT
30$:	BITB	#LOFLAG,R1	;IS FILE LOCKED?
	BEQ	40$		; NO    BRANCH
	MOVB	#'L,CLMFLD+1	;INSERT LOCKED SYMBOL
	BR	50$
40$:	BIT	#LOSW,SWMS1$	;LOCKED SWITCH SPECIFIED?
	BNE	REJECT
50$:	TST	HDBUF$+S.HDHD+S.IDHD+M.EFNU  ;HEADER EXTENSIONS?
	BEQ	60$
	MOVB	#'M,CLMFLD+2	;INSERT MULTI-HEADER SYMBOL
	BR	CKD1
60$:	BIT	#MUSW,SWMS1$	;MULTI-HEADER SWITCH SPECIFIED?
	BEQ	CKD1		;NO  PROCEED
REJECT:	JMP	UNPACK		;UNPACK THE NEXT ENTRY
CKD1:	MOVB	HDBUF$,R1	;GET OFFSET TO IDENT AREA IN HEADER
	ASL	R1		;MAKE AWORD OFFSET
; FOR DATE SELECT USE CREATION DATE BY DEFAULT. IF REVISION DATE SPECIFIED
;  USE IT (IF NEVER REVISED FALL BACK ON CREATION DATE). R1 POINTS TO
;  DATE USING. R3 ALWAYS POINTS TO CREATION DATE.
	ADD	#HDBUF$,R1	; POINT AT IDENT AREA
	MOV	R1,R3		; POINT TO CREATION DATE
	ADD	#I.CRDT,R3
	BIT	#RDSW,SWMS1$	; USE REVISION DATE ??
	BEQ	1$		; NO !!!!
	TST	I.RVNO(R1)	; EVER REVISED ??
	BEQ	1$		; NO--USE CREATION DATE
	ADD	#<I.RVDT-I.CRDT>,R1	; YES--USE REVISION DATE
1$:	ADD	#<I.CRDT>,R1
	BIT	#DASW,SWMSK$	;DOING DATE SELECTION?
	BEQ	LSTENT		;NO-LIST IT
	MOV	R0,-(SP)
	CALL	CNVDAT		;CONVERT DATE TO INTEGER
	MOV	(SP)+,R0
	TST	R2
	BEQ	LSTENT		; BAD DATE FORMAT
;
; FOR DATE SELECTION, SEE IF THE FILE'S DATE IS AFTER THE AFTER-DATE,
;	AND BEFORE THE BEFORE-DATE------INCLUSIVE OF THE END POINTS.
	CMP	BEVAL$,R2
	BLO	UNPK1
	CMP	AFVAL$,R2
	BHI	UNPK1
	BR	LSTENT
UNPK1:	JMP	UNPACK
	.PAGE
	.ENABLE	LSB
LSTENT:
	BIT	#HDSW,SWMSK$	;HAS HEADER BEEN LISTED?
	BEQ	13$		;BRANCH AROUND IF NO
	JMP	LSTE1		;JUMP IF HEADER HAS BEEN LISTED
13$:	BIT	#PRSW,SWMS1$	;IF USING PROCESSOR SKIP OVER HEADER
	BEQ	1$
	JMP	PRCSSR
1$:	BIS	#<HDSW!FLSW>,SWMSK$	;FLAG AS PRINTED
	SUB	#D.SIZ,R5	;BACK UP TO DO THIS 1 AGAIN
	DEC	NUMFT
	MOV	LSTFDB+F.NRBD+2,R0 ;RESET POINTER TO TOP OF BUFFER
	TST	NXUIC$		; WILDCARD UIC???
	BNE	3$		; YES
	BITB	#FD.SPL,LSTFDB+F.BKP1	; IS OUTPUT AUTO-SPOOLED ?
	BNE	3$		; BR IF YES
	BIT	#SPSW,SWMSK$	;LISTING BEING SPOOLED ?
	BEQ	4$		;NO
3$:	CALL	PUTLST
	CALL	PUTLST
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$+18.> ;FINISH DATE?
	BLO	10$		;BR IF NO
	CALL	PUTLS1		;PRINT THAT
; PUT COMMAND LINE - FOUND IN STRCMD
	TST	CMDBLK+G.CMLD
	BEQ	15$
	PUT$S	#LSTFDB,#STRCMD+2,STRCMD
	MOV	#LINBUF,LSTFDB+F.NRBD+2
	MOV	#LINBUF,R0
;
; **** GIVE MSG IF WE HAVE TO DO IT IN PIECES****
15$:	TST	UFDFDB+F.BDB	; IS DIRECTORY OPEN???
	BEQ	11$		; NO
	DIAG	0		; YES--PUT MESSAGE
11$:	JMP	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
	.PAGE
PUNPK1:	JMP	UNPACK
LSTE1:	INC	NUMFS
; ACCUM TOTAL BLOCKS USED/ALLOCATED
	MOV	#HDBUF$+H.UFAT,R4	; ADDR OF USER ATTRIBUTES
	ADD	F.HIBK+2(R4),TBLKA+2	; ALLOC
	ADC	TBLKA
	ADD	F.HIBK(R4),TBLKA
	MOV	F.EFBK+2(R4),R1		; USED
	BEQ	1$
	TST	F.FFBY(R4)		; 1ST FREE BYTE = 0?
	BNE	1$
	DEC	R1			; YES--DON'T COUNT THE BLOCK
1$:	ADD	R1,TBLKU+2
	ADC	TBLKU
	BIT	#BRSW,SWMSK$		; JUMP OUT IF LISTING NOT WANTED
	BEQ	PUNPK1
	BIT	#<FUSW!DASW!LISW>,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
2$:	MOVB	#40,(R0)+	;INSERT BLANKS TO FILL OUT FILENAME SPACE
	CMP	R0,R1
	BLO	2$
	MOV	#CLMFLD,R2	;GET ADDRESS OF CONTIG-LOCKED-MULTI FIELD
	MOV	#4,R1		;WILL MOVE 4 BYTES
4$:	MOVB	(R2)+,(R0)+	;MOVE FIELD TO OUTPUT LINE
	SOB	R1,4$
	CALL	PUTDTM		; INSERT DATE AND TIME
	MOV	#FUTABL,R3	;FORMAT TABLE ADDRESS
10$:	MOVB	(R3)+,R4	;PICK UP NEXT OFFSET
	BEQ	55$		;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	52$		;BR WHEN FIELD IS FULL
	MOVB	#40,(R0)+	;SPACE FILL
	BR	50$		;TRY AGAIN
52$:	BIT	#FUSW,SWMSK$		;REALLY BIG LISTING?
	BEQ	PUT1		;NO
	BR	10$		;YES   DO SOME MORE
;;;; PRINT REVISION DATE & TIME
55$:	MOVB	HDBUF$,R3
	ASL	R3
	ADD	#HDBUF$,R3
	MOV	I.RVNO(R3),R4
	BEQ	60$		; NEVER REVISED, FORGET IT
	ADD	#I.RVDT,R3
	CALL	PUTDTM
	CMP	R4,#1	; SHOW REV COUNT IF > 1
	BEQ	60$
	MOV	R4,R1
	CLR	R2
	MOVB	#'(,(R0)+
	CALL	$CBDMG
	MOVB	#'.,(R0)+
	MOVB	#'),(R0)+
60$:
PUT1:
	BIT	#SDSW,SWMS1$	; DOING SELECTIVE DELETE?
	BNE	1$		; YES
	CALL	PUTLST		; OUTPUT THE LINE
	BIT	#DESW,SWMSK$	; ALWAYS DELETE
	BNE	55$		; YES-DON'T BOTHER TO ASK
	JMP	UNPK1		; CONTINUE
55$:	JMP	5$		; DELETE FILE
1$:	MOV	LSTFDB+F.NRBD+2,R2 ;GET ADDRESS OF BUFFER.
	SUB	R2,R0		; COMPUTE LENGTH OF BUFFER.
	MOV	#PRMPT,R1	; POINT TO PROMPT STRING.
	MOV	(PC)+,(R1)+	; START OUT AT BEGINNING OF LINE.
	.BYTE	15,12		; <CR><LF>
100$:	MOVB	(R2)+,(R1)+	; MOVE IN THE FILENAME.
	SOB	R0,100$		; MOVE ALL OF IT.
	MOV	#QBUF$,R2	; POINT TO MESSAGE SUFFIX FOR QUESTION PROMPT
	MOV	#QBUFS$,R0	; GET LENGTH OF MESSAGE SUFFIX
101$:	MOVB	(R2)+,(R1)+	; MOVE IT INTO PLACE
	SOB	R0,101$		; LOOP UNTIL THROUGH
	SUB	#PRMPT,R1	; COMPUTE LENGTH OF PROMPT STRING.
99$:	CLRB	LINBUF		; ERASE ANY PREVIOUS YES RESPONSES
	QIOW$S	#IO.RPR,#1,#17,,,,<#LINBUF,#4,,#PRMPT,R1,#0>
	MOV	LSTFDB+F.NRBD+2,R0 ; RECOVER BUFFER ADDR
3$:	BICB	#40,LINBUF	; CONVERT TO UPPER CASE
	CMPB	#'Y,LINBUF	; WAS THE ANSWER YES?
	BEQ	5$		; IF YES, DELETE THE FILE
	CMPB	#'G,LINBUF	; WAS THE ANSWER GO?
	BNE	103$		; IF NO, CHECK FOR QUIT
	QIOW$S	#IO.RPR,#1,#17,,,,<#LINBUF,#4,,#QBF1$,#QBF1S$,#0>
	BICB	#40,LINBUF	; CONVERT TO UPPER CASE
	CMPB	#'Y,LINBUF	; SURE?
	BNE	99$		; IF NOT, PROMPT AGAIN
	BIC	#SDSW,SWMS1$	; CLEAR SELECTIVE DELETE FLAG
	BIS	#DESW,SWMSK$	; SET DELETE SWITCH
	BR	5$		; START TO DELETE THE FILES
102$:	JMP	QUITR		;***QUIT THIS RUN
103$:	CMPB	#'Q,LINBUF	; WAS THE ANSWER QUIT?
	BEQ	102$		; IF YES, RETURN
	BR	UNPK2		; NO FOR THIS FILE; SEE ABOUT ABOUT NEXT FILE
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	UNPK2		; BR IF DELETE WORKED
	DIAG	FDEL		; ISSUE DIAGNOSTIC MESSAGE
UNPK2:
	JMP	UNPACK		;DO THE NEXT
PRCSSR:				;DESING A COMMAND FILE
	BIS	#FLSW,SWMSK$	;MUST SET FILE WRITTEN SWITCH
	CLRB	EQFLG		;CLR FLAG THAT SHOW IF = NEEDED
	MOV	LSTFDB+F.NRBD+2,R0
	SUB	R0,LEN1		;GET CHAR. COUNT OF FILENAME
	SUB	R0,LEN2		;CHAR. COUNT OF ENTIRE NAME
	MOV	R0,R1		;R1  HOLDS STARTING ADDRESS
	MOV	PRCCNT,R2
	MOV	#PRMPT,R3	;STORE	FILNAM.TYP.V IN PRMPT
	MOV	LEN2,R4
10$:	MOV	(R1)+,(R3)+
	SOB	R4,10$
	MOV	LSTFDB+F.NRBD+2,R1	;RESET STARTING ADDRESS
	TST	R2		;IS THERE A PROCESSOR NAME?
	BEQ	20$		;NO   SKIP OVER THIS
	ADD	R2,R0		;INC CHAR. COUNT
	MOV	#XXXSAV,R3
15$:	MOVB	(R3)+,(R1)+	;INSERT PROCESSOR NAME CHAR. BY CHAR.
	SOB	R2,15$
	CMP	#1,PRCCNT	;IF INSERT ONLY 1 CHAR. ASSUME @
	BEQ	20$		;  DO NOT INSERT BLANK
	MOVB	#40,(R1)+	;INSERT A BLANK
	INC	R0		;INC CHAR. COUNT
20$:					;WORK ON FORMATS NOW
	BIT	#1,PRNUM$	;OUTFILE?
	BEQ	30$		; NO 
	BISB	#1,EQFLG	;SET FLAG TO INCLUDE =
	CALL	INSRT		;INSERT OUTFILE NAME
30$:	BIT	#2,PRNUM$	;LSTFILE?
	BEQ	40$		;NO
	BISB	#1,EQFLG	;SET BIT 0 - A FLAG TO INSERT =
	MOVB	#54,(R1)+	;INSERT A COMMA
	INC	R0		;INC CHAR. COUNT
	CALL	INSRT		;INSERT LSTFILE
40$:	BITB	#1,EQFLG	;DO WE NEED TO INSERT =?
	BEQ	50$
	MOVB	#'=,(R1)+	;INSERT =
	INC	R0		;INC CHAR. COUNT
50$:
;  LATER ADD DEVICE OPTION HERE
;   ADD UIC OPTION HERE
	CALL	INSRT		;INSERT FILNAM
	MOV	R3,R4		;SAVE R3
	BIT	#4,PRNUM$	;TYPE?
	BEQ	60$		;NO  BRANCH
	MOV	#4,R2		;WE WILL MOVE 4 CHARACTERS
	ADD	R2,R0		;INC CHAR. COUNT
52$:	MOVB	(R3)+,(R1)+	;MOVE BYTE BY BYTE (R3 LEFT BY INSRT)
	SOB	R2,52$
60$:	BIT	#10,PRNUM$	;VERSION?
	BEQ	70$		;NO  BRANCH
	MOV	LEN2,R2		;LOAD #CHAR. IN ENTIRE STRING
	SUB	LEN1,R2
	SUB	#4,R2		;ADJUST FOR CHAR. ALREADY DONE
	ADD	R2,R0		;INC. CHAR COUNT
	CMP	R3,R4		;DID WE DO TYPE?
	BNE	62$		;YES - R3 POINTS CORRECTLY
	ADD	#4,R3		;NO   ADJUST R3
62$:	MOVB	(R3)+,(R1)+	;MOVE BYTE BY BYTE
	SOB	R2,62$
70$:	BIT	#20,PRNUM$	;SECOND FILE?
	BEQ	80$		;NO    BRANCH
	MOVB	#54,(R1)+	;INSERT A COMMA
	INC	R0		;INC CHAR. COUNT
	CALL	INSRT		;INSERT SECOND FILE
	ADD	#2,R0		;ADD  ;0
	MOVB	#';,(R1)+
	MOVB	#'0,(R1)+
80$:	CALL	PUTLS1		;PUT LINE
	BR	UNPK2
;
;INSRT -----  INSERT FILENAM INTO OUTPUT BUFFER
;
INSRT:
	MOV	#PRMPT,R3	;GET ADDRESS OF FILENAM
	MOV	LEN1,R2		;AND ITS LENGTH
	ADD	R2,R0		;INC CHAR. COUNT
10$:	MOVB	(R3)+,(R1)+	;MOVE BYTE BY BYTE
	SOB	R2,10$
	RETURN
	.PAGE
PUTDTM:	MOV	#DTSTR,R2	;DATE-TIME FORMAT STRING
	MOVB	(R2)+,(R0)+	;INSERT A LEAST 1 BLANK
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$:	RETURN
;
SIZECV:
	CLR	R2		;SET ZERO SUPPRESS FLAG
	TST	<F.FFBY-<F.EFBK+2>-2>(R4) ;FIRST FREE BYTE 0 ?
	BNE	10$		;NO, PROCEED
	TST	R1
	BEQ	10$
	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	#2,LSTFDB+F.NRBD+2	; 2 LEADING SPACES
PUTLS1:	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
	MOV	#LINBUF,LSTFDB+F.NRBD+2
	BCC	10$
	FERR	PUTE		;???CAN'T DO PUT???
10$:	MOV	#LINBUF,R0 ;GET RECORD BUFFER
	RETURN
	.END