.TITLE D2CLNK
.IDENT /V1.0/
.SBTTL CONVERT SYSTEM DATE AND TIME TO CLUNKS
;
; CONVERTS SYSTEM DATE AND TIME TO CLUNKS
;
; LAST EDIT: 6-NOV-1987 12:06:53 
;
;	*** USE THE SAME CALLING SEQUENCE AS C2DATE...
;
;
;			--- AUTHORED BY ---
;
;			BOB ROCK
;			NORTHEAST ELECTRONICS DIV.
;			NORTHERN TELECOM INC.
;			AIRPORT RD.
;			CONCORD, N.H. 03301
;			(603) 224-6511 EXT 347
;
;	FORTRAN CALLABLE ROUTINE TO COVERT TO AND FROM
;	DATATRIEVE CLUNKS AND RSX-11 FORMAT TIME AND DATE
;
;		BY BOB ROCK	APR-81
;
;	BASIC PLUS-2
;		CALL C2DATE BY REF (CLUNKS%(),C.DATE$,C.TIME$,STATUS%)
;
;			CLUNKS% IS A 4 WORD INTEGER ARRAY
;			C.DATE$ MUST BE A 9 CHAR MIN. STRING
;			C.TIME$ MUST BE A 8 CHAR MIN. STRING
;			STATUS% RETURNS FOLLOWING RESULTS:
;				1 = SUCCESS
;				-1 = ERROR - DATE WAS PRIOR TO 1900
;				-2 = ERROR - DATE AFTER 1999
;                               -3 = ERROR - CLUNK OVERFLOW
;
;  NOTE:
;    FORMAT OF LONG WORDS IS LSW,...,MSW
;
;  THIS ROUTINE HAS BEEN MODIFIED BY PHILIP HANNAY, CARGILL GRAIN LAB,
;    3444 DIGHT AV S, MINNEAPOLIS, MN. 55407,  (612)-721-8531, FOR
;    OUR USE.  THE MODIFICATIONS ARE ACTUALLY CORRECTIONS, ONE
;    TO DETECT ILLEGAL CHARACTERS IN THE ASCII YEAR INPUT, THE OTHER
;    TO DO CORRECT DECIMAL TO BINARY CONVERSION OF THE MINUTES AND
;    SECONDS OF THE ASCII TIME INPUT.  JULY 6, 1982.  THIS ROUTINE
;    USES THE STANDARD DEC CALL SITE SO IT CAN BE CALLED BY FORTRAN OR
;    BY OMSI PASCAL V2.0 WITH NO CHANGES.
;
;  IT WAS FURTHER MODIFIED BY BOB THOMAS,CARGILL,INC.,P.O. BOX 9300
;    MPLS,MN,55440, (612)475-5432. THOSE FURTHER MODIFICATIONS
;    WERE TO CORRECT THE VALUES FOR 1 SEC, 1 MIN AND 1 HOUR. IN
;    ADDITION THE ADD64 ROUTINE WAS REWRITTEN TO PROVIDE FOR CASCADING 
;    CARRY BITS (SUCH AS THOSE THAT OCCUR ON 05-JUN-86 17:09:27).
;
;  PETER STADICK OCT-NOV '87 - BROKEN ROUTINES INTO SEPERATE MODULES
;    AND MODIFYIED TO ALLOW THEM TO BE BUILD INTO A SUPERVISOR MODE
;    LIBRARY. ALSO ADDED DEC CALL SITE TO ADD, SUBTRACT, MULTIPLY AND
;    DIVIDE ROUTINES SO THEY CAN BE CALLED FROM FORTRAN, PASCAL, ETC..
;    PETER STADICK, CARGILL INC, P.O. DRAWER AR, RESERVE,LA 70084
;    (504)-536-4111.
;
.PSECT CLUNK,RO,I,LCL,REL
D2CLNK::

	MOV R5,-(SP)		; SAVE ARG POINTER FOR LATER USE

	; CREATE STACK BUFFER SPACE
STKSIZ=190.	; NUMBER OF BYTES IN VARIABLE STACK FRAME
TEMP1=182.	; THESE VALUES ARE THE OFFSETS INTO THE STACK
TEMP2=174.	; WERE THE BUFFER CAN BE FOUND.
TEMP3=166.
CLUNKS=158.
BYEAR=156.
BMONTH=154.
BDAY=152.
BHOUR=150.
BMIN=148.
BSEC=146.
	MOV #0,R0		; CREATE FOUR 4 WORD BUFFERS 	
	MOV #22.,R1		; AND SIX 1 WORD BUFFERS
10$:	MOV R0,-(SP)		; ON STACK
	SOB R1, 10$

	; 28 DAYS IN A MONTH - 24,192,000,000,000 CLUNKS
DAY28=138.
	MOV #000000,-(SP)	; MSW
	MOV #013000,-(SP)
	MOV #121621,-(SP)
	MOV #000000,-(SP)	; LSW

	; 29 DAYS IN A MONTH - 25,056,000,000,000 CLUNKS
DAY29=130.
	MOV #000000,-(SP)	; MSW
	MOV #013311,-(SP)
	MOV #146722,-(SP)
	MOV #140000,-(SP)	; LSW

	; 30 DAYS IN A MONTH - 25,920,000,000,000 CLUNKS
DAY30=68.
	MOV #000000,-(SP)	; MSW
	MOV #013622,-(SP)
	MOV #174144,-(SP)
	MOV #100000,-(SP)	; LSW

	; 31 DAYS IN A MONTH - 26,787,000,000,000 CLUNKS
DAY31=60.
	MOV #000000,-(SP)	; MSW
	MOV #014134,-(SP)
	MOV #021316,-(SP)
	MOV #040000,-(SP)	; LSW

	; CREATE ASCII MONTH ABBREVIATION TABLE ON STACK
ASCMON=78.
	MOV #"EC,-(SP)
	MOV #"VD,-(SP)
	MOV #"NO,-(SP)
	MOV #"CT,-(SP)
	MOV #"PO,-(SP)
	MOV #"SE,-(SP)
	MOV #"UG,-(SP)
	MOV #"LA,-(SP)
	MOV #"JU,-(SP)
	MOV #"UN,-(SP)
	MOV #"YJ,-(SP)
	MOV #"MA,-(SP)
	MOV #"PR,-(SP)
	MOV #"RA,-(SP)
	MOV #"MA,-(SP)
	MOV #"EB,-(SP)
	MOV #"NF,-(SP)
	MOV #"JA,-(SP)

	; PUT DAYS IN MONTH BUFFER ON STACK
DAYMON=54.
	MOV #31.,-(SP)
	MOV #30.,-(SP)
	MOV #31.,-(SP)
	MOV #30.,-(SP)
	MOV #31.,-(SP)
	MOV #31.,-(SP)
	MOV #30.,-(SP)
	MOV #31.,-(SP)
	MOV #30.,-(SP)
	MOV #31.,-(SP)
	MOV #28.,-(SP)
	MOV #31.,-(SP)

	; CLUNKS PER MONTH TABLE
CLDAY=30.
	MOV SP,R0
	ADD #DAY31,R0
	MOV SP,R1
	ADD #DAY30,R1
	MOV R0,-(SP)		; DEC HAS 31 DAYS
	MOV R1,-(SP)		; NOV HAS 30 DAYS
	MOV R0,-(SP)		; OCT HAS 31 DAYS
	MOV R1,-(SP)		; SEP HAS 30 DAYS
	MOV R0,-(SP)		; AUG HAS 31 DAYS
	MOV R0,-(SP)		; JUL HAS 31 DAYS
	MOV R1,-(SP)		; JUN HAS 30 DAYS
	MOV R0,-(SP)		; MAY HAS 31 DAYS
	MOV R1,-(SP)		; APR HAS 30 DAYS
	MOV R0,-(SP)		; MAR HAS 31 DAYS
	MOV #0,-(SP)		; FEB-SET BY APPROPRIATE ROUTINE FOR LEAP YEAR
	MOV R0,-(SP)		; JAN HAS 31 DAYS

		;MAKE A LOCAL COPY OF DATE AND TIME

;	MOV 4(R5),R0
;	MOV #DATE,R1
;	MOV #9.,  R2
;10$:	MOVB (R0)+,(R1)+
;	SOB R2, 10$

DATE=20.
	MOV 4(R5),R0		; SAVE DATE IN BUFFER ON STACK
	MOV #5,R2
	ADD #9.,R0		; POINT TO END OF DATE
	INC R0
15$:	CLR R1
	MOVB -(R0),R1		; INSERT LOW BYTE
	SWAB R1
	BISB -(R0),R1		; INSERT HIGH BYTE
	MOV R1,-(SP)		; PUSH ON STACK
	SOB R2,15$
	MOVB #0,11(SP)		; MAKE SURE LAST CHARACTER IS A NULL

;	MOV 6(R5),R0	;GET POINTER TO TIME STRING
;	MOV #TIME,R1
;	MOV #8.,  R2
;20$:	MOVB (R0)+,(R1)+
;	SOB R2, 20$

TIME=10.
	MOV 6(R5),R0		; SAVE TIME IN BUFFER ON STACK
	MOV #4,R2
	ADD #8.,R0		; POINT TO END OF DATE
	MOV #0,-(SP)		; PUT IN TERMINATING NULL
20$:	CLR R1
	MOVB -(R0),R1		; INSERT LOW BYTE
	SWAB R1
	BISB -(R0),R1		; INSERT HIGH BYTE
	MOV R1,-(SP)		; PUSH ON STACK
	SOB R2,20$

	; GENERATE SUBROUTINE CALL SITE ON STACK
	MOV R0,-(SP)		; IDS VALUE LOCATION
	MOV SP,R0
	MOV R0,-(SP)		; ADDRESS OF IDS LOCATION
	MOV R0,-(SP)		; PARAMETER 1 SPACE
	MOV R0,-(SP)		; PARAMETER 2 SPACE
	MOV R0,-(SP)		; PARAMETER 3 SPACE
	MOV SP,R5		
	SUB #2,R5		; R5 NOW HAS ADDRESS OF CALL SITE 
				; PARAMETER BLOCK
	
		;CONVERT DAY TO BINARY

	MOV SP,R0
	ADD #DATE,R0		; ADJUST R0 TO POINT TO DATE BUFFER
;	MOV #DATE,R0
	CALL $CDTB
	MOV R1, BDAY(SP)	;R0 = ADDR OF NEXT BYTE
				;R1 = CONVERTED VALUE
				;R2 = TERMINATING CHAR
	TST R1
	BNE 25$			; A ZERO DAY IS NOT PERMITTED
	JMP ERRD2		; INDICATE ILLEGAL DATE
	

25$:	CMPB #'-,R2
	BEQ CMON		;NOTE - FORMAT IS DA-MON-YR
30$:	JMP ERRD1

		;CONVERT MONTH TO BINARY

CMON:				; R0 POINTING TO MONTH
	MOV SP,R1
	ADD #ASCMON,R1		;POINTER TO ASCII TABLE
	MOV #1,BMONTH(SP)	; ACTS AS A MONTH COUNTER

10$:	BICB #40,(R0)	;CONVERT TO UPPER CASE
	CMPB (R0),(R1)	;COMPARE MONTH TO TABLE...
	BNE 20$

	BICB #40,1(R0)
	CMPB 1(R0),1(R1)
	BNE 20$

	BICB #40,2(R0)
	CMPB 2(R0),2(R1)
	BEQ 50$			; A MATCH !!!

20$:	CMP #12.,BMONTH(SP)		;12TH MONTH YET?
	BNE 30$
	JMP ERRD1		; YES - FORMAT ERROR
	

30$:	ADD #3,R1		;POINT TO NEXT MONTH
	INC BMONTH(SP)
	BR 10$

50$:	CMPB #'-,3(R0)
	BEQ CYEAR
	JMP ERRD1

		; CONVERT YEARS TO BINARY

CYEAR:	ADD #4,R0
	CALL $CDTB
	MOV R1, BYEAR(SP)
;
; ADDED BY PHIL HANNAY TO TEST FOR PREMATURE CONVERSION TERMINATION
;
	CMPB #0,R2		;LOOK AT TERMINATION CHARACTER
	BEQ 2$			;BRANCH IF NULL CHARACTER AT END
	CMPB #32.,R2		;NOT NULL, MAYBE A BLANK
	BNE 3$			;BRANCH IF NOT BLANK CHARACTER AT END
;
; END ADDITION
;
2$:	CMP R1, #100.		;YEARS MUST BE LESS THAN 100.
	BLO CHKDAY
3$:	JMP ERRD1

		; CHECK THAT THE CURRENT DAY CAN EXIST THIS YEAR

CHKDAY:	TST BYEAR(SP)		; NOTE THAT 1900 WAS NOT A LEAP YEAR...
	MOV SP,R0
	BEQ 5$
	BIT #3, BYEAR(SP)	;TEST FOR LEAP YEAR
	BEQ 10$			; BR IF LEAPING

5$:	ADD #DAY28,R0
	MOV R0, CLDAY+2(SP)	;NOT LEAP YEAR, SET TABLES ACCORDINGLY
	MOVB #28., DAYMON+2(SP)
	BR 20$

10$:	ADD #DAY29,R0
	MOV R0, CLDAY+2(SP)	; THIS IS A LEAP YEAR
	MOVB #29., DAYMON+2(SP)

20$:	MOV BMONTH(SP), R0	; NOW TEST THE DAY...
	DEC R0			; JAN IS MONTH ONE...
	ASL R0			; MAKE IT A WORD OFFSET
	ADD #DAYMON,R0
	ADD SP,R0
	MOV BDAY(SP), R1
	CMP R1,(R0)
	BLOS CHOUR
	JMP ERRD2		; ILLGAL DAY FOR MONTH WAS DETECTED
	

		;CONVERT HOUR TO BINARY

CHOUR:	MOV SP,R0
	ADD #TIME,R0
	CALL $CDTB
	MOV R1, BHOUR(SP)
	CMP R1, #24.		; MUST BE LESS THAN 24 HOURS...
	BLO 10$
	BR 20$

10$:	CMPB #':,R2		;NOTE FORMAT HH:MM:SS
	BEQ CMIN
20$:	JMP ERRD1

		; CONVER MINUTE TO BINARY

;
; IN ORIGINAL VERSION, AN "INC R0" WAS INCORRECTLY PLACED AT CMIN:,
;  CAUSING NUMBER CONVERSION TO START AT THE CHARACTER FOLLOWING THE
;  ACTUAL "FIRST" CHARACTER OF THE NUMBER.  REMEMBER THAT $CDTB LEAVES
;  R0 POINTING TO THE NEXT BYTE FOLLOWING THE TERMINATION CHARACTER.
;
;  PHIL HANNAY  JULY 6, 1982
;
CMIN:	CALL $CDTB
	MOV R1, BMIN(SP)
	CMP R1,#60.		; MUST BE LESS THAN 60 MIN
	BLO 10$
	BR 20$

10$:	CMPB #':,R2
	BEQ CSEC
20$:	JMP ERRD1

		; CONVER SECONDS TO BINARY
;
; IN ORIGINAL VERSION, AN "INC R0" WAS INCORRECTLY PLACED AT CSEC:,
;  CAUSING NUMBER CONVERSION TO START AT THE CHARACTER FOLLOWING THE
;  ACTUAL "FIRST" CHARACTER OF THE NUMBER.  REMEMBER THAT $CDTB LEAVES
;  R0 POINTING TO THE NEXT BYTE FOLLOWING THE TERMINATION CHARACTER.
;
;  PHIL HANNAY  JULY 6, 1982
;
CSEC:	CALL $CDTB
	MOV R1,BSEC(SP)
	CMP R1,#60.
	BLO CADD
	JMP ERRD1
	
		; TIME TO CHANGE BINARY INFORMATION TO CLUNKS
		; NOTE - ERROR CHECKING IS BEEN COMPLETED

CADD:

		; CLUNKS = OFFSET + YEARS + LEAP DAYS
		; OFFSET FROM 17-NOV-1858 TO 1-JAN-1900

	MOV #000000,CLUNKS(SP)
	MOV #072215,CLUNKS+2(SP)
	MOV #015304,CLUNKS+4(SP)
	MOV #000056,CLUNKS+6(SP)
	MOV SP,4(R5)		; PUT OFFSET IN CLUNKS IN CALL SITE
	ADD #CLUNKS,4(R5)	
	MOV 4(R5),6(R5)		; PUT TOTAL IN CLUNKS IN CALL SITE
	
;	MOV OFFSET,   CLUNKS	; MOVE THE OFFSET
;	MOV OFFSET+2, CLUNKS+2
;	MOV OFFSET+4, CLUNKS+4
;	MOV OFFSET+6, CLUNKS+6

		; ADD ON THE YEARS

	MOV BYEAR(SP), R3		; USE AS YEAR COUNTER
	TST R3			;  WAS IT ZERO (1900)
	BEQ ADDL		;  BR IF YES

	; NON LEAP YEAR (365 DAYS) - 306,600,000,000,000 CLUNKS

	MOV SP,R0		; PUT 365 DAY CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #140000, (R0)
	MOV #074306,2(R0)
	MOV #017321,4(R0)
	MOV #000001,6(R0)
	MOV R0,2(R5)		; PUT ADDRESS IN CALL SITE
10$:	JSR PC, ADD64
	BCC 15$
        JMP ERRD1
15$:	SOB R3, 10$

		; ADD IN THE LEAP YEARS

ADDL:	MOV BYEAR(SP), R3	; # LEAP DAYS = (BYEAR/4)-1
	ASH #-2, R3
	BEQ ADDM		; IF NONE - WHY WORRY?
	BIT #3,BYEAR(SP)	; IF PRESENT YEAR IS LEAP, THEN WILL DEAL
	BNE 10$			;   WITH IT LATER, ELSE CONTINUE
	DEC R3
	BEQ ADDM

	; A DAY - 864,000,000,000 CLUNKS

10$:	MOV SP,R0		; PUT DAY CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #140000, (R0)
	MOV #025151,2(R0)
	MOV #000311,4(R0)
	MOV #000000,6(R0)
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
;	MOV #DAY,    R0		; ELSE ADD THEM IN...
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2
20$:	JSR PC, ADD64
	BCC 25$
        JMP ERRD1
25$:	SOB R3, 20$

		; TAKE CARE OF THE DAYS OF THE MONTH

ADDM:
	MOV BMONTH(SP), R3
	
	MOV SP,R4
	ADD #CLDAY,R4
50$:	DEC R3			;DO THIS LOOP FOR MONTH-1 TIMES
	BEQ ADDD
	MOV (R4),2(R5)		;GET A POINTER TO THE PROPER MONTH
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD1
	INC R4
	INC R4
	BR 50$

		; ADD DAYS-1 TO TOTAL

ADDD:	MOV BDAY(SP), R3
	DEC R3
	BEQ ADDH

	; A DAY - 864,000,000,000 CLUNKS

	MOV SP,R0		; PUT DAY CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #140000, (R0)
	MOV #025151,2(R0)
	MOV #000311,4(R0)
	MOV #000000,6(R0)
	MOV R0,2(R5)		; PUT ADDRESS IN CALL SITE
;	MOV #DAY, R0
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2
10$:	JSR PC, ADD64
        BCS ERRD1
	SOB R3, 10$

		; ADD IN THE HOURS

ADDH:	MOV BHOUR(SP), R3
	TST R3
	BEQ ADDMIN

;	MOV #HOUR, R0
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2

	; AN HOUR - 36,000,000,000 CLUNKS

	MOV SP,R0		; PUT HOUR CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #064000, (R0)
	MOV #060704,2(R0)
	MOV #000010,4(R0)
	MOV #000000,6(R0)
	MOV R0,2(R5)		; PUT ADDRESS IN CALL SITE
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
10$:	JSR PC, ADD64
        BCS ERRD1
	SOB R3, 10$

		; ADD IN MINUTES

ADDMIN:	MOV BMIN(SP), R3
	TST R3
	BEQ ADDSEC

;	MOV #MIN, R0
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2

	; A MINUTE - 600,000,000 CLUNKS

	MOV SP,R0		; PUT MINUTES CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #043000, (R0)
	MOV #021703,2(R0)
	MOV #000000,4(R0)
	MOV #000000,6(R0)
	MOV R0,2(R5)		; PUT ADDRESS IN CALL SITE
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
10$:	JSR PC, ADD64
        BCS ERRD1
	SOB R3, 10$

		; ADD IN SECONDS

ADDSEC:	MOV BSEC(SP), R3
	TST R3
	BEQ DONE

;	MOV #SEC, R0
;	MOV #CLUNKS, R1
;	MOV #CLUNKS, R2

	; A SECOND - 10,000,000 CLUNKS

	MOV SP,R0		; PUT SECONDS CLUNK VALUE IN TEMP3
	ADD #TEMP3,R0
	MOV #113200, (R0)
	MOV #000230,2(R0)
	MOV #000000,4(R0)
	MOV #000000,6(R0)
	MOV R0,2(R5)		; PUT ADDRESS IN CALL SITE
	; 4(R5) AND 6(R5) SHOULD STILL POINT TO CLUNK
10$:	JSR PC, ADD64
        BCS ERRD1
	SOB R3, 10$

		; CLUNK CALCULATION IS NOW COMPLETE
		; RETURN THE CLUNKS TO THE CALLING PROGRAM

DONE:	
	MOV SP,R1		; GET ADDRESS OF FINAL CLUNK VALUE
	ADD #CLUNKS,R1

	ADD #STKSIZ,SP		; ADJUST SP BACK

	MOV (SP)+, R5		;GET ARG POINTER BACK FROM STACK

	MOV 2(R5),R0		;GET ADDRESS OF CALLER'S BUFFER

	MOV (R1),(R0)
	MOV 2(R1),2(R0)
	MOV 4(R1),4(R0)
	MOV 6(R1),6(R0)

	MOV #1, @10(R5)		; INDICATE SUCCESSFUL STATUS
	RTS PC

ERRD1:	
	ADD #STKSIZ,SP		; ADJUST SP BACK

	MOV (SP)+, R5		;RESTORE ARG POINTER
	MOV #-1, @10(R5)	; INDICATE INVALID DATE STATUS
	RTS PC

ERRD2:	
	ADD #STKSIZ,SP		; ADJUST SP BACK

	MOV (SP)+, R5		;RESTORE ARG POINTER
	MOV #-2, @10(R5)	; INDICATE INVALID DATE STATUS
	RTS PC

ERRD3:	
	ADD #STKSIZ,SP		; ADJUST SP BACK

	MOV (SP)+, R5		;RESTORE ARG POINTER
	MOV #-3, @10(R5)	; INDICATE INVALID DATE STATUS
	RTS PC

	
	.END