.TITLE	DIRCDI - CONVERT DATE TO INTEGER
	.IDENT	/1APR82/
	.ENABL	GBL
;
;+
;******
;
;	DIRCDI.MAC - CONVERTS ASCII DATE FORMAT INTO
;	 # DAYS SINCE BASE YEAR 1969, OR CONVERTS # DAYS SINCE 1969 INTO
;	 COMPRESSED ASCII DATA FORMAT.  DATE FORMAT = DDMMMYY, DD AND
;	 YY = 2 DIGIT ASCII #'S, MMM = 3 CHARACTER MONTH.
;	 SINGLE ASCII DELIMITERS ARE OPTIONAL BETWEEN DAY, MONTH AND YEAR
;	 STRINGS (MUST BE NON-ALPHANUMERIC CHARACTERS), E.G. 23-APR-74,
;	 23APR-74, 23'APR"74 AND 23APR74 ARE ALL VALID STRINGS.
;
;
;	SORENSON, 4/1/82
;
;*****
;
;	UPDATE 4/1/82 -- PRS; ORIGINAL EDIT
;
;*****
;-
;
;	LOCAL SYMBOLS
;
	BASEYR	= 69.		;BASE YEAR FOR ALGORITHM = ANY LEAP YEAR +1
	DAY4YR	= 1461.		;DAYS IN 4 YRS
	DAY1YR	= 365.		;DAYS IN 1 YR
;
;	LOCAL DATA
;
	.PSECT	$IDATA,RW,D,LCL,CON,REL
BUF:
DATE:	.BLKW	4			;INTEGER ACCUMULATOR/BUFFER FOR ASCII
					; DATE

	.NLIST	BEX
MONTHS:
	.ASCII	/JAN/<31.>/FEB/
FEB:	.BYTE	28.			;# DAYS IN FEBRUARY
	.ASCII	/MAR/<31.>/APR/<30.>/MAY/<31.>/JUN/<30.>/JUL/<31.>/AUG/<31.>
	.ASCII	/SEP/<30.>/OCT/<31.>/NOV/<30.>/DEC/<31.>
	.EVEN
;
;*****
;
;	.DRCDI -- ENTRY POINT FOR CONVERSION OF ASCII STRING TO INTEGER
;		CALL WITH R0 POINTING TO BUFFER CONTAINING ASCII DATE,
;		INTEGER EQUIVALENT OF DATE RETURNED IN R1
;
;*****
;
	.PSECT	$CODE1,RO,I,LCL,CON,REL	
.DRCDI::				;MACRO ENTRY POINT
	MOV	R0,-(SP)		;SAVE REGISTERS 
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	CALL	C2ATB			;CONVERT 2 DIGIT DAY TO BINARY
	BCC	10$			;BRANCH ON SUCCESS
	BR	45$			;EXIT WITH FAILURE
10$:
	MOV	R1,DATE			;SAVE DATE COUNT
	MOV	R0,R3			;COPY CURRENT POINTER
	ADD	#3,R0			;STEP R0 TO YEAR FIELD
	CALL	C2ATB			;CONVERT YEAR TO BINARY
	BCC	15$			;BRANCH ON SUCCESS
	CALL	C2ATB			;TRY AGAIN, MAY HAVE BEEN "-YY"
	BCS	45$			;EXIT ON FAILURE
15$:
	MOV	R3,R0			;RECOVER POINTER TO MONTH
	BIT	#3,R1			;CHECK BOTTOM 2 BITS OF YEAR
	BEQ	19$			;BRANCH IF 0, IN LEAP YEAR
	MOVB	#28.,FEB		;SET 28 DAYS IN FEB
	BR	20$
19$:	MOVB	#29.,FEB		;SET 29 DAYS IN FEB
20$:
	SUB	#BASEYR,R1		;SUB OUT BASE YEAR
	BGT	25$			;BRANCH IF VALID YEAR
	BEQ	30$			;BRANCH IF IN BASE YEAR
	BR	45$			;EXIT WITH FAILURE
25$:
	MOV	R1,R2			;COPY YEAR
	ASR	R1			;DIVIDE YEAR BY 4
	ASR	R1
	BEQ	27$			;BRANCH IF 0
	MUL	#DAY4YR,R1		;GET DAYS IN 4 YR BLOCKS
	ADD	R1,DATE			;ADD IT TO ACCUMULATOR
27$:	MOV	R2,R1			;RECOVER YEAR
	BIC	#177774,R1		;GRAB BOTTOM 2 BITS
	BEQ	30$			;BRANCH IF 0
	MUL	#DAY1YR,R1		;GET DAYS IN 1 YR BLOCKS
	ADD	R1,DATE			;ADD IT TO ACCUMULATOR
30$:
	MOV	#MONTHS,R3		;FETCH ADDRESS OF MONTHS
	MOV	#12.,R4			;12 MONTHS / YEAR
32$:	MOV	R0,R1			;COPY POINTER
	MOV	#3,R2			;MATCH 3 CHARACTERS
35$:	CMPB	(R1)+,(R3)+		;CHECK DATE STRING
	BNE	40$			;BRANCH ON MISMATCH
	SOB	R2,35$
	MOV	DATE,R1			;RECOVER DATE
	DEC	R1			;ADJUST # TO DAYS SINCE 1-JAN-BASEYR
	CLC				;SHOW SUCCESS
	BR	50$			; AND EXIT
40$:
	MOVB	(R3)+,R1		;STEP R3 TO NEXT MONTH
	SOB	R2,40$
	ADD	R1,DATE			;ADD # DATES IN MONTH
	SOB	R4,32$			;CONTINUE WITH NEXT MONTH
45$:
	SEC				;ERROR TRAP 
50$:
	MOV	(SP)+,R4		;RESTORE REGISTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN				;RETURN TO CALLER
;
;*****
;
;	.DRCID -- MACRO ENTRY POINT TO CONVERT INTEGER TO ASCII DATE STRING.
;		CALL WITH R0 POINTING TO DESTINATION BUFFER FOR ASCII DATE,
;		R1 = INTEGER TO CONVERT
;
;*****
;
.DRCID::
	MOV	R0,-(SP)		;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R1,R3			;COPY INTEGER
	BLT	45$			;BRANCH ON BAD #
	CLR	R2			;CLEAR HI WORD
	DIV	#DAY4YR,R2		;DIVIDE BY # DAYS IN 4 YR BLOCKS
	ASL	R2			;MULTIPLY RESULT BY 4
	ASL	R2
	MOV	R2,R1			;SAVE IT
	CLR	R2			;CLEAR HI WORD
	DIV	#DAY1YR,R2		;DIVIDE BY # DAYS IN 1 YR BLOCKS
	CMP	R2,#3			;CHECK RESULT, MAYBE IN LEAP YEAR
	BEQ	17$			;BRANCH IF YES
	BGT	15$			;BRANCH IF ON 31-DEC IN LEAP YEAR
	ADD	R2,R1			;NO, ADD TO PREVIOUS YEAR COUNT
	MOVB	#28.,FEB		;SET 28 DAYS IN FEB
	BR	20$
15$:	
	MOV	#DAY1YR,R3		;RESET R3 TO # DAYS SINCE 1-JAN
17$:	MOVB	#29.,FEB		;SET 29 DAYS IN FEB
	ADD	#3,R1			;ADD IN 3 YEARS TO YEAR COUNT
20$:
	INC	R3			;ADJUST REMAINDER FOR DAY/MONTH
	ADD	#BASEYR,R1		;ADD IN BASE YEAR
	MOV	#BUF+5,R0		;FETCH PLACE FOR 2 DIGIT YEAR STRING
	MOV	#11012,R2		;SETUP CONVERSION PARAMETERS
	CALL	$CBTA			;CONVERT YEAR TO ASCII
	MOV	#MONTHS,R1		;FETCH ADDRESS OF MONTHS IN YEAR
25$:	MOV	#BUF+2,R0		;FETCH PLACE FOR MONTH STRING
	MOV	R3,R2			;RECOVER REMAINDER
	MOVB	(R1)+,(R0)+		;COPY MONTH
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,R0		;FETCH # DAYS IN MONTH
	SUB	R0,R2			;ADJUST DAYS LEFT
	BLE	30$			;BRANCH WHEN HIT RIGHT MONTH
	MOV	R2,R3			;SAVE REMAINDER
	BR	25$			;LOOP TIL DONE
30$:
	MOV	R3,R1			;RECOVER REMAINDER
	MOV	#BUF,R0			;FETCH PLACE TO PUT ASCII DATE
	MOV	#11012,R2		;SET CONVERSION PARAMETERS
	CALL	$CBTA			;CONVERT DATE
	MOV	6(SP),R0		;FETCH PLACE TO RETURN DATE TO FORTRAN
	MOV	#BUF,R1			;FETCH ADDRESS OF DATE
	MOV	#7,R2			;COPY 7 BYTES
35$:	MOVB	(R1)+,(R0)+		;MOVE DATE STRING
	SOB	R2,35$
	CLC				;SHOW SUCCESS
	BR	50$
45$:
	SEC				;SHOW PROBLEM TO MACRO
50$:
	MOV	(SP)+,R3		;RECOVER REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN				;EXIT
;
;*****
;
;	LOCAL SUBROUTINE TO CONVERT 1 TO 2 DIGIT ASCII DECIMAL # TO
;	 UNSIGNED BINARY INTEGER.  NUMERIC STRING MUST END IN A NON-NUMERIC
;	 CHARACTER.  IF DELIMITER IS AN ALPHABETIC CHARACTER, R0 POINTER
;	 WILL BE RETURNED POINTING TO THE DELIMITER; IF NOT AND ALPHA
;	 CHARACTER, R0 POINTER WILL BE RETURNED POINTING PAST DELIMITER.
;
;	REGISTER USAGE:
;	 WHEN CALLED -
;		R0 - POINTS TO BYTE STRING
;		R1,R2 - DESTROYED
;	 ON SUCCESSFUL RETURN - CARRY BIT CLEAR
;		R0 - POINTS TO BYTE AFTER CONVERTED STRING (SEE ABOVE)
;		R1 - BINARY RESULT
;		R2 - DESTROYED
;
;	 ERROR  RETURN - CARRY BIT SET
;
;
;*****
;
C2ATB:
	MOVB	(R0)+,R1	;FETCH ASCII CHARACTER
	SUB	#60,R1		;STRIP OFF ASCII
	BLT	20$		;BRANCH ON BAD #
	CMP	R1,#9.		;CHECK UPPER LIMIT
	BGT	20$		;BRANCH ON BAD #
	MOVB	(R0),R2		;FETCH NEXT CHARACTER
	SUB	#60,R2		;STRIP OFF ASCII
	BLT	10$		;BRANCH ON DELIMITER
	CMPB	R2,#9.		;CHECK UPPER LIMIT
	BGT	10$		;BRANCH ON DELIMITER
	INC	R0		;HAVE 2 VALID BCD #'S IN R1,R2; POINT PAST #'S
	MOV	R2,-(SP)	;SAVE LSD
	ASL	R1		;MULTIPLY MSD BY 10
	ADD	R1,(SP)
	ASL	R1
	ASL	R1
	ADD	(SP)+,R1	;PUT RESULT IN R1
10$:
	MOVB	(R0)+,R2	;GRAB DELIMITER
	SUB	#101,R2		;STRIP OUT ASCII, LOOK FOR ALPHA CHARACTER
	BLT	15$		;BRANCH IF NOT ALPHA
	CMP	R2,#132		; > Z ?
	BGT	15$		;BRANCH IF YES
	DEC	R0		;RETURN POINTER POINTING AT ALPHA DELIMITER
15$:
	CLC			;SHOW SUCCESS
	RETURN
20$:
	SEC			;SHOW FAILURE
	RETURN
	.END	;.DRCDI