.TITLE	SRDSUB---SORT DIRECTORY SUBROUTINES
	.IDENT	-6.8-		; Nov-99
	.ENABL	LC
;
;  MODIFICATIONS:
;
;	CEF001 -- 1-June-83
;		ADD .PSECTS
;		MOVE data to front of code into SRDMON psect
;
;
;	VERSION 6.4 - 07-Nov-83		(;BT003)
;
;		Bob Turkelson
;		SRD Working Group
;
;		When the date stored in the file header is corrupt, issue a
;		  non-fatal diagnostic message.  (Previously the same fatal
;		  message was issued for this situation as was given for when
;		  an invalid date was specified in the command line.)
;		Do not "CLR (R1)" before returning from SRDCOM (SRDSUB).  This
;		  instruction is no longer necessary.  It caused a memory
;		  protection violation problem when compressing a dense
;		  directory whose length was six or more blocks if SRD was
;		  built to use the extend task directive, and the end of the
;		  SRDLST overlay section ($$$XX3) happened to be on a 64-byte
;		  boundary, or two bytes before such a boundary (that is, with
;		  address ending in 00 or 76).
;
;
;	VERSION 6.5 - 16-Jan-85		(;WG001)
;
;		SRD Working Group
;
;		In the CVDATE routine (in SRDSUB), skip over the first
;		  byte of the date field if it is blank.  When
;		  VMS BACKUP/IMAGE restores a Structure 1 disk, a file
;		  date with a single digit day of month is stored in
;		  the file header with a blank preceding the digit,
;		  rather than a zero character as is done in RSX.
;		  (For example, " 4OCT84" rather than "04OCT84".)
;
;	VERSION 6.6 - 27-Jan-97
;
;		Johnny Billquist
;
;		Added support for the next millenium.
;
;	VERSION 6.8 - 18-Nov-99
;
;		Johnny Billquist
;
;		Changed support to conform to M+ V4.6
;
;=
;
	.MCALL	DIR$
;+
; ATTDET---ATTACH/DETACH LISTING DEVICE
;
; THIS ROTINE IS CALLED TO ATTACH OR DETACH THE LISTING DEVICE
; IF THE DEVICE IS RECORD ORIENTED
;-
	.PSECT	SRDMON,RW,D,LCL,REL,CON                                         ;CEF001
	.NLIST	BEX                                                             ;CEF001
MONTHS:	.ASCII	\JAN\<-1>\FEB\<-1>\MAR\<-1>\APR\<-1>\MAY\<-1>\JUN\<-1>          ;C
	.ASCII	\JUL\<-1>\AUG\<-1>\SEP\<-1>\OCT\<-1>\NOV\<-1>\DEC\<-1>          ;CEF001
	.LIST	BEX                                                             ;CEF001
	.BYTE	0                                                               ;CEF001
BLKPOS:	.BYTE				; POSITION OF FIRST SPACE               ;CEF001
COLPOS:	.BYTE				; POSITION OF FIRST COLON               ;CEF001
	.EVEN                                                                   ;CEF001
	.PSECT	SRDCOD,I,RO,LCL,REL,CON                                         ;CEF001
;                                                                               ;
ATTDET::MOV	(R0)+,LSTQIO+2	; SET FUNCTION
10$:	DIR$	#LSTQIO		; ISSUE REQUEST
	BCC	20$		; BR IF A-OK
	CALL	ALERR		; DIAGNOS ERR
	BR	10$		; RETRY IF RETRYABLE
20$:	RTS	R0		; RETURN
;+
; SRDCOM --- COMPRESS DIRECTORY BUFFER.
;
;	R1 -> END OF DIRECTORY BUFFER
;	R2 -> BEGINNING OF DIRECTORY BUFFER
;	R3, R4, R5 ARE DESTROYED
;
;	DUKE001 -- 19-NOV-79,-5.0-, HENRY R. TUMBLIN
;		ADDED AS A SUBROUTINE
;	Modified by PASP to compress 'in order' so as not to screw
;	up a /-SR listing.
;-
SRDCOM::
	MOV	R2,R3		; COPY THAT FOR SORT
	MOV	R2,R4		; Twice
;
10$:
	CMP	R3,R1		; Finished?
	BHIS	40$		; If HIS yes - exit
	TST	(R3)		; SEE IF OCCUPIED
	BNE	20$		; BR IF YES
	ADD	#D.SIZ,R3	; No - set to next
	BR	10$		; And try again
;
20$:
	MOV	#<D.SIZ/2>,R5	; SET DIRECTORY SIZE IN WORDS
;
30$:
	MOV	(R3)+,(R4)+	; FILL IN HOLE WITH NEXT PROPER ENTRY
	SOB	R5,30$		; DO ENTIRE ENTRY
	BR	10$		; Check the next one
;
40$:
	MOV	R4,R3		; Get furthest we've used so far
;
50$:
	CMP	R3,R1		; Used the lot?
	BHIS	60$		; If HIS yes
	CLR	(R3)		; No - clear this one
	ADD	#D.SIZ,R3	; Set to next entry
	BR	50$		; And try next one
;
60$:
	MOV	R4,R1		; Update end of directory pointer
;	Removed "CLR (R1)" instruction to avoid memory protection violation     ;BT003
	RETURN			; AND RETURN TO THE CALLER.
;+
; CNVDAT---CONVERT DATE FROM STRING TO MONOTONICALLY INCREASING
; 	BINARY INTEGER.
;
; In:  R1 -> Source string.
;
; Out: R2 - Year
;      R3 - Month/Date
;      R4 - Time
;-
;
CNVDAT::
	CLC			; Clear C-bit                                   ;BT003
	MOV	R0,-(SP)	; SAVE R0
	MOV	R1,-(SP)	; SAVE R1
	MOV	#18.,R0		; GET LENGTH OF STRING TO CHECK
	ADD	R0,R1		; SET R1 PAST END OF STRING
	MOVB	#19.,BLKPOS	; INITIALISE OFFSETS
	CLRB	COLPOS		;
;
10$:
	CMPB	-(R1),#''	; FOUND A QUOTE?
	BNE	20$		; IF NE NO - LOOK FOR HASH
	MOVB	R0,BLKPOS	; YES - STORE THE OFFSET
	BR	30$		; Can't be a colon at the same place.
;
20$:
	CMPB	(R1),#'#	; FOUND A HASH?
	BNE	30$		; IF NE NO - FINISH LOOP
21$:	MOVB	R0,COLPOS	; YES - STORE OFFSET
;
30$:
	SOB	R0,10$		; CHECK NEXT CHAR
	TSTB	COLPOS		; ANY TIME SPECIFIED?
	BNE	40$		; IF NE YES - CARRY ON
	CALL	CVDATE		; NO - CONVERT THE DATE
	BCS	80$		; CS - return with CS                           ;BT003
	CLR	R4		; AND SHOW NO TIME
	BR	80$		; AND EXIT
;
40$:
	CMPB	BLKPOS,COLPOS	; DATE OR TIME FIRST?
	BLT	60$		; IF LT THE DATE
	CALL	CVTIME		; ELSE CONVERT THE TIME
	MOVB	BLKPOS,R1	; GET THE BLANKS OFFSET
	ADD	(SP),R1		; INITIALISE THE ADDRESS OF THE DATE
	CMPB	BLKPOS,#19.	; NO DATE?
	BNE	50$		; OK WE HAVE ONE
	MOV	#TDBUF$,R1	; RESET TO TODAY
;
50$:
	CALL	CVDATE		; CONVERT THE DATE
	BR	80$		; Return (with either CC or CS)                 ;BT003
;
60$:
	CALL	CVDATE		; CONVERT THE DATE FIRST
	MOVB	BLKPOS,R1	; GET ADDRESS OF TIME
	ADD	(SP),R1		;
	CALL	CVTIME		; AND CONVERT THAT
;
80$:
	MOV	(SP)+,R1	; RESTORE R1
	MOV	(SP)+,R0	; RESTORE R0
	RETURN			; AND EXIT
;
; Convert a normal ascii date into a binary value.
;
; In: R1 - Pointer to string.
;
; Out: R1 - Pointer after string.
;      R2 - Year
;      R3 - Month/Date
;
CVDATE::
	CLC			; Clear C-bit                                   ;BT003
	MOV	R0,-(SP)	; Save registers.
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	CALL	CNV2		; CONVERT TO BINARY
	MOV	R2,R3		; Check result.
	BEQ	50$		; MUST BE SOMETING
	CMPB	#'-,(R1)+	; SKIP SEPARATOR
	BEQ	10$		; BR IF SEPARATOR
	DEC	R1		; BACK UP
10$:	MOV	#MONTHS,R4	; LIST OF ALL MONTHS
20$:	MOV	R1,R2		; COPY ADDRESS OF MONTH NAME
30$:	CMPB	(R2)+,(R4)+	; SAME?
	BEQ	30$		; BR AS LONG AS YES
	TSTB	-1(R4)		; END OF MONTH
	BMI	60$		; YES-FOUND IT
	ADD	#32.,R3		; NO ADD IN A MONTH'S WORTH OF DAYS
40$:	TSTB	(R4)+		; LOOK FOR NEXT MONTH
	BGT	40$		; BR IF NOT END
	TSTB	(R4)		; END OF LIST?
	BNE	20$		; BR IF NO
50$:	SEC			; Set C-bit to indicate bad date format         ;BT003
	BR	80$		; Return with CS                                ;BT003
60$:
	MOV	R2,R1		; COPY PLACE IN INPUT STRING
	CMPB	-(R1),#'-	; SEPARATOR?
	BNE	70$		;
	INC	R1		; BACK UP
70$:	MOV	R1,R0		; Setup to convert year.
	CALL	$CDTB		; GET YEAR
	MOV	R1,R2		; Save result.
	MOV	R0,R1		; Save new pointer.
	.if df	m$$p46
	CMP	R2,#$Y2KHI	; Are we in this century?
	.iff
	CMP	R2,#65.
	.endc
	BHIS	71$		; Yes.
	ADD	#100.,R2	; No. Y2K then...
	BR	79$		; Done.
71$:	CMP	R2,#100.	; Hmmm, are we on two digits?
	BLT	79$		; No...
	SUB	#1900.,R2	; Make into normal.
	BGE	79$		; Ok...
	SEC			; Error.
	BR	80$
79$:	CLC			; It worked...
80$:	MOV	(SP)+,R5	; Restore registers.
	MOV	(SP)+,R4
	MOV	(SP)+,R0
	RETURN                                                                  ;BT0
;
; Convert a file ascii date into a binary value.
;
; In: R1 - Pointer to string.
;
; Out: R1 - Pointer after string.
;      R2 - Year
;      R3 - Month/Date
;
CVFDAT::
	CLC			; Clear C-bit                                   ;BT003
	MOV	R0,-(SP)	; Save registers.
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	CMPB	#<' >,(R1)	; Is first byte of date field a blank?          ;WG001
	BNE	5$		; NE - no                                       ;WG001
	INC	R1		; Skip over the blank                           ;WG001
5$:                                                                             ;
	CALL	CNV2		; CONVERT TO BINARY
	MOV	R2,R3		; Check result.
	BEQ	50$		; MUST BE SOMETING
	MOV	#MONTHS,R4	; LIST OF ALL MONTHS
20$:	MOV	R1,R2		; COPY ADDRESS OF MONTH NAME
30$:	CMPB	(R2)+,(R4)+	; SAME?
	BEQ	30$		; BR AS LONG AS YES
	TSTB	-1(R4)		; END OF MONTH
	BMI	60$		; YES-FOUND IT
	ADD	#32.,R3		; NO ADD IN A MONTH'S WORTH OF DAYS
40$:	TSTB	(R4)+		; LOOK FOR NEXT MONTH
	BGT	40$		; BR IF NOT END
	TSTB	(R4)		; END OF LIST?
	BNE	20$		; BR IF NO
50$:	SEC			; Set C-bit to indicate bad date format         ;BT003
	BR	80$		; Return with CS                                ;BT003
60$:
	MOV	R2,R1		; COPY PLACE IN INPUT STRING
	DEC	R1
	MOVB	(R1)+,R2	; Get first char of year.
	SUB	#'0,R2		; Make into binary.
	CLR	-(SP)
	MOVB	(R1)+,(SP)	; Get next char.
	SUB	#'0,(SP)	; Make into binary.
	ASL	R2		; Add binary values up.
	ADD	R2,(SP)
	ASL	R2
	ASL	R2
	ADD	(SP)+,R2
80$:	MOV	(SP)+,R5	; Restore registers.
	MOV	(SP)+,R4
	MOV	(SP)+,R0
	RETURN                                                                  ;BT0
;
; Convert time into binary.
;
; In: R1 - Pointer to string.
;
; Out: R1 - Pointer after string.
;      R4 - Binary time.
;
CVTIME::
	MOV	R2,-(SP)	; SAVE R2
	MOV	R5,-(SP)	; SAVE R5
	CALL	CNV2		; CONVERT FIRST TWO
	MOV	R2,R4		; SAVE THEM
	ASH	#6,R4		; MULTIPLY BY 64.
	CMPB	(R1)+,#'#	; DIVIDER?
	BEQ	10$		; IF EQ YES
	DEC	R1		; NO - DISCOUNT IT
;
10$:
	CALL	CNV2		; GET THE NEXT TWO
	ADD	R2,R4		; ADD THEM IN
	MOV	(SP)+,R5	; RESTORE REGISTERS
	MOV	(SP)+,R2	;
	RETURN
;
; Convert two ascii digits into number.
;
; In: R1 - String pointer
;
; Out: R2 - Binary value.
;
CNV2:	CLR	R2		; INIT ACCUMULATOR
	MOV	#2,R5		; SET MAX CHARS TO CONVERT
10$:	CMPB	(R1),#'0	; CHECK FOR RANGE
	BLO	20$		; BR IF OUT
	CMPB	(R1),#'9	; CHECK OTHER END
	BHI	20$		; BR IF OUT
	CLR	-(SP)		; GET A ZERO
	MOVB	(R1)+,(SP)	; GET THE VALUE
	SUB	#'0,(SP)	; REMOVE ASCII BIAS
	ASL	R2		; MULT PREVIOUS
	ADD	R2,(SP)		; SAVE TIME 2 RESULT
	ASL	R2		; X 4
	ASL	R2		; X 8
	ADD	(SP)+,R2	; FINAL RESULT OLD X 10 + NEW
	SOB	R5,10$		; LOOP?
20$:	RETURN
;
ALERR::
$ALERR::
	MOV	(SP),R0		;
	MOV	$DSW,R1		;
	HALT			;
	RETURN			;
;
	.IF NDF	m$$p46
;
; Do the same job that $DAT does, except handle Y2K gracefully.
; (we'll just print four digits...)
;
$MYDAT::
	JSR	R5,.SAVR1
	MOV	4(R1),R2	; Get date.
	MOV	R1,-(SP)	; Save pointer.
	MOV	R2,R1		; Move date into R1.
	MOV	#010012,R2	; Format...
	CALL	$CBTA
	MOV	(SP),R1		; Get pointer.
	MOV	2(R1),R2	; Get month.
	DEC	R2		; Offset 0.
	ASL	R2		; Multiply by 4.
	ASL	R2
	MOVB	#'-,(R0)+	; Setup text...
	MOVB	MONTHS(R2),(R0)+
	INC	R2
	MOVB	MONTHS(R2),(R0)+
	INC	R2
	MOVB	MONTHS(R2),(R0)+
	MOVB	#'-,(R0)+
	MOV	(SP)+,R1	; Get pointer.
	MOV	(R1),R1		; Get year.
	ADD	#1900.,R1	; Make into four digits...
	MOV	#020012,R2	; Conversion...
	JMP	$CBTA
;
	.ENDC
;
	.END