.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