.TITLE	SRDINI
	.IDENT	-5.0-		; 19-NOV-79

;+
;
; **SRD--SORT DIRECTORY
;
; 	TASK INITIALIZATION PHASE
;
;
;  THIS TASK WILL SORT A RSX11M DIRECTORY
; THEN CREATE A LISTING WITH SEVERAL SELECTION OPTIONS
;
; MODIFICATIONS:
;
;	HLC001 -- FIX BUG ON SYSTEMS WITH EXTEND TASK AND NO
;		  DYNAMIC CHECKPOINT ALLOCATION.
;
;	HLC002 -- FIX BUG WHEN USING SYSTEM DATE AS DEFAULT.
;
;	 BT001 -- 11-JUL-79 -- SUPPORT CO, LO, MU SWITCHES.
;	 BT002 -- 15-JUL-79 -- SUPPORT /AF AND /BE SWITCHES IN COMMAND LINE
;		  TO SELECT FILES BETWEEN THE TWO DATES.
;	 BT003 -- 18-JUL-79 -- TREAT FILE SPECIFICATION STRING GIVEN IN COMMAND
;		  LINE AS IF IT HAD WILD CARD MATCHING AFTER NAME AND TYPE
;		  STRINGS GIVEN, UNLESS /DE, /SD, OR /PU SPECIFIED;  ALSO
;		  INSERT '.' IF NONE GIVEN IN /SE: OR /SD: SWITCH STRING.
;	 BT004 -- 29-JUL-79 -- ZERO /SD BUFFER TO AVOID SYNTAX ERROR IF
;		  NAME.TYP/SD USED AFTER PREVIOUS /SD:NAME.TYP OR /SE:NAME.TYP
;	 BT005 -- 30-JUL-79 -- SUPPORT /OV:[N] SWITCH TO LIST OBSOLETE VERSIONS
;		  OF FILES, WHICH ARE THE FILES WHICH WOULD BE DELETED IF THE
;		  /PU:[N] SWITCH WERE USED, AND THOSE WHICH WOULD NOT BE LISTED
;		  IF THE /SV:[N] SWITCH WERE SPECIFIED.  NOTE THAT NO ADDITIONAL
;		  BIT IN THE SWITCH MASK WORD IS NEEDED FOR /OV PROCESSING.
;	 BT006 -- 05-AUG-79 -- CONDITIONALIZE FOR APPENDING WILD CARD MATCHING
;		  CHARACTERS TO IMPLICIT SELECTION FILE NAME STRING (MADE IN
;		  MODIFICATION BT003).
;
;	DUKE007 -- 19-NOV-79 ADDED /ID SWITCH TO DISPLAY VERSION NUMBER.
;	DUKE008	-- 19-Nov-79 ADDED /BF SWITCH TO DISPLAY INTERNAL BUFFER SIZE.
;-

;
; SYSTEM MACRO CALLS
;
	.MCALL	CSI$1,CSI$2,DIR$,EXIT$S,GCMLD$,GCML$,FHDOF$
	.MCALL	GTIM$S,WTSE$S,CSI$SW,CSI$SV,CSI$ND,NMBLK$
	.IF DF	R$$11M
	.MCALL	EXRG$S,GPRT$	; 04 EXTEND REQION
	.IFF
	.MCALL	GTSK$		; GET TASK PARAMETERS.
	.ENDC
	FHDOF$	DEF$L		; DEFINE FILE HEADER
;
	.IF DF	R$$11M
GETPAR:	GPRT$	,PARBF$
	.IFF
GTSK:	GTSK$	PARBF$
	.ENDC
STRING:	.ASCII	/SY:/
	.EVEN
SWTABL: CSI$SW  NA,NASW,SWMSK$,SET,NEG
	CSI$SW	SP,SPSW,SWMSK$,SET,NEG
	CSI$SW	HV,HVSW,SWMSK$,SET,NEG,HVVAL
	CSI$SW	NE,NESW,SWMSK$,SET,NEG
	CSI$SW	BE,<BESW!DASW>,SWMSK$,SET,NEG,BEVAL
	CSI$SW	AF,<AFSW!DASW>,SWMSK$,SET,NEG,DAVAL
	CSI$SW	SE,SESW,SWMSK$,SET,,SEVAL
	CSI$SW	SD,<SESW!SDSW>,SWMSK$,SET,NEG,SEVAL
	CSI$SW	PU,<PUSW!SVSW!SDSW!DESW>,SWMSK$,SET,NEG,PUVAL
	CSI$SW	OV,<PUSW!SVSW>,SWMSK$,SET,NEG,PUVAL
	CSI$SW	WB,WBSW,SWMSK$,SET,NEG
	CSI$SW	SV,SVSW,SWMSK$,SET,NEG,PUVAL
	CSI$SW	LI,LISW,SWMSK$,SET,NEG,FUVAL
	CSI$SW	DE,DESW,SWMSK$,SET,NEG
	CSI$SW	DA,DASW,SWMSK$,SET,NEG,DAVAL
	CSI$SW	FU,FUSW,SWMSK$,SET,NEG,FUVAL
	CSI$SW	CO,COSW,SWMS2$,SET,NEG
	CSI$SW	LO,LOSW,SWMS2$,SET,NEG
	CSI$SW	MU,MUSW,SWMS2$,SET,NEG
	CSI$SW	ID,IDSW,SWMS2$,SET	; +007 /IDENT
	CSI$SW	BF,BFSW,SWMS2$,SET	; +007 /BF

	CSI$ND
	CSI$SV	ASCII,SEBUF$,16.,SEVAL
	CSI$SV	DECIMAL,LINSZ$,2,FUVAL
	CSI$SV	DECIMAL,VRSCT$,2,PUVAL
	CSI$SV	ASCII,DABUF$,9.,DAVAL
	CSI$SV	ASCII,BEBUF$,9.,BEVAL
	CSI$SV	OCTAL,LVNUM$,2,HVVAL
	CSI$ND
DFNB:	NMBLK$  200200,DIR,1,SY,0
SRDINI::
	.IF DF	R$$11M		; 4.1 IF RUNNING ON RSX11M...
	DIR$	#GETPAR		; FIND SIZE OF PARTITION
	MOV	PARBF$+2,R0	; PICK UP SIZE OF PAR/100(OCTAL)
	SWAB	R0		; THIS ROUTINE
	ASRB	R0		; CONVERTS THAT SIZE
	ROR	R0		; INTO SIZE OF PARTITION
	ROR	R0		; IN BYTES
	ADD	#$DSW,R0	; ADD IN BASE OF PARTITION
	MOV	R0,DIRBE$	; SAVE END OF DIRECTORY BUFFER
	.IF DF	D$$CAL		; IF DYNAMIC CHECKPOINT ALGORITHM AVAILABLE...
	SUB	DIRBF$,R0	; FIND SIZE OF WORK BUFFER
	MOV	R0,R1		; COPY THAT
	CLC			; 04
	ROR	R1		; UN-SIGNED DIVIDE BY 2
	ASR	R1		; 04
	ASR	R1
	ASR	R1
	ASR	R1
	ASR	R1		; BY 64.
	NEG	R1		; BLOCK COUNT NEGATIVE
	EXRG$S	R1		; TRY TO SHRINK TASK
	BCS	LOOP		; BR IF DIDN'T WORK
	BIC	#77,R0		;  MODULO 64 BYTES
	SUB	R0,DIRBE$	; REDUCE SIZE OF BUFFER
	.ENDC
	.IFF			; IF ON RSX11D OR IAS...
	DIR$	#GTSK		; GET OUR TASK PARAMETERS.
	MOV	PARBF$+G.TSTS,R0 ; GET END OF BUFFER.
	MOV	R0,DIRBE$	; SET END OF BUFFER.
	.ENDC
LOOP:
	MOV	#LISW,SWMSK$	; INIT SWITCHES
	MOV	#0,SWMS2$	; INIT 2ND SWITCH WORD
	CLR	FLAGS$		; AND FLAGS
	CLR	LINSZ$		; ZERO LINE SIZE SW VALUE
	CLR	NXUIC$		; ASSUME NO WILD CARD UIC'S
	CLR	DABUF$		; ZERO RESIDUAL DATE
	CLR	BEBUF$		; ZERO /BE DATE
	CLRB	SEBUF$		; CLEAR /SE, /SD BUFFER
	CLR	VRSCT$		; RESET ANY PURGE COUNT
	GCML$	#CMDBLK	 	; GET COMMAND LINE
	BCC	CMDOK		; BR=AOK
	CMPB	CMDBLK+G.ERR,#GE.IOR ; I/O ERROR?
	BEQ	1$		; YES
	CMPB	#GE.EOF,G.ERR(R0) ; LOOK FOR END-OF-FILE
	BEQ	5$		; BR IF EXPECTED ERROR
	FERR	GCME		; ELSE LOG ERR
1$:	DIAG	GCME		; ISSUE DIAGNOSTIC
5$:	JSR	R0,ATTDET	; TRY TO DETACH DEVICE.
	.WORD	IO.DET		; 
	EXIT$S			; THEN LEAVE
;
;  COMMAND ERROR
;
CS1ERR:	FERR	CS1E
CS2IER:	FERR	CS2I
CS2OER:	FERR	CS2O
CMDERR:	FERR	GCME
PARSER:	FERR	PRSE
;
;
CMDOK:	MOV	G.CMLD+2(R0),R1	; COMMAND START
	MOV	G.CMLD(R0),R2	; AND LENGTH
	BNE	20$		; BR IF COMMAND THERE
	MOV	#STRING,R1	; SET DEFAULT COMMAND
	MOV	#3,R2		; LENGTH
20$:
	CSI$1	#CSIBLK,R1,R2	; CK SYNTAX
	BCS	CS1ERR		; BR IF BAD
	MOV	#SWTABL,C.SWAD(R0) ; SET SWITCH TABLE ADDRESS
	MOVB	#CS.OUT,(R0)	; ASSUME THAT OUTPUT IS ALL THAT WAS GIVEN
	MOV	#LSTDFN,R3	; GET DEFAULT NAME BLOCK FOR LISTING
	CLR	R2		; ASSUME NO NAME FOR OUTPUT IN STRING
	.IF NDF	I$$AS		; IF NOT ON IAS...
	MOV	#"TI,N.DVNM(R3)	; ASSUME THAT THE "TI:" IS WHERE IT GOES
	.IFF			; BUT IF ON IAS...
	MOV	#"TO,N.DVNM(R3)	; ASSUME THAT THE "TO:" IS WHERE IT GOES
	.ENDC
	BIT	#CS.EQU*400,(R0) ; WAS AN "=" GIVEN?
	BEQ	30$		; BR IF NO-ASSUMPTIONS WERE CORRECT
	MOV	#"SY,N.DVNM(R3)	; NAME GIVEN-CHANGE DEFAULT TO "SY0:"
	CALL	.CSI2		; PARSE REAL OUTPUT NAME
	BCS	CS2OER		; OUTPUT SPEC ERROR
	MOVB	#CS.INP,(R0)	; SET UP TO DO INPUT NEXT
	MOV	#<CSIBLK+C.DSDS>,R2 ; GET DATA-SET-DESCRITOR ADDRESS
30$:	MOV	#LSTFDB,R0	; SET FILE-DESCRIPTOR-BLOCK
	MOV	#<LSTFDB+F.FNB>,R1 ; AND FILE-NAME-BLOCK FOR PARSE
	CALL	.PARSE		; ---AND PARSE IT!
	BCS	PARSER		; BR IF FAILED
	CALL	.OPFNB		; OPEN THE FILE
	BCC	40$		; BR IF A-OK
	FERR	OPNO		; FATAL OPEN ON OUTPUT FILE
40$:	BITB	#FD.REC,F.RCTL(R0) ; RECORD DEVICE?
	BEQ	50$		; BR IF NO
	JSR	R0,ATTDET	; TRY TO ATTACH
	.WORD	IO.ATT
50$:
	MOV	#CSIBLK,R0	; SET CSI BLOCK
	CALL	.CSI2		; GET COMMAND FOR UFD TO SORT
	BCS	CS2IER		; INPUT SPEC ERROR
	BITB	#CS.MOR,C.STAT(R0) ; CHECK FOR INVALID SYNTAX
	BNE	CMDERR		; BR IF THERE
	BITB	#CS.NMF,C.STAT(R0) ; WAS A NAME FIELD SPECFIED?
	BEQ	SETUP		; BR IF NO-NO IMPLIED SELECT FIELD
	MOV	C.FILD+2(R0),R1	; GET STRING ADDRESS
	MOV	C.FILD(R0),R0	; NOW LENGTH
	CLR	C.FILD+CSIBLK	; DONT LET PARSE SEE NAME
	MOV	#SEBUF$,R2	; STRING BUFFER ADDRESS
	BIT	#SESW,SWMSK$	; WAS SELECT SW SPECIFIED?
	BEQ	55$		; BR IF NO-NAME IS IMPLIED SELECT
	TSTB	(R2)		; WAS A STRING GIVEN?
	BNE	CS1ERR		; 2 SELECT STRINGS IS A COMMAND ERROR
55$:	BIS	#SESW,SWMSK$	; EFFECT A SELECT
60$:
	.IF DF	WILD$		; IF INSERTING WILD CARD MATCHING CHARACTERS
	CMPB	#'.,(R1)	; IS A PERIOD NEXT?
	BNE	65$		; BR IF NO
	BIT	#<DESW!SDSW>,SWMSK$  ; IS THIS A DELETE OPERATION?
	BNE	65$		; BR IF YES
	MOVB	#'*,(R2)+	; INSERT A WILD CARD IN FRONT OF PERIOD
	.ENDC
65$:	MOVB	(R1)+,(R2)+	; COPY A BYTE
	DEC	R0		; MOVE ENTIRE STRING?
	BLE	70$		; BR IF YES
	CMP	R2,#SEBUF$+19.	; RUN OUT OF SPACE?
	BLO	60$		; IF NO-LOOP AGAIN
70$:
	.IF DF	WILD$		; IF INSERTING WILD CARD MATCHING CHARACTERS
	BIT	#<DESW!SDSW>,SWMSK$  ; IS THIS A DELETE OPERATION?
	BNE	75$		; BR IF YES
	MOVB	#'*,(R2)+	; INSERT A WILD CARD AT END OF STRING
	.ENDC
75$:	CLRB	(R2)		; SET SENTINEL FOR STRING END
SETUP:
	BIT	#SESW,SWMSK$	; USER SPECIFY /SE:?
	BEQ	2$		; NO -- SKIP
	MOV	#SEBUF$,R0	; POINT TO THE /SE: SWITCH VALUE.
	CLR	R1		; NO PERIOD FOUND YET
1$:	CMPB	#'.,(R0)	; IS THIS BYTE A PERIOD?
	BNE	40$		; BR IF NO
	INC	R1		; FLAG THAT A PERIOD HAS BEEN FOUND
40$:	TSTB	(R0)+		; LOOK FOR NULL TERMINATOR
	BNE	1$		; NOT THERE YET--KEEP LOOKING
	TSTB	-(R0)		; BACK UP TO NULL TERMINATOR
	TSTB	-(R0)		; BACK UP TO LAST BYTE IN STRING
	CMPB	#'*,(R0)+	; IS LAST BYTE A WILD CARD?
	BEQ	50$		; BR IF YES
	TST	R1		; WAS A PERIOD FOUND IN STRING?
	BNE	50$		; BR IF YES
	MOVB	#'.,(R0)+	; INSERT A PERIOD AT END OF STRING
50$:	MOVB	#';,(R0)	; TERMINATE STRING WITH A ';'
2$:	MOV	#LINSZ$,R0	; POINT AT LINE SIZE SW VALUE
	TST	(R0)		; DID USER SPECIFY VALUE?
	BNE	5$		; BR IF YES!
	MOV	LSTFDB+F.BBFS,(R0) ; SET DEVICE BUFFER SIZE FOR LINE SIZE
5$:	CMP	(R0),#72.	; CK LINE SIZE AGAINST MIN
	BHIS	10$		; BR IF SIZE OK
	MOV	#72.,(R0)	; SET ACCEPTABLE VALUE
10$:	CMP	(R0),#132.	; NOW CK AGAINST MAX
	BLOS	20$		; BR IF OK
	MOV	#132.,(R0)	; SET ACCEPTABLE LINE SIZE
20$:
LST1:
	MOV	#DATIM$,R0	; POINT AT DATE BUFFER
	MOV	#HDBUF$,R1	; SCRATCH AREA
	GTIM$S	R1		; FIND THE TIME
	CALL	$DAT		; CONVERT DATE TO NORMAL FORM
10$:	MOVB	#40,(R0)+	; SEPARATE DATEAND TIME
	BIT	#1,R0		; SET ON EVEN WORD BOUNDRY
	BNE	10$		; BR IF NO-MAKE IT EVEN
	MOV	#2,R2		; SET TO CONVERT HR,MIN
	CALL	$TIM		; AND CONVERT THE TIME
	BIT	#DASW,SWMSK$	; DATE SELECT
	BEQ	30$		; BR IF NO
	MOV	#DABUF$,R1	; SET TO POINT AT /AF OR /DA SWITCH BUFFER
	CALL	DACONV		; GET INTEGER DATE (TODAY OR USER SUPPLIED)
	MOV	R2,DABUF$	; SAVE INTEGER /AF OR /DA DATE FOR MATCHING
	MOV	#BEBUF$,R1	; SET TO POINT AT /BE SWITCH BUFFER
	CALL	DACONV		; GET INTEGER DATE (TODAY OR USER SUPPLIED)
	MOV	R2,BEBUF$	; SAVE INTEGER /BE DATE FOR LATER MATCHING
30$:
	BITB	#CS.WLD,C.STAT+CSIBLK ; ANY WILD CARDS AROUND HERE?
	BEQ	OPN1		; BR IF NO!
	MOV	C.DIRD+2+CSIBLK,R3 ; GET ADDRESS OF DIRECTORY STRING
	MOV	C.DIRD+CSIBLK,R0 ; NOW LENGTH
	BEQ	OPN1		; BR IF NO DIRECTORY STRING
40$:	DEC	R0		; COUNT DOWN NUMBER CHARS TO SCAN
	BMI	OPN1		; BR IF DIDN'T FIND WILD CARD FLAG
	CMPB	(R3)+,#'*	; IS THAT A WILD CARD FLAG?
	BNE	40$		; BR IF NO
	INC	NXUIC$		; SET UIC TO START AT 1
	MOV	C.DIRD+2+CSIBLK,R3 ; POINT AT DIRECTORY DESC.
	CLR	WCGRP$		; ASSUME WILD GROUP
	INC	R3		; SKIP [
	CMPB	#'*,(R3)+	; IS IT WILD?
	BEQ	70$		; BR IF YES
60$:	CMPB	#',,(R3)+	; LOOK FOR END OF NUMBER
	BNE	60$		; BR IF NOT FOUND
	MOV	R3,R1		; COPY START OF USER NUMBER
	DEC	R1		; BACK UP TO COMMA
	MOV	#'[,R2		; SET OTHER END OF FIELD
	CALL	GETUIC		; CONVERT TO RAD50
	MOV	R1,WCGRP$	; SAVE SELECTED GROUP
70$:	CMPB	#'],(R3)+	; LOOK FOR END OF USER NUMBER
	BNE	70$		; BR IF NOT FOUND
	CLR	WCUSR$		; ASSUME WILD CARD USER
	MOV	R3,R1		; COPY PLACE IN STRING
	CMPB	-(R1),-(R1)	; BACK UP TO LAST DIGIT IN NUMBER
	CMPB	#'*,(R1)+	; IS IT WILD
	BEQ	80$		; BR IF YES
	MOV	#<',>,R2	; SET END OF FIELD
	CALL	GETUIC		; CONV TO RAD50 FORM
	MOV	R1,WCUSR$	; SAVE THAT CODE
80$:	MOV	#LSTNX$,(SP)	; SET RETURN ADDRESS
OPN1:	MOV	#UFDFDB,R0	; GET FDB
	MOV	#<UFDFDB+F.FNB>,R1 ; FILE NAME BLOCK
	MOV	#<CSIBLK+C.DSDS>,R2 ; DATA SET DESCRIPTOR
	MOV	#DFNB,R3	; DEFAULT NAME BLOCK
	TST	NXUIC$		; DOING WILD CARD OPERATION?
	BEQ	10$		; BR IF NO
	CALL	.PRSDV		; PARSE DEVICE ONLY
	BCC	INIEX		; EXIT INIT IF OK
	FERR	PRSE		; INDICATE ERROR
10$:
	CALL	.PARSE		;
	BCC	SRTDIR		; BR IF OK
;
	FERR	DIRF		; DIRECRORY FIND ERR
;
SRTDIR:
;
;  DIRECTORY FIND WAS SUCCESSFUL
;
	MOV	N.DID(R1),N.FID(R1) ; COPY DIRECTORY I.D.
	CLR	N.DID(R1)	; REMOVE DIRECTORY ID
	MOV	N.DID+2(R1),N.FID+2(R1) ; TO FILE ID SPACE
	MOV	N.DID+4(R1),N.FID+4(R1) ; JUST FOR "GRINS", THIS TOO!
	MOVB	#FO.RD!FA.SHR,F.FACC(R0) ; ASSUME READ ACCESS
	TSTB	SWMSK$		; DOES HE WANT IT WRITTEN BACK?
	BPL	5$		; BR IF NO
	MOVB	#FO.MFY,F.FACC(R0) ; REQUEST ACCESS OF FILE FOR MODIFY
5$:
	MOV	#<UFDFDB+F.FNB+N.FID>,READHD+Q.IOPL ; SET FID FOR HEADER READ
	DIR$	#READHD		; REQUEST THE READ
	BCC	20$		; BR IF AOK
	CALL	$ALERR		; DIAGNOS ERR
	BR	5$		; RETRY IF THAT IS POSIBLE
20$:	WTSE$S	#EFN1		; WAIT FOR THAT TO STOP
	MOVB	HDBUF$+1,R1	; GET OFFSET TO IDENT AREA
	ADD	#I.FNAM,R1	; POINT AT FILE NAME
	ADD	#HDBUF$,R1	; ADD IN OFFSER FOR BUFFER
	MOV	(R1)+,F.FNAM(R0) ; SET TOP 1/2 OF DIRECTORY NAME
	MOV	(R1),F.FNAM+2(R0) ; -AND BOTTOM 1/2
INIEX:				; INITIALIZER EXIT POINT
	RETURN
;
; GETUIC---LOCAL SUBROUTINE TO CONVERT A 1 TO 3 BYTE NUMERIC STRING
; 	INTO 3 RADIX 50 CHAR FORMAT CONSISTANT WITH DIRECTORY NAMES

GETUIC:	MOV	#UICS$,R0	; POINT AT 4 BYTE STRING BUFFER
	MOV	#"00,(R0)+	; ASSUME LEADING ZEROS NEEDED
	CLRB	(R0)+		; ADVANCE PONTER
10$:	CMPB	-(R1),R2	; IS THIS TERMINAL CHAR?
	BEQ	20$		; BR IF YES
	MOVB	(R1),-(R0)	; NO-SET DATA INTO STRING
	BR	10$		; TRY AGAIN
20$:	MOV	#UICS$,R0	; RESET POINTER
	CALL	$CAT5		; CONVERT TO RAD50
	RETURN
;
; DACONV---LOCAL SUBROUTINE TO GET INTEGER DATE TO USE (TODAY OR USER SUPPLIED)
;	INPUT:	  R1 - THE ADDRESS OF THE ASCII DATE BUFFER
;	OUTPUT:   R2 - INTEGER DATE VALUE
;
DACONV:
	TST	(R1)		; ANY DATE SUPPLIED?
	BNE	20$		; BR IF YES-USE USER SUPPLIED DATE
	MOV	#DATIM$,R1	; IF NON SUPPLIED-USE TODAY!
	BISB	#'0,(R1)	; FIRST CHARACTER MUST BE NUMERIC HLC002
20$:	CALL	CNVDAT		; CHANGE TO INTEGER FORMAT
	RETURN
	.END