.TITLE CLOCK .IDENT /001.00/ .rem ' ! CLOCK is a task to set the system time from a Computer Products, ! Grant Technology Devision model 307 time of day clock (TDC), or ! to reset the TDC from the system time. ! ! Author: ! William L. Kyle ! E.I. duPont de Nemoures & Co. ! Engineering Department ! P.O. Box 6090 ! Newark, DE 19714-6090 ! !========================================================================! ! Copyright (C) 1987 ! ! E.I. duPont de Nemoures & Co. ! ! All rights reserved. ! ! This software is furnished through the DECUS Library and may ! ! NOT be sold. It may be copied only with the inclusion of ! ! this copyright notice. ! ! ! ! DuPont assumes no responsibility for the use or reliability ! ! of this software. ! !========================================================================! ! ! Link command file ! ! CLOCK/PR/FP,CLOCK/MA/-SP=CLOCK,ERRMSG ! / ! UNITS=1 ! PRI=150 ! TASK=...CLK ! // ! ' .ENABL LC .NLIST BEX .NLIST CND .LIBRARY /SYS$LIBRARY:PDPSML/ .SBTTL Macros .MCALL $$SML .MCALL DIR$, GMCR$, ALUN$, GTIM$, STIM$ .MCALL SPRA$S, SVTK$S, ASTX$S, SPND$S, MRKT$S .MCALL EXST$S, QIOW$S .MCALL ISTAT$, STATE$, TRAN$ $$SML ; structured macros .SBTTL Program_sections .PSECT $CODE, I, RO, CON, REL, LCL .PSECT $PDATA, D, RO, CON, REL, LCL .PSECT $IDATA, D, RW, CON, REL, LCL .PSECT $$BUF, D, RW, OVR, REL, GBL .PSECT $CODE .page .SBTTL Local_data ; ; Define floating accumulators ; F0 = %0 F1 = %1 F2 = %2 F3 = %3 F4 = %4 F5 = %5 TILUN = 1 ; logical unit number for TI: WRITFL = 1 ; event flag for I/O writes MARKFL = 2 ; event flag for mark time MARKTM = 5. ; number of minutes to wait on mark time FL.SYS = 1 ; flag to set system time from clock FL.CLK = 2 ; flag to set clock from system time FL.MON = 4 ; flag to monitor system time and clock FL.HLP = 10 ; flag to type help message FL.DST = 20 ; flag for auto daylight savings time ; ; Grant-307 register assignments ; CLKBAS = 170400 ; Factory configuration of clock calender ; address. CLKBAS should be changed if base ; of Grant-307 is altered from the original ; factory configuration. SECOND = 0 ; Seconds MINUTE = 2 ; Minutes HOUR = 4 ; Hours DOW = 6 ; Day of the week DAY = 7 ; Day of the month MONTH = 10 ; Month YEAR = 11 ; Year REGA = 12 ; Status register A REGB = 13 ; Status register B REGC = 14 ; Status register C REGD = 15 ; Status register D ; ; Register bits ; UIP.A = 200 ; Update in progress DV0.A = 20 ; Clock divider (sets the clock frequency) DV1.A = 40 ; Clock divider (sets the clock frequency) DV2.A = 100 ; Clock divider (sets the clock frequency) SET.B = 200 ; Set the clock DM.B = 4 ; Set data in binary format MODE.B = 2 ; Set clock to 24 hour mode DSE.B = 1 ; Set the clock to do daylight savings time VRT.D = 200 ; Valid RAM and time bit tests for low ; battery or power failure. .page .SAVE .SBTTL $$BUF - output buffer area .PSECT $$BUF BUFFER: .BLKB 256. ; extend the buffer for output .EVEN .SBTTL $PDATA - pure data area .PSECT $PDATA .NLIST BEX ERR1: .ASCII <15>&%2R -- Grant-307 clock not in system.& .ASCIZ &%N%10SBase address = %P& ERR2: .ASCIZ <15>&%2R -- Syntax error. "See HELP for correct systax."& ERR3: .ASCII <15>/%2R -- Unable to set the system time./ .ASCIZ /%N%10SDSW error %D./ ERR4: .ASCIZ <15>&%2R -- Grant-307 clock power fail. Reset the clock time.& ERR5: .ASCII <15>/%2R -- Unable to get the system time./ .ASCIZ /%N%10SDSW error %D./ ERR6: .ASCII <15>&%2R -- Grant-307 clock time and SYSTEM& .ASCIZ /%N%10Stime differ by more than one minute./ HLPMSG: .ASCII <12><12><15>/ CLOCK is a program used for the Grant-307 time of day clock./ .ASCII <12><12><15>/ CLOCK has three functions:/ .ASCII <12><15>/ * Set the system time from the Grant-307 clock./ .ASCII <12><15>/ * Set the Grant-307 clock from the system time./ .ASCII <12><15>/ * Monitor the system time verses the Grant-307 clock time./ .ASCII <12><12><15><11><11>/COMMAND SYNTAX/ .ASCII <12><15>& $ CLOCK SET SYSTEM_TIME ! sets system time.& .ASCII <12><15>& $ CLOCK SET CLOCK ! sets clock.& .ASCII <12><15>& $ CLOCK SET CLOCK/AUTO_DAYLIGHT_SAVINGS_TIME& .ASCII <12><15>& ! sets clock and enables auto daylight savings time.& .ASCII <12><15>& $ CLOCK MONITOR ! monitor the system time& .ASCII <12><15>& ! verses the Grant-307 clock time.& .ASCII <12><15>& $ CLOCK MONITOR/AUTO_DAYLIGHT_SAVINGS_TIME& .ASCII <12><15>& ! monitor the time and enables auto daylight savings time.&<12> .ASCII <12><15>& $ CLOCK HELP ! type this help text.&<12> HLPSZ = .-HLPMSG .EVEN .LIST BEX .page .SBTTL $IDATA - impure data area .PSECT $IDATA SSTTBL: .WORD NOCLCK ; address for trap to 4 WRITST: .BLKW 2 ; write I/O status ARGLST: .BLKW 7. ; output status area for errmsg FLAGS: .BLKW 1 ; flag area for command parsing LSTCLK: .BLKW 2 ; storage for last clock time ALUNTI: ALUN$ TILUN,TI,0 ; assign lun DPB for TI GMCR: GMCR$ ; get command line DPB GETTIM: GTIM$ TIMBUF ; get time DPB SETTIM: STIM$ TIMBUF ; set time DPB TIMBUF: .BLKW 8. ; Buffer for get and set time WEEKDY: .BLKW 1 ; Day of week .page .SBTTL STATE - TPARS state table ; To be used with blank suppress option $RONLY = 1 ; make psects read only ISTAT$ CLOSTB,CLOKTB STATE$ CLOKEY TRAN$ $RAD50 STATE$ TRAN$ '/,ACTION TRAN$ $LAMDA STATE$ ACTION TRAN$ $EOS,$EXIT,REJECT TRAN$ "SET",DEM TRAN$ "MONITOR",DST,,FL.MON,FLAGS TRAN$ "HELP",DONE,,FL.HLP,FLAGS STATE$ DEM TRAN$ '/,WHICH TRAN$ ':,WHICH TRAN$ '=,WHICH TRAN$ $LAMDA STATE$ WHICH TRAN$ "SYSTEM_TIME",DONE,,FL.SYS,FLAGS TRAN$ "CLOCK",DST,,FL.CLK,FLAGS STATE$ DST TRAN$ $EOS,$EXIT TRAN$ '/ STATE$ TRAN$ $EOS,$EXIT,REJECT TRAN$ "AUTO_DAYLIGHT_SAVINGS_TIME",DONE,,FL.DST,FLAGS STATE$ DONE TRAN$ $EOS,$EXIT TRAN$ $LAMDA,$EXIT,REJECT STATE$ .RESTORE .page .SBTTL CLOCK - Main line code CLOCK:: DIR$ #ALUNTI ;assign lun for TI: SVTK$S #SSTTBL,#1 ;specify address for nxm MOV #CLKBAS,R5 ;get base address of clock CLR R0 ;set up flag word TSTB (R5) ;check to see if clock present TSTB REGD(R5) ;check to see if clock present IF R0,EQ ;IF clock present MOV R0,SSTTBL ;clear out trap address SVTK$S #SSTTBL,#1 ;clear out SST table CALL GETCMD ;get the command IF ,CC ;IF got one, OK IF #FL.SYS,SET,FLAGS ;IF set system time CALL TIMSET ;set the time ENDI ;ENDI IF #FL.CLK,SET,FLAGS ;IF set the clock CALL CLKSET ;set the clock ENDI ;ENDI IF #FL.MON,SET,FLAGS ;IF monitor system time vs clock SPRA$S #POWERF ;specify power fail AST address MRKT$S #MARKFL,#1,#2,#CHECK ;start to check the time SPND$S ;suspend forever, exit if resumed MOV #EX$SUC,R0 ;success ENDI ;ENDI IF #FL.HLP,SET,FLAGS ;IF help QIOW$S #IO.WLB,#TILUN,#WRITFL,,#WRITST,,<#HLPMSG,#HLPSZ,#40> ;type out help text MOV #EX$SUC,R0 ;success ENDI ;ENDI ELSE ;ELSE no command, just exit MOV #ERR2,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list CLR (R2) ;assume no arguments MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$WAR,R0 ;warning ENDI ;ENDI ELSE ;ELSE no clock present MOV #ERR1,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list MOV #1,(R2) ;assume one argument MOV #CLKBAS,2(R2) ;put clock address on argument list MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$ERR,R0 ;error ENDI ;ENDI EXST$S R0 ;exit .page .SBTTL Subroutines .SBTTL * TIMSET - set the system time from Grant-307 clock ; ; TIMSET - set the system time from Grant-307 clock ; ; INPUT: ; R5 = base address of Grant-307 clock ; OUTPUT: ; R0 = exit status ; TIMSET: IFB #VRT.D,SET,REGD(R5) ;IF the clock is ok MOV #-1,S.TICT+TIMBUF ;use default clock ticks MOV #-1,S.TICP+TIMBUF ;use default ticks per second UNTILB #UIP.A,CLEAR,REGA(R5) ;UNTIL clock is readable ENDU ;ENDU MOVB SECOND(R5),S.TISC+TIMBUF ;read the seconds MOVB MINUTE(R5),S.TIMI+TIMBUF ;read the minutes MOVB HOUR(R5),S.TIHR+TIMBUF ;read the hours MOVB DAY(R5),S.TIDA+TIMBUF ;read the day MOVB MONTH(R5),S.TIMO+TIMBUF ;read the month MOVB YEAR(R5),S.TIYR+TIMBUF ;read the year DIR$ #SETTIM ;set the system time IF ,CC ;IF no error MOV #EX$SUC,R0 ;success ELSE ;ELSE error MOV #ERR3,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list MOV #1,(R2) ;assume one argument MOV $DSW,2(R2) ;put DSW on argument list MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$ERR,R0 ;error ENDI ;ENDI ELSE ;ELSE clock had power fail MOV #ERR4,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list CLR (R2) ;assume no arguments MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$ERR,R0 ;error ENDI ;ENDI RETURN .page .SBTTL * CLKSET - set Grant-307 clock from system time ; ; CLKSET - set Grant-307 clock from system time ; ; INPUT: ; R5 = base address of Grant-307 clock ; OUTPUT: ; R0 = exit status ; CLKSET: DIR$ #GETTIM ;get the time from system IF ,CC ;IF no error MOVB REGD(R5),R0 ;make sure the valid time bit is reset BISB #SET.B,REGB(R5) ;make sure the clock can be set MOV R4,-(SP) ;save R4 MOV SP,R4 ;set flag true for while loop WHILE R4 ;WHILE clock not set MOVB G.TIYR+TIMBUF,YEAR(R5) ;set the year MOVB G.TIMO+TIMBUF,MONTH(R5) ;set the month MOVB G.TIDA+TIMBUF,DAY(R5) ;set the day CALL TODAY ;get day of week DIR$ #GETTIM ;get the time from system IF ,CC ;IF no error IFB G.TIDA+TIMBUF,EQ,DAY(R5) ;IF still same day MOVB G.TISC+TIMBUF,SECOND(R5) ;set the seconds MOVB G.TIMI+TIMBUF,MINUTE(R5) ;set the minutes MOVB G.TIHR+TIMBUF,HOUR(R5) ;set the hours MOVB WEEKDY,DOW(R5) ;set the day of the week MOVB #DV1.A,REGA(R5) ;set the clock frequency IF #FL.DST,SET,FLAGS ;IF auto daylight savings time MOVB #DM.B!MODE.B!DSE.B,REGB(R5) ;start the clock ELSE ;ELSE MOVB #DM.B!MODE.B,REGB(R5) ;start the clock ENDI ;ENDI MOV #EX$SUC,R0 ;success CLR R4 ;flag clock set ENDI ;ENDI ELSE ;ELSE error MOV #ERR5,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list MOV #1,(R2) ;assume one argument MOV $DSW,2(R2) ;put DSW on argument list MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$ERR,R0 ;error CLR R4 ;flag exit while loop ENDI ;ENDI ENDW ;ENDW MOV (SP)+,R4 ;restore R4 ELSE ;ELSE error MOV #ERR5,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list MOV #1,(R2) ;assume one argument MOV $DSW,2(R2) ;put DSW on argument list MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error MOV #EX$ERR,R0 ;error ENDI ;ENDI RETURN .page .SBTTL * TODAY - routine to caculate day of week index ; ; TODAY - routine to caculate day of week index ; ; This routine is a slight modification of the routine from the ; RSX-11M V3.2 indirect command processor manual. All credit ; belongs to the orginal author. I had no desire to try to figure ; out this code any more than required to get it to work. ; ; OUTPUT: ; WEEKDY = day of week index (Sunday = 1) ; TODAY: CALL $SAVAL ;save all registers and return as co-routine MOV #10.,R1 ADD G.TIMO+TIMBUF,R1 ;T1 in R1 MOV R1,R2 ;T1 in R2 CLR R0 ;get set for divide DIV #13.,R0 ;T2 in R0 MOV R0,R1 ;T2 in R1 MUL #12.,R1 ;T2*12. in R1 NEG R1 ADD R2,R1 ;T1-(T2*12.) in R1 MUL #13.,R1 ;13.*(T1-(T2*12.)) in R1 DEC R1 ;(13.*(T1-(T2*12.)))-1 in R1 CLR R0 ;get set for divide DIV #5.,R0 ;((13.*(T1-(T2*12.)))-1)/5. in R0 MOV #77.,R1 ADD R0,R1 ;(((13.*(T1-(T2*12.)))-1)/5.)+77. in R1 ADD G.TIDA+TIMBUF,R1 ;T3 in R1 MOV G.TIYR+TIMBUF,R3 ;T4 in R3 IF G.TIMO+TIMBUF,LT,#3. ;IF JAN. or FEB. DEC R3 ;T4 = T4-1 ENDI ;ENDI MUL #5.,R3 ;5.*T4 in R3 CLR R2 ;get set for divide DIV #4.,R2 ;T7 in R2 ADD R2,R1 ;T3+T7 in R1 INC R1 ;T8 in R1 MOV R1,R2 ;T8 in R2 CLR R0 ;get set up for divide DIV #7.,R0 ;T8/7. in R0 MOV R0,R1 ;T8/7. in R1 MUL #7.,R1 ;(T8/7.)*7. in R1 INC R2 ;T8+1 in R2 SUB R1,R2 ;day index (Sunday = 1) MOV R2,WEEKDY ;save day index RETURN .page .SBTTL * GETCMD - get and parse command line ; ; GETCMD - get and parse command line ; ; OUTPUT: ; CS = syntax error ; CC = good command, flag bits set to indicate command ; ; R5 saved ; GETCMD: MOV R5,-(SP) ;save R5 DIR$ #GMCR ;get command line MOV $DSW,R3 ;get length of command line MOV #GMCR+G.MCRB,R4 ;get address of command MOV #CLOKEY,R5 ;address of state to start with MOV #CLOKTB,R2 ;point to key word table MOV #3*400,R1 ;set up options word CALL .TPARS ;parse it here and now MOV (SP)+,R5 ;restore R5 RETURN .SBTTL * REJECT - TPARS action routine ; ; REJECT - TPARS action routine ; REJECT: ;reject transition ADD #2,(SP) ;point to reject return RETURN .page .SBTTL TRAP - TRAP action routines .SBTTL * NOCLCK - SST nonexistent memory ; ; NOCLCK - SST nonexistent memory ; ; Call by nonexistent memory SST if Grant-307 clock not in I/O page ; ; OUTPUT: ; R0 /= 0 ; NOCLCK: ADD 6,SP ;clean up stack MOV SP,R0 ;flag trap to 4 RTT ;return from trap .SBTTL * POWERF - AST power fail ; ; POWERF - AST power fail ; ; Call by power fail recovery AST to reset system time ; POWERF: MOV R0,-(SP) ;save R0 MOV R1,-(SP) ;save R1 MOV R2,-(SP) ;save R2 MOV R3,-(SP) ;save R3 MOV R5,-(SP) ;save R5 CALL TIMSET ;set the time MOV (SP)+,R5 ;restore R5 MOV (SP)+,R3 ;restore R3 MOV (SP)+,R2 ;restore R2 MOV (SP)+,R1 ;restore R1 MOV (SP)+,R0 ;restore R0 ASTX$S ;exit the ast routine .page .SBTTL * CHECK - AST compare system / Grant-307 clock time ; ; CHECK - AST compare system / Grant-307 clock time ; ; Call by AST routine from mark time ; CHECK: TST (SP)+ ;clean stack MOV R0,-(SP) ;save R0 MOV R1,-(SP) ;save R1 MOV R2,-(SP) ;save R2 MOV R3,-(SP) ;save R3 MOV R4,-(SP) ;save R4 MOV R5,-(SP) ;save R5 SETI ;set regular integer mode SETF ;set regular floating mode MOV #CLKBAS,R5 ;get base address of clock CLR R4 ;set error flag false DIR$ #GETTIM ;get system time IF ,CC ;IF no error UNTILB #UIP.A,CLEAR,REGA(R5) ;UNTIL clock is readable ENDU ;ENDU IFB G.TIYR+TIMBUF,EQ,YEAR(R5) ;IF year is the same IFB G.TIMO+TIMBUF,EQ,MONTH(R5) ;IF month is the same ;; ;; Get time from Grant-307 and convert to seconds from start of month ;; MOVB DAY(R5),R1 ;get the day LDCIF R1,F0 ;convert hour to floating MULF #24.,F0 ;convert to hours MOVB HOUR(R5),R1 ;get the hour LDCIF R1,F1 ;convert to floating ADDF F1,F0 ;add into hours MULF #60.,F0 ;convert to minutes MOVB MINUTE(R5),R1 ;get the minutes LDCIF R1,F1 ;convert to floating ADDF F1,F0 ;add into time MULF #60.,F0 ;convert to seconds MOVB SECOND(R5),R1 ;get the seconds LDCIF R1,F1 ;convert to floating ADDF F1,F0 ;add into total STF F0,F3 ;save current clock time ;; ;; Now convert system time to seconds from start of month ;; LDCIF G.TIDA+TIMBUF,F2 ;get the days MULF #24.,F2 ;make the days into hours LDCIF G.TIHR+TIMBUF,F1 ;get the hours in floating format ADDF F1,F2 ;add into total MULF #60.,F2 ;make into minutes LDCIF G.TIMI+TIMBUF,F1 ;get the minutes in floating format ADDF F1,F2 ;add into total MULF #60.,F2 ;now make it seconds LDCIF G.TISC+TIMBUF,F1 ;get the seconds in floating format ADDF F1,F2 ;and add into total SUBF F0,F2 ;subtract clock time from system time ABSF F2 ;get the absolute value STCFI F2,R1 ;convert to integer in R1 IF #FL.DST,SET,FLAGS ;IF auto daylight savings time CALL DAYLIT ;go check daylight savings time ENDI ;ENDI IF #60.,LT,R1 ;IF time difference greater than 60 sec. MOV SP,R4 ;flag error ENDI ;ENDI ELSE ;ELSE error MOV SP,R4 ;flag error ENDI ;ENDI ELSE ;ELSE error MOV SP,R4 ;flag error ENDI ;ENDI IF R4 ;IF error MOV #ERR6,R1 ;get error address MOV #ARGLST,R2 ;get address of argument list CLR (R2) ;assume no arguments MOV #TILUN,R3 ;lun to output error message CALL ERRMSG ;output error ENDI ;ENDI ENDI ;ENDI SETL ;set long integer mode STCFL F3,LSTCLK ;update last clock time SETI ;set regular integer mode MOV (SP)+,R5 ;restore R5 MOV (SP)+,R4 ;restore R4 MOV (SP)+,R3 ;restore R3 MOV (SP)+,R2 ;restore R2 MOV (SP)+,R1 ;restore R1 MOV (SP)+,R0 ;restore R0 MRKT$S #MARKFL,#MARKTM,#3,#CHECK ;check the time every MARKTM minutes ASTX$S ;exit ast routine .page .SBTTL * DAYLIT - subroutine to check daylight savings time ; ; DAYLIT - subroutine to check daylight savings time ; ; INPUT: ; R1 = current time difference in seconds ; F3 = current time in seconds from start of month ; OUTPUT: ; R1 = current time difference in seconds if not daylight ; savings time change ; R1 = 0 if daylight savings time change ; Correct routine called to reset system time or ; clock time. ; DAYLIT: MOV LSTCLK,R2 ;get first word of last clock time BIS LSTCLK+2,R2 ;or in second word IF R2,NE ;IF not first check IF #60.*59.,LT,R1 ;IF more than 59 minutes difference IF #60.*61.,GT,R1 ;IF less than 61 minutes, assume time change SETL ;set long integer mode LDCLF LSTCLK,F2 ;get last clock time in floating format SETI ;set regular integer mode SUBF F3,F2 ;subtract current time from last time ABSF F2 ;get the absolute value STCFI F2,R2 ;convert to integer in R2 IF #<60.*MARKTM>+90.,LT,R2 ;IF change in Grant-307 clock CALL TIMSET ;set system time ELSE ;ELSE CALL CLKSET ;set clock ENDI ;ENDI CLR R1 ;do not print time error ENDI ;ENDI ENDI ;ENDI ENDI ;ENDI RETURN .END CLOCK