MCALL  .MODULE
MODULE MKTIME,RELEASE=Y01,VERSION=01,COMMENT=<MKTIME/MBGLIB>,IDENT=NO,LIB=YES

;                           Copyright (c) 2000
;                              Megan Gentry
;                       Framingham, Massachusetts
;                          All Rights Reserved
;                  Commercial Distribution Prohibited
;
; This software may be  freely copied  and used in its entirety for any
; purpose  so long as the above copyright notice and these comments are
; preserved  in  the  source  form  of  this  software, and  the binary
; copyright is preserved in any image built from it.
;
; The author has used best efforts in the research, design, development
; and  testing of  this software.  The author  makes no warranty of any
; kind,  expressed or  implied,  with  regard to  this software and its
; suitability for a given application.  The author shall not  be liable
; in any  event for  incidental or  consequential damages in connection
; with, or arising out of, the use or performance of this software. Use
; of this software constitutes acceptance of these terms.
;
; The author  is committed to making a best effort at fixing any errors
; found  in the  software and  would welcome  any reports  of problems,
; comments  or suggestions  regarding the software.   Please send email
; to <[email protected]>.
       .SBTTL  Edit History

;+
;
; Edit History:
;
; X01 (00) 11-Feb-2000 Megan Gentry
;       Initial coding.
;
; X01 (01) 14-Feb-2000 Megan Gentry
;       o Month entry is returned from locltm in range 0-11, per U*x
;         libary routine localtime(), change range checking and some
;         code to account for this
;       o Corrected TM Array entry names to be consistent with
;         U*x library routine localtime()
;
; Y01 (01) 14-Feb-2000 Megan Gentry
;       o Ready for initial release.
;
;-
       .SBTTL  Definitions

       .MCALL  .ASSUM

; Declare the system definition library

       .LIBRARY "SRC:SYSTEM.MLB"

; Specifiy the macros we'll be using

       .MCALL  .DSECT  .DS     .EQU

       .MCALL  .DATDF
       .DATDF

       .MCALL  .DTMDF
       .DTMDF

       .MCALL  .TIMDF
       .TIMDF
       .SBTTL  Local definitions

; Define local structure of TM Array

       .DSECT
       .DS     TM.SEC                  ; : Seconds after the minute (0 - 59)
       .DS     TM.MIN                  ; : Minutes after the hour (0 - 59)
       .DS     TM.HOUR                 ; : Hours since midnight (0 - 23)
       .DS     TM.MDAY                 ; : Day of month (1 - 31)
       .DS     TM.MON                  ; : Month of year (1 - 12)
       .DS     TM.YEAR                 ; : Years since 1900 (72 - 199)
       .DS     TM.WDAY                 ; : Days since Sunday (0 - 6)
       .DS     TM.YDAY                 ; : Days since January 1st (0 - 365)
       .DS     TM.ISDST                ; : Daylight Savings Time flag
       .DS     TM.GMT  2               ; : Seconds east of Greenwich
       .DS     TM.TZ                   ; : Time zone code
       .DS     TM.TICKS                ; : Ticks into a second (0 - 59)
       .SBTTL  Miscellaneous Definitions

; Define the globals

       .GLOBL  $SYSLB
       .GLOBL  $ARGER
       .GLOBL  $NXADR

; Define any conditionals

       .IIF NDF FT.EIS FT.EIS = 0      ;By default, don't use EIS
       .SBTTL  Revision and Copyright string for images

       .PSECT  .COPY.  RO,D

       .NLCSI  TYPE=I
       .ASCII  /Copyright (c) 2000 Megan Gentry/<15><12>
       .SBTTL  MKTIME  - Convert TM Array to RT-11 date/time block

;+
;
; MKTIME
;       This fortran-callable subroutine is modelled after the U*x
;       library routine mktime(), and is designed to take selected
;       contents of a TM Array and and fill an RT-11 date/time
;       block with the converted date and time information.
;
; Call:
;
;       CALL MKTIME ( TM , DATMBK )
;
;    where:
;       TM      is an INTEGER*2 array containing 13. entries which
;               contains the date and time to be converted (only
;               the TM.YEAR, TM.MON, TM.MDAY, TM.HOUR, TM.MIN, TM.SEC
;               and TM.TICKS entries are used for the conversion).
;
;               TM[0]   Seconds after the minute [0-59]
;               TM[1]   Minutes after the hour [0-59]
;               TM[2]   Hours since midnight [0-23]
;               TM[3]   Day of the month [1-31]
;               TM[4]   Month of the year [0-11]
;               TM[5]   Years since 1900 [0-199]
;
;       The following entries are not used in the conversion.
;
;               TM[6]   Days since Sunday [0-6]
;               TM[7]   Days since January 1 [0-365]
;               TM[8]   Daylight Savings Time flag
;               TM[9]   Seconds east of Greenwich (lo-order word) <future>
;               TM[10]  Seconds east of Greenwich (hi-order word) <future>
;                         (negative indicates west of Greenwich)
;               TM[11]  Time Zone code                            <future>
;
;       The following entry is used in the conversion
;
;               TM[12]  Ticks into second [0-59]
;
;       DATMBK  is an INTEGER*2 array containing 3. entries which will
;               be filled with the RT-11 formatted date and time as
;               follows:
;
;                       +----------+
;                       |   date   | [0] DTM.DT (16 bits, EEMMMMDDDDDYYYYY)
;                       +----------+
;                       | time, hi | [2] DTM.TM + TIM.HI
;                       +          +
;                       | time, lo | [4] DTM.TM + TIM.LO
;                       +----------+
;
; Return:
;       If there is no error, the DATMBK contains an RT-11 formatted
;       date and time.
;
; Errors:
;       o Insufficient arguments
;       o Invalid information in the TM Array
;
; Notes:
;       o This module was designed from the standpoint of producing
;         a date/time value specified in whatever form is appropriate
;         for the system.  This is why we don't use the U*x style 32-bit
;         integer containing seconds since Jan 1, 1900.
;
;       o The base year of the RT-11 Epoch is 1972, so dates prior
;         to 1972 cannot be converted.
;
;-

       .GLOBL  MKTIME

       .PSECT  SYS$I,I

       .ENABL  LSB

ERROR:  MOV     #$ARGER,R0
       SEC
       RETURN

MKTIME::
       MOV     (R5)+,R4                ;R4 = Argument count

       CALL    $NXADR                  ;Get first argument (-> TM Array)
       BCS     ERROR                   ;None specified!
       MOV     R0,R1                   ;R1 -> TM Array

       CALL    $NXADR                  ;Try for pointer to date/time block
       BCS     ERROR                   ;None specified!
       MOV     R0,R4                   ;R4 -> RT-11 Date/Time block

       CALL    TMVAL                   ;Validate the TM Array
       BCS     ERROR                   ;Information was invalid

; We have to do double precision here since the largest value can
; be 5183999. (60 ticks * 60 seconds * 60 minutes * 24 hours - 1 tick)
;       5183999 = 79 (*65536) + 6655.

       CLR     R2                      ;Clear high-order time
       MOV     TM.HOUR(R1),R3          ;Start with hours
       MOV     #60.,R0                 ;R0 = Minutes per hour
       CALL    DIMULT                  ;Do the multiplication (R0 * R2,R3)
       ADD     TM.MIN(R1),R3           ;Add in minutes
       ADC     R2                      ; in double-precision
       BCS     ERROR                   ;Overflow...
       MOV     #60.,R0                 ;R0 = Seconds per minute
       CALL    DIMULT                  ;Do the multiplication (R0 * R2,R3)
       ADD     TM.SEC(R1),R3           ;Add in seconds
       ADC     R2                      ; in double-precision
       BCS     ERROR                   ;Overflow...
       MOV     #60.,R0                 ;R0 = Ticks per second
       CALL    DIMULT                  ;Do the multiplication (R0 * R2,R3)
       ADD     TM.TICKS(R1),R3         ;Add in ticks
       ADC     R2                      ; in double-precision
       BCS     ERROR                   ;Overflow

; Here we validate the resulting time.  The time is patently invalid
; if the hi-order portion is greater than 79.  If it exactly equals 79,
; then the low order can be no larger than 6655.

       CMP     R2,#79.                 ;Is time invalid?
       BHI     ERROR                   ;Clearly yes...
       BLO     30$                     ;Clearly no...
       CMP     R3,#6655.               ;Maybe... Check lo-order limit...
       BHI     ERROR                   ;Clearly yes...
30$:

; Time is validated, lets put it in the supplied structure

       MOV     R2,<DTM.TM+TIM.HI>(R4)  ;Store high-order time
       MOV     R3,<DTM.TM+TIM.LO>(R4)  ;Store lo-order time

; Now we assemble an RT-11 date

       MOV     TM.MON(R1),R3           ;R3 = Month of year
       INC     R3                      ;Convert from range 0-11 to 1-12

       .IF EQ FT.EIS
       SWAB    R3                      ;Shift month into position
       ASL     R3                      ; ...
       ASL     R3                      ; ...
       .IFF ;EQ FT.EIS
       ASH     #<DA$MON>,R3            ;Shift month into position
       .ENDC ;EQ FT.EIS

       MOV     TM.MDAY(R1),R2          ;R2 = Day of month

       .IF EQ FT.EIS
       SWAB    R2                      ;Shift day into position
       ASR     R2                      ; ...
       ASR     R2                      ; ...
       ASR     R2                      ; ...
       .IFF ;EQ FT.EIS
       ASH     #<DA$DAY>,R2            ;Shift it into position
       .ENDC ;EQ FT.EIS

       BIS     R2,R3                   ;Merge with month

       MOV     TM.YEAR(R1),R2          ;R2 = Years since 1900
       ADD     #1900.,R2               ;R2 = Actual year
       SUB     #<DA.YR0>,R2            ;Subtract base of RT-11 Epoch
       BLT     ERROR                   ;Error if less than the base
       MOV     R2,R0                   ;Make a copy of it
       BIC     #^C<DA.YR>,R2           ;Isolate the year offset
       BIS     R2,R3                   ;Merge with day and month
       BIC     #<DA.YR>,R0             ;Isolate the epoch bits

       .IF EQ FT.EIS
       ASL     R0                      ;Shift epoch bits into position
       SWAB    R0                      ; ...
       .IFF ;EQ FT.EIS
       ASH     #<DA$AGE-DA$DAY>,R0     ;Shift epoch bits into position
       .ENDC ;EQ FT.EIS

       BIS     R0,R3                   ;Merge with day, month and year offset

       .Assume DTM.DT EQ 0
       MOV     R3,@R4                  ;Store converted date

       CLC                             ;Return success
       RETURN

       .DSABL  LSB
       .SBTTL  TMVAL   - Validates TM Array

;+
;
; TMVAL
;       Examines the contents of the TM Array and verifies that
;       each entry is within valid ranges.
;
; Call:
;       R1 -> TM Array
;
; Return:
;       All registers unaffected
;       C-bit clear, TM Array (portion we need) is valid
;       C-bit set, TM Array (portion we need) contains invalid information
;
; Notes:
;       o We could be pedantic about it and verify that the day field
;         is correct for a given month and year (accounting for leap
;         years), but then the routine would not be as general-purpose.
;
;-

       .PSECT  SYS$I,I

TMVAL:  MOV     R0,-(SP)                ;Save a few registers while
       MOV     R2,-(SP)                ; we use them
       MOV     #TMVTAB,R0              ;R0 -> TM Array validation table
10$:    CMP     @R0,#-1                 ;End of table?
       BEQ     30$                     ;Yep, TM array is okay
       MOV     R1,R2                   ;R2 -> Base of TM Array
       ADD     @R0,R2                  ;R2 -> Entry to check
       CMP     @R2,2(R0)               ;Is it lower than the minimum?
       BLT     20$                     ;Yes...
       CMP     @R2,4(R0)               ;No, is it higher than the maximum?
       BGT     20$                     ;Yes...
       ADD     #6,R0                   ;Nope, this TM Array offset was okay,
       BR      10$                     ; on to the next one...

20$:    SEC                             ;TM Array did not validate
       BR      40$

30$:    CLC                             ;TM Array validated okay
40$:    MOV     (SP)+,R2                ;*C* Restore
       MOV     (SP)+,R0                ;*C*  previously saved registers
       RETURN
       .SBTTL  DIMULT  - Double Precision Integer Multiply

;+
;
; DIMULT
;       Performs a double-precision integer multiply
;
; Call:
;       R2,R3 contain double-precision multiplicand
;       R0    contains single-precision multiplier
;
; Return:
;       PSW<C> = 0
;               R2,R3 contain double-precision product (32 bits)
;       PSW<C> = 1
;               overflow occurred
;
; Note:
;       o We don't check for multiplier of zero, since we know it
;         will always be some value (60.)
;       o We don't check for multiplicand of zero, since we don't
;         care
;
;-

       .PSECT  SYS$I,I

       .ENABL  LSB

DIMULT:
       CLR     -(SP)                   ;Reset lo-order product
       CLR     -(SP)                   ; and hi-order product
       BR      20$

10$:
       .IF EQ FT.EIS
       ASL     R3                      ;Double-precision shift multiplicand
       ROL     R2                      ; ...
       .IFF ;EQ FT.EIS
       ASHC    #1,R2                   ;Double-precision shift multiplicand
       .ENDC ;EQ FT.EIS

       BCS     40$                     ;Overflow (w/stacked items)

20$:    ASR     R0                      ;Shift multiplier right
       BCC     30$                     ;No addition required...

       ADD     R3,2(SP)                ;Add lo-order intermediate to product
       ADC     @SP                     ; w/carry
       ADD     R2,@SP                  ;Add hi-order intermediate to product
       BCS     40$                     ;Overflow (w/stacked items)

30$:    TST     R0                      ;More to do?
       BNE     10$                     ;Yes if non-zero...
       MOV     (SP)+,R2                ;Return hi-order product
       MOV     (SP)+,R3                ; and lo-order product
       CLC
       BR      50$                     ;Nope, we're all done...

40$:    CMP     (SP)+,(SP)+             ;Dump invalid product from stack
       SEC                             ;Failure due to overflow
50$:    RETURN

       .DSABL  LSB
       .SBTTL  Pure Data

       .PSECT  SYS$D,D

; TM Array validation table
;       First word is TM Array offset to check
;       Second word is lower limit
;       Third word is upper limit

TMVTAB: .WORD   TM.TICKS, 0, 59.
       .WORD   TM.SEC, 0, 59.
       .WORD   TM.MIN, 0, 59.
       .WORD   TM.HOUR, 0, 24.
       .WORD   TM.MDAY, 1, 31.
       .WORD   TM.MON, 0, 11.
       .WORD   TM.YEAR, 0, 199.
       .WORD   -1      ; ** Table Fence **

       .END

You are viewing proxied material from gopher.quux.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.