*   M:TIME RETURNS THE TIME AND DATE TO THE USER IN A
*   FOUR-WORD BLOCK WHHOSE ADDRESS THE USER SUPPLIES.
*   THE ADDRESS IS CHECKED FOR VALIDITY AND A USER TRAP
*   WILL OCCUR IF THE ADDRESS IS INVALID.
*
*   WHEN M:TIME IS ENTERED:
*        REGISTER 5 CONTAINS ADDRESS OF JIT
*        REGISTER 6 CONTAINS ADDRESS OF USER'S FOUR-WORD BLOCK
*        REGISTER 7 CONTAINS ADDRESS OF USER'S FPT
*        REGISTER SR4 (R11) CONTAINS THE RETURN ADDRESS
*
*   'TIME' CONTAINS THE HOUR IN THE HIGH-ORDER HALF-WORD,
*        AND THE MINUTE IN THE LOW-ORDER HALF-WORD.  (IN EBCDIC)
*   'DATE' (TWO WORDS) CONTAINS THE MONTH IN THE HIGH-ORDER HALF-WORD,
*        AND THE DAY IN THE LOW-ORDER HALF-WORD OF THE FIRST WORD.
*        THE SECOND WORD CONTAINS THE YEAR IN THE LOW-ORDER HALF-WORD.
*        ALL THESE ITEMS ARE IN EBCDIC.
*   '1MIN' CONTAINS 50 MINUS THE NUMBER OF 1/50TH'S OF A MINUTE SINCE
*        THE LAST MINUTE.  (IN BINARY)
*   'SYSICBTUN' CONTAINS THE NUMBER OF CLOCK TICKS IN 1/50 MINUTE.
*        I.E., 600, SINCE A CLOCK TICK IS 2 MILLISECONDS.
*   'SYSICBCLK' CONTAINS SYSICBTUN MINUS THE NUMBER OF CLOCK TICKS
*        BETWEEN THE LAST 1/50 MINUTE AND THE LAST CLOCK-ZERO
*        INTERRUPT.
*   'C:CTUN' CONTAINS THE NUMBER OF CLOCK TICKS IN THE CURRENTLY-
*        ACTIVE CLOCK INTERVAL.
*   'C:TINC' CONTAINS C:CTUN MINUS THE NUMBER OF CLOCK TICKS SINCE
*        THE LAST CLOCK-ZERO INTERRUPT. THE CLOCK'S MTW INSTRUCTION
*        WORKS ON C:TINC.
*
*   TIME AND DATE ARE GIVEN TO THE USER AS FOLLOWS:
*                 HH:MM MON DD,'YY
*
*  IF 'TUN' (TIMER UNITS)WAS SPECIFIED IN THE M:TIME CALL
*   BIT 8 IS SET ON IN THE FPT SIGNIFYING THAT THE FOLLOWING
*   ADDITIONAL INFORMATION IS TO BE RETURNED TO THE USER
*   IN SR1,SR2,AND SR3, ALL IN BINARY:
*

*   SR1 - YEAR IN HIGH-ORDER HALF-WORD
*         JULIAN DAY IN LOW-ORDER HALF-WORD
*   SR2 - HOUR IN BYTE ZERO
*         MINUTE IN BYTE 1
*         SECOND IN BYTE 2
*         TIMER UNITS (TWO-MILLISECOND INTERVALS SINCE THE
*         LAST WHOLE SECOND) IN BYTE THREE
*   SR3 - THOUSANDTHS OF A MINUTE SINCE THE LAST WHOLE MINUTE
*
*
*
*   .   .   .   .   F   T   F   U   CONVERTING TWO EBCDIC
* * 0   0   0   0   0   1   0   A   CHARACTERS TO BINARY BY
* --------------------------------  MULTIPLYING BY X'10A':
*   .   .   .   .   6   9   6   0
* + .   .   .   .  ( T*A ) ( U*A )  FIRST MULTIPLY BY X'10A',
* + .   .   F   0   F   0           THEN SHIFT RIGHT 8,
* + .   .   0   T   0   U           THEN SUBTRACT X'59'.
* --------------------------------  NOTE: X'60'+(U*A) IS NO MORE
*   .   .   .   .   5   9   6   0    THAN X'BA', SINCE U IS NO
* + .   .   .   .  (T*A+U) ( U*A )   MORE THAN 9 AND 9*A=5A.
*
         PAGE
         SYSTEM   UTS
         DEF      TIM,TIMSZ
         DEF      MTIME
         REF      T:ABORTM
         REF      S:CUN,UH:FLG
         REF      T:IACU
         REF      DATE,TIME,1MIN
         REF      M8,M17,Y008
         REF      C:CTUN,C:TINC,SYSICBTUN,SYSICBCLK
          PAGE
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
*
         PAGE
*
MTIME    EQU      %
TIM      EQU      %
         LW,R3    -1,R7             R3= 'TMS' FLAG. (FOR LATER TEST).
         LW,R4    SR4               R4= RETURN ADDRESS.
         AND,R6   M17               R6= USER'S FOUR-WORD BLOCK ADDRESS
         BEZ      ADDROKAY          ---> ZERO MEANS NO BLOCK.
         LW,R7    S:CUN
         LH,R7    UH:FLG,R7
         CI,R7    SJAC              IF USER HAS SPECIAL JIT ACCESS,
         BANZ     ADDROKAY          ---> BLOCK ADDRESS MUST BE OKAY.
         LW,7     6
         SLS,7    -9
         BAL,11   T:IACU
         BCS,3    TIMERR
         LW,7     6
         AI,7     3
         SLS,7    -9
         BAL,R11  T:IACU            SEE IF BLOCKEND ADDR IS VALID.
         BCR,3    ADDROKAY          ---> BLOCKEND ADDR IS VALID.
TIMERR   EQU      %
         LI,R14   X'4A'             BAD BLOCK ADDRESS.  SET ERROR CODE
         B        T:ABORTM        -----> AND ABORT USER.
         PAGE
ADDROKAY EQU      %         INHIBIT INTERRUPTS WHILE GETTING RAW DATA:
         DISABLE                     R12  R13  R14  R15  R0
         LW,R12   TIME              HHMM
         LW,R13   DATE              HHMM MMDD
         LW,R14   DATE+1            HHMM MMDD   YY
         LCW,R15  1MIN                (1MIN COUNTS 50->1 IN A MINUTE)
         AI,R15   50                HHMM MMDD   YY 1/50
         LW,R0    SYSICBTUN           (SYSICBTUN-SYSICBCLK IS # OF 2MS
         SW,R0    SYSICBCLK            FROM 1/50-MIN TO CLOCK-ZERO)
         AW,R0    C:CTUN              (C:CTUN-C:TINC IS # OF 2MS FROM
         SW,R0    C:TINC               CLOCK-ZERO TO RIGHT NOW)
         ENABLE                     HHMM MMDD   YY 1/50 2-MS
         LI,R1    X'10A'              THIS CUTE LITTLE SET OF CODE
         MH,R1    R13                 CONVERTS MONTH (MM) EBCDIC
         SLS,R1   -8                  INTO MONTH-NUMBER BINARY
         AI,R1    -X'59'              IN REGISTER 1.
         AND,R1   M8                HHMM MMDD   YY 1/50 2-MS MON#
*                                    R12  R13  R14  R15  R0   R1
*
         AI,R6    0                 SEE IF USER HAS A FOUR-WORD BLOCK.
         BEZ      NOBLOCK           ---> NO.
*   SHUFFLE TIME AND DATE AROUND TO LOAD USER'S FOUR-WORD BLOCK.
*                                    R8   R9   R10  R11
         INT,R11  R14               .... .... .... 00YY
         AW,R11   L(','''**16)      .... .... .... ,'YY
         LW,R10   R13               .... .... MMDD ,'YY
         LW,R9    MONTHS,R1         .... MON  MMDD ,'YY
         STH,R9   R10               .... MON  N DD ,'YY
         SLD,R8   +16               ..MO N 00 N DD ,'YY
         LW,R9    R12               ..MO HHMM N DD ,'YY
         SLD,R8   +16               MOHH MM00 N DD ,'YY
         AI,R9    ' :'              MOHH MM : N DD ,'YY
         SCS,R9   -8                MOHH :MM  N DD ,'YY
         SCD,R8   +16               HH:M M MO N DD ,'YY
         LCI      4                  R8   R9   R10  R11
         STM,R8   0,R6              USER'S FOUR-WORD BLOCK IS LOADED.
         PAGE
*                                   HHMM MMDD   YY 1/50 2-MS MON#
NOBLOCK  EQU      %                  R12  R13  R14  R15  R0   R1
*
         CW,R3    Y008              SEE IF USER REQUESTED 'TMS'.
         BAZ      EXIT              ---> NO.
*    FIX UP DATE AND TIME TO LOAD USER'S SR1 - SR3.
*
         LW,R3    R13                 THIS CUTE LITTLE SET OF CODE
         MI,R3    X'10A00'            CONVERTS DAY (DD) EBCDIC
         LH,SR1   R3                  INTO DAY-NUMBER BINARY
         AI,SR1   -X'59'              IN SR1.
         AND,SR1  M8                SR1(16-31)= DAY OF MONTH.
         AH,SR1   CALEN,R1          SR1(16-31)= DAY OF YEAR.
         LW,R3    R14                 THIS CUTE LITTLE SET OF CODE
         MI,R3    X'10A00'            CONVERTS YEAR (YY) EBCDIC
         LH,R3    R3                  INTO YEAR-NUMBER BINARY
         AI,R3    -X'59'              IN R3.
         AND,R3   M8
         STH,R3   SR1               SR1(00-15)= YEAR.
         CI,R3    3                 NOW IT'S TIME FOR LEAPYEAR CHECK:
         BANZ     NOLEAP            ---> YEAR NOT DIV BY 4; NOT LEAP.
         CI,R1    3
         BL       NOLEAP            ---> JAN OR FEB; NOT FEB29 YET.
         AI,SR1   1                 LEAPYEAR; BUMP DAY BY ONE.
NOLEAP   EQU      %
         MI,R15   600               CONVERT 1/50-MIN UNITS TO 2MS.
         AW,R15   R0                R15= # 2MS SINCE LAST MINUTE.
         LW,R1    R15
         LI,R0    0                 R1 = # 1/1000-MIN SINCE LAST MIN.
         DW,R0    L(30)             R0 = # 2MS SINCE LAST 1/1000 MIN.
         DH,R15   L(500**16)        R15= # SECONDS SINCE LAST MINUTE.
         LW,SR2   R0                SR2(24-31)= 2MS SINCE 1/1000 MIN.
         SLS,R15  +8
         AW,SR2   R15               SR2(16-23)= SECONDS.
         LW,SR3   R1                SR3(00-31)= 1/1000-MIN SINCE MIN.
         LW,R3    R12                 THIS CUTE LITTLE SET OF CODE
         MI,R2    X'10A00'            CONVERTS HOUR-MINUTE (HHMM)
         SLS,R3   +8                  EBCDIC INTO HOUR BINARY AND
         SLD,R2   +8                  MINUTE BINARY IN
         AI,R2    -X'5A59'            R2(16-23) AND R2(24-31).
         STH,R2   SR2               SR2(00-07)= HOUR.
*                                   SR2(08-15)= MINUTE.
         LW,R1    TSTACK
         LCI      3
         STM,SR1  SR1-15,R1         USER'S SR1-SR3 ARE LOADED.
*
EXIT     EQU      %
         LW,SR4   R4                RESTORE RETURN ADDRESS TO SR4.
         DESTRUCT                 -----> FINISHED. EXIT.
         PAGE
*
MONTHS   EQU      %-1
         TEXT     'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
CALEN    DATA,2   0,0,31,59,90,120,151,181,212,243,273,304,334
         BOUND 4
TIMSZ    EQU      TIMEND-TIM
TIMEND   END

