	.TITLE	VAXQAD  VAX QUAD TIME SUBROUTINE
	.IDENT	/1.0/
;.begin.doc ************************** begin.doc
; .c ;MODULE
; .c ;^&VAXQAD\&
; .nf
; .x VAXQAD>Defined
; Source:VAXQAD.MOD
; To become part of library:QUEUE
; Designer           :EARL LAKIA
; Author             :EARL LAKIA (DEFAULT DESIGNER)
; Date of last update:30-SEP-86
; Revision level     :1.0
; 	
; .C ;Formal Parameter List
; Receives:
;     
; Returns:
;   
;   VAXTIME          INTEGER*2  4 WORD ARRAY TO RECEIVE THE VAX QUAD 
;                               TIME WORD (64 BIT TIME VALUE)
; 	
; Accesses common(s):
; 	
; Accesses file(s):
; 	
; Other modules referenced:
; .SK
; .fill
; .SK
; Description:
; .sk    
; 	This subroutine is called to get the current time and convert 
; the time to the vax equivalent time stamp.  The caller must pass the
; 4 word array by address.  The calling sequence is:
; .NOFILL
;  
; 	INTEGER*2 VAXTIME(4)
; 	CALL VAXQAD(VAXTIME)
; .page
; The algothrim used is:
; 
;	F = 365. * IY + ID + 31 * (IM-1)
;	G = 365. * IY + ID + 31 * (IM-1)
;	IF (IM .GT. 2) THEN
;		I1 = (IY/100.)
;		I1 = ( (I1 + 1) * .75)
;		I2 = (IY/4.)
;		I3 = (.4 * IM + 2.3)
;		G = G - I3 + I2 - I1
;	F=F-INT(.4*IM+2.3) + INT(IY/4.) - INT(.75 * (INT(IY/100.)+1))
;	ELSE
;		I1 = (IY - 1)/100
;		I1 = I1 * .75 + 1
;		I2 = (IY - 1)/4
;		G = G + I2 - I1
;	F=F+INT((IY-1.0)/4.0) - INT(.75 * INT((IY-1.)/100.) + 1)
;	ENDIF
;	F= F- 678941.0  ! SUBTRACT DAYS SINCE 17-NOV-1858
;	XMS=  F * 864000000000.0  ! MILA SECONDS PER DAY
;
; .FILL
; end.doc ****************************** end.doc  

;.begin.doc ************************** begin.doc
;  
; .c ;MODULE
; .c ;^&VAXQDD\&
; .nf
; .x VAXQDD>Defined
; Source:VAXQAD.MAC
; To become part of library:QUEUE
; Designer           :EARL LAKIA
; Author             :EARL LAKIA (DEFAULT DESIGNER)
; Date of last update:03-OCT-86
; Revision level     :1.0
; 	
; .C ;Formal Parameter List
; Receives:
; 
;   HOUR             INTEGER*2  CURRENT HOUR OF THE DAY (0 TO 23)
;   
;   MIN              INTEGER*2  CURRENT MINUTE OF HOUR (0-59)
;   
;   SEC              INTEGER*2  CURRENT SECOND OF MINUTE (0-59)
;   
;   MONTH            INTEGER*2  MONTH OF YEAR (1 TO 12)
;   
;   DAY              INTEGER*2  CURRENT DAY OF MONTH (1 TO 31 DEPENDING 
;                               ON MONTH)
;  
;   YEAR             INTEGER*2  YEAR SINCE 1900, (0 TO 99)
;     
; Returns:
;   
;   QUAD             INT*2(4)   FOUR WORD INTEGER*2 ARRAY TO RECEIVE 
;                               THE VAX EQUIVALENT QUAD WORD TIME.
; 	
; Accesses common(s):
; 	
; Accesses file(s):
; 	
; Other modules referenced:
; .SK
; .fill
; .SK
; Description:
; .sk    
; 	This subroutine is called to return the VAX standard
; QUAD time format into the associated element 
; of the 	QUAD array.  The Vax standard time  is shown below
; along with element number of the QUAD array.
; .SK
; .nofill
; 3322 2222 2222 1111 1111 1100 0000 0000
; 1098 7654 3210 9876 5432 1098 7654 3210
; 
;     QUAD   2       !      QUAD  1
; 
; 6666 5555 5555 5544 4444 4444 3333 3333
; 3210 9876 5432 1098 7654 3210 9876 5432
; 
;    QUAD   4        !      QUAD  3
; 
; .SK
; .fill
; 	Note the bit order of the VAX time format which
; has low precision bits first in the two long words.
; The value of OCT 3, 1986 at 11:00#AM is:  4507F800 008F5E18.
; 	This subroutine is accurate to plus or minus
; 512 millaseconds due to the accuracy of the double
; precison floating point arithmetic.
; 	The calling sequence is:
; .SK 2
; .NOFILL
;          INTEGER*2 MONTH,YEAR,DAY,HOUR,MINUTE,SECOND
;          INTEGER*2 QUAD(4)
;          DATA MONTH/10/,DAY/3/,HOUR/0/,MINUTE/0/,SECOND/0/
;          DATA YEAR/86/
; C
;          CALL VAXQDD(HOUR,MINUTE,SECOND,MONTH,DAY,YEAR,QUAD)
; 
; end.doc ****************************** end.doc  

	.MCALL	GTIM$	; GET CURRENT SYSTEM TIME
	.MCALL	DIR$	; DIRECTIVE CALL
;
; DEFINE FLOATING POINT ACCUMULATORS
;
	F0=%0
	F1=%1
	F2=%2
	F3=%3
	.PAGE
	.PSECT	$DATA,CON,LCL,D
;
TIME:
	GTIM$	TIMBUF
TIMBUF:
	.BLKW	8.	; TIME BUFFER
;
DAYMLT:
	.FLT4	864000000000.0	; NUMBER OF MILASECONDS IN A DAY
HRSMLT:
	.FLT4	36000000000.0	; NUMBER OF MILASECONDS IN AN HOUR
MINMLT:
	.FLT4	600000000.0	; NUMBER OF MILASECONDS IN A MINUTE
SECMLT:
	.FLT4	10000000.0	; NUMBER OF MILASECONDS IN A SECOND
TICMLT:
	.FLT4	166666.6	; NUMBER OF MILASECONDS IN A TICK
K365:	
	.FLT2	365.0
K$75:	
	.FLT2	0.75
K$4:	
	.FLT2	0.4
K2$3:	
	.FLT2	2.3
K1858:	
	.FLT2	678941.0	; DAYS SINCE 17-NOV-1858
XMS:	
	.BLKW	4	; TOTAL NUMBER OF MILLASECONDS
			; USED FOR MASKING OPERATIONS
;
; TEMPORAIES
;
I1:	.WORD	0
I2:	.WORD	0
I3:	.WORD	0	
$TEMPS:
	.BLKB	10	; TEMPS 
;
	.PSECT	TIME,OVR,GBL,D,RW
XMSR:	
	.BLKW	4	; TOTAL NUMBER OF MILLASECONDS AS A REAL FOR DEBUG
EXP:
	.BLKW	1	; EXPONENT
G:	.FLT2	0.0
F:	.FLT2	0.0

;
	.PSECT	CODE,RO,CON,LCL,REL,I
;
; USER SPECIFIED HOURS, MINUTES, SECONDS, MONTH, DAY, YEAR SINCE 1900
;
;	   (R5)= 7
;	@02(R5)= HOURS
;	@04(R5)= MIN
;	@06(R5)= SEC
; 	@10(R5)= MONTH
;	@12(R5)= DAY
;	@14(R5)= YEAR
;	@16(R5)= QUAD RETURN
;
VAXQDD::
	CMP	#7,(R5)+		; SEVEN ARGUMENTS?
	BEQ	10$
	TRAP	<80.+128.>		; INSUFFICIENT NUMBER ARGUMENTS
	RETURN
10$:
	MOV	@(R5)+,TIMBUF+G.TIHR	; HOURS
	MOV	@(R5)+,TIMBUF+G.TIMI	; MINUTES
	MOV	@(R5)+,TIMBUF+G.TISC	; SECONDS
	MOV	@(R5)+,TIMBUF+G.TIMO	; MONTH
	MOV	@(R5)+,TIMBUF+G.TIDA	; DAY
	MOV	@(R5)+,TIMBUF+G.TIYR	; YEAR
	BR	COM
;
; GET THE CURRENT SYSTEM TIME
;
VAXQAD::
	CMP	#1,(R5)+ ; CORRECT NUMBER ARGUMENTS
	BEQ	5$	; YES
	TRAP	<128.+80.>
	RETURN
5$:
	DIR$	#TIME	; GET CURRENT SYTE CLOCK
COM:
	CLR	XMS
	CLR	XMS+2
	CLR	XMS+4
	CLR	XMS+6
	MOV	#MOVTIM,-(SP)	; FAKE RETURN ADDRESS
	CALL	$SAVAL	; SAVE ALL REGISTERS
;
	ADD	#1900.,TIMBUF+G.TIYR	; MAKE THE YEAR 1986 AND NOT 86
;
	SETF		; SET FLOATING (NORMAL)
	SETI		; SET INTEGER (NORMAL)
;

	LDCIF	TIMBUF+G.TIYR,F0	; GET YEAR
	LDF	F0,F1
	MULF	K365,F1 	; F1= (365.0 *IY)
	LDCIF	TIMBUF+G.TIDA,F2	; DAY
	ADDF	F2,F1		; F1= (365.0*IY)+DAY
	MOV	TIMBUF+G.TIMO,R1	; MONTH
	DEC	R1		; R1= MONTH-1
	MUL	#37,R1		; R1= (MONTH-1)*31)
	LDCIF	R1,F2		; F2= (MONTH-1)*31)
	ADDF	F2,F1		; F1= (365.0*IY)+DAY+((MONTH-1)*31)
	STF	F1,F		; SAVE IN F
	STF	F1,G		; SAVE IN G
	CMP	TIMBUF+G.TIMO,#2	; IF(MONTH .GT. 2) FEBRUARY
	BLE	L$FAAD			; YES
	LDF	F0,F2
	DIVF	#^F100.0,F2
	STCFI	F2,R2
	MOV	R2,R0
	INC	R0
	LDCIF	R0,F3
	MULF	#^F0.75,F3
	STCFI	F3,R2
	LDF	F0,F3
	MULF	#^F0.25,F3
	STCFI	F3,I2
	LDCIF	TIMBUF+G.TIMO,F1
	MULF	K$4,F1
	ADDF	K2$3,F1
	STCFI	F1,I3
	STF	F0,$TEMPS
	LDCIF	I3,F0
	STF	F2,$TEMPS+4
	LDF	G,F2
	SUBF	F0,F2
	LDCIF	I2,F0
	ADDF	F0,F2
	LDCIF	R2,F0
	SUBF	F0,F2
	STF	F2,G
	STCFI	F1,R0
	LDCIF	R0,F0
	LDF	F,F1
	SUBF	F0,F1
	STCFI	F3,R0
	LDCIF	R0,F0
	ADDF	F0,F1
	LDF	$TEMPS+4,F0
	STCFI	F0,R0
	INC	R0
	LDCIF	R0,F0
	MULF	#^F0.75,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	SUBF	F0,F1
	STF	F1,F
	BR	L$FAOF
L$FAAD:
	MOV	TIMBUF+G.TIYR,R1
	DEC	R1
	MOV	R1,R5
	SXT	R4
	DIV	#144,R4
	MOV	R4,R2
	LDCIF	R2,F1
	MULF	#^F0.75,F1
	LDF	#^F1.0,F2
	ADDF	F2,F1
	STCFI	F1,R2
	TST	R1
	SXT	R0
	DIV	#4,R0
	MOV	R0,I2
	LDCIF	R0,F1
	ADDF	G,F1
	LDCIF	R2,F3
	SUBF	F3,F1
	STF	F1,G
	SUBF	F2,F0
	LDF	F0,F1
	MULF	#^F0.25,F1
	STCFI	F1,R0
	LDCIF	R0,F1
	ADDF	F,F1
	DIVF	#^F100.0,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	MULF	#0.75,F0
	ADDF	F2,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	SUBF	F0,F1
	STF	F1,F
L$FAOF:
	MOV	R2,I1
	LDF	F,F0
	SUBF	K1858,F0
	STF	F0,F
	SETD			; SET DOUBLE PRECISION
	LDCFD	F,F0		; GET VALUE SO FAR IN DOUBLE PRECISON
	MULD	DAYMLT,F0		; CALCULATE MILLASECONDS TO DATE
	STD	F0,XMS		; SAVE CALC. SO FAR
	.PAGE
;
; NOW ADD IN THE HOURS, MINUTES, SECONDS, AND TICKS.
;
	LDCID	TIMBUF+G.TIHR,F1	; GET HOURS
	MULD	HRSMLT,F1		; MULT BY MILLA SECONDS/HOUR
	ADDD	F1,F0			; ADD TO TOTAL
;
	LDCID	TIMBUF+G.TIMI,F1	; GET MINUTES
	MULD	MINMLT,F1		; MULT BY MILLASECONDS/MINUTE
	ADDD	F1,F0
;
	LDCID	TIMBUF+G.TISC,F1	; GET SECONDS
	MULD	SECMLT,F1		; MULT BY MILLASECONDS/SEC
	ADDD	F1,F0
;
	LDCID	TIMBUF+G.TICT,F1	; GET CLOCK TICK OF SECOND
	MULD	TICMLT,F1		; MULT BY MILLASECONDS/TICK
	ADDD	F1,F0
	STD	F0,XMS			; SAVE TOTAL MILLASECONDS
					; SINCE 17-NOV-1858
	.PAGE
;
; MOW CONVERT IT TO 64 BIT INTEGER
; XMS=
;	1 111 11
;	5 432 109 876 543 210  
; XMS   S MMM MMM MMF FFF FFF
; XMS+2 F FFF FFF FFF FFF FFF
; XMS+4 F FFF FFF FFF FFF FFF
; XMS+6 F FFF FFF FFF FFF FFF
;
C64:
	STD	F0,XMSR
	STEXP	F0,R1			; GET UNBIASED EXPONENT
	MOV	R1,EXP			; SAVE THE EXPONENT
	SETF				; SET NORMAL FLOATING ARITH
	BIC	#177600,XMS		; CLEAR EXPONENT
	BIS	#000200,XMS		; SET THE HIDDEN BIT
	SUB	#56.,R1			; DETERMINE HOW MANY BITS TO SHIFT
					; RIGHT THE RESULT (IF
					; WE LEAVE AS IS, IT IS LIKE
					; MULTIPLYING THE FRACTION BY 2**56
	BMI	20$			; IT'S A RIGHT SHIFT, 
;
; LEFT SHIFT, START FROM THE TOP
;
	MOV	XMS,R4			; SHIFT REGISTERS
	MOV	XMS+2,R5		;   "       "
	ASHC	R1,R4
	MOV	R4,XMS
;
	MOV	XMS+2,R4
	MOV	XMS+4,R5
	ASHC	R1,R4
	MOV	R4,XMS+2
;
	MOV	XMS+4,R4
	MOV	XMS+6,R5
	ASHC	R1,R4
	MOV	R4,XMS+4
;
	MOV	XMS+6,R5
	ASH	R1,R5
	MOV	R5,XMS+6
	RETURN
;
; DO IT FROM THE BOTOM UP, SHIFTING RIGHT
;
20$:
	MOV	XMS+6,R5
	MOV	XMS+4,R4
	ASHC	R1,R4		; SHIFT POOP OFF THE RIGHT END
	MOV	R5,XMS+6
;
	MOV	XMS+4,R5
	MOV	XMS+2,R4
	ASHC	R1,R4
	MOV	R5,XMS+4
;
	MOV	XMS+2,R5
	MOV	XMS,R4
	ASHC	R1,R4
	MOV	R4,XMS
	MOV	R5,XMS+2
	RETURN
;
; (R5)= ADDRESS OF RETURN QUAD TIME VARIABLE
;
MOVTIM:
	MOV	(R5),R1
	MOV	XMS+4,(R1)+
	MOV	XMS+6,(R1)+
	MOV	XMS+2,(R1)+
	MOV	XMS,(R1)
	RETURN			; REAL RETURN TO CALLER
	.END
