         PCC      0
*M*      TIM      PROCESS M:TIME CAL
         SPACE    1
*P*      NAME:    MTIME
*P*      PURPOSE:
*P*               TO PROCESS THE M:TIME SERVICE CALL
*P*      REFERENCE:
*P*               REPORTS F &D
         SPACE    1
*F*      NAME:    MTIME
*F*      PURPOSE:
*F*               TO RETURN TIME AND DATE IN EBCDIC AND/OR
*F*               TIME AND DATE IN BINARY INCLUDING RESOLUTION
*F*               DOWN TO BASIC TIMER UNITS
*F*      DESCRIPTION:
*F*           1.  TO RETURN THE TIME AND DATE TO THE USER
*F*               IN A FOUR WORD BLOCK WHOSE ADDRESS IS SUPPLIED
*F*               BY THE USER.  THE ADDRESS CANT BE IN THE
*F*               REGISTERS AND MUST BE VALID UNLESS THE
*F*               USER HAD SPECIAL JIT ACCESS.  AN INVALID
*F*               ADDRESS WILL CAUSE THE USER TO BE ABORTED.
*F*                   TIME AND DATE GIVEN IN EBCDIC
*F*                         HH:MM MON DD,'YY
*F*                   WD0  HH:M
*F*                   WD1  M MO
*F*                   WD2  N DD
*F*                   WD3  ,'YY
*F*           2.  AND/OR TO RETURN ADDITIONAL INFORMATION
*F*               TO THE USER IF 'TMS' HAS BEEN SPECIFIED ON HIS CALL.
*F*               THIS INFORMATION IS RETURNED IN THE USERS REGISTERS
*F*               8-10 (SR1-SR3) IN BINARY*
*F*                    R8 (SR1) - YEAR LEFT HALFWORD
*F*                               JULIAN DAY RIGHT HALFWORD
*F*                    R9 (SR2) - HOUR BYTE 0
*F*                               MINUTE BYTE 1
*F*                               SECOND BYTE 2
*F*                               TIMER UNITS  BYTE 3
*F*                                (2 MS INTERVALS SINCE LAST WHOLE SEC)
*F*                    R10 (SR3) - THOUSANDTHS OF A MINUTE SINCE LAST
*F*                                WHOLE MINUTE
*F*      REFERENCE:
*F*               SEE REPORT D
         PAGE
*D*      NAME:  MTIME
         SPACE    1
*D*      REGISTERS:
*D*               R11 LINK REGISTERS PRESERVED
*D*               ALL OTHER REGISTERS VOLATILE
         SPACE    1
*D*      CALL:
*D*               MTIME RESIDES IN MISOV OVERLAY
*D*               INITIAL CAL DECODING PERFORMED IN ALTCP
*D*               CAUSING ENTRANCE TO UCAL AND AN
*D*               IMMEDIATE BRANCH TO MTIME
         SPACE    1
*D*      INTERFACE:
*D*               T:IACU -  TO VALIDATE THE ACCESS PROTECTION
*D*               ON THE FOUR WORD BLOCK
*D*                    R7 CONTAINS VIRTUAL PAGE #
*D*                    UPON RETURN CC3&4 CONTAIN THE ACCESS
*D*                    PROTECTION OF THE VIRTUAL PAGE
         SPACE    1
*D*      ENVIRONMENT:
*D*               MAPPED,MASTER MODE
*D*               IHIBITS INTERRUPTS WHILE GETTING RAW DATA
         SPACE    1
*D*      INPUT:
*D*               R6 - THE ADDRESS OF THE FOUR WORD BLOCK
*D*               R7 - THE ADDRESS OF THE USER'S FPT
*D*               R11 - THE LINK ADDRESS
         SPACE    1
*D*      OUTPUT:
*D*               TIME AND DATE IN EBCDIC IN THE FOUR WORD BLOCK
*D*               TIME AND DATE IN BINARY IN THE USERS REGISTER 8-10
*D*                   IN THE TSTACK IF REQUESTED
         SPACE    1
*D*      DESCRIPTION:
*D*               UPON ENTRY THE 4 WORD BLOCK IF SPECIFIED IS
*D*               VALIDATED THROUGH A CALL TO T:IACU UNLESS THE
*D*               USER HAS SPECIAL JIT ACCESS.
*D*               IF THE ADDRESS IS INVALID THEN THE USER IS
*D*               ABORTED THROUGH A EXIT TO T:ABORTM
*D*               OTHERWISE THE INTERRUPTS ARE DISABLED WHILE THE
*D*               RAW DATA IS COLLECTED .  SEE REPORT X FOR
*D*               DATA CELL DESCRIPTION
*D*               THE CONVERSIONS OF TIME AND DATE ARE THEN PERFORMED
*D*               AND STORED INTO THE 4 WORD BLOCK IF SPECIFIED.
*D*               IF 'TMS' (BIT 8 OF THE FPT  IS SET) HAS BEEN
*D*               SPECIFIED THEN THE CONVERSION TO BINARY IS PERFORMED
*D*               AND STORED INTO THE USERS R8-R10 IN
*D*               THE TSTACK
*D*               A DESTRUCT EXIT IS MADE FROM THE MODULE
         SPACE    3
*E*      ERROR:   4A00
*E*      MESSAGE: SPECIFIED BUFFER DOES NOT BELONG TO USER
*E*      DESCRIPTION:
*E*               ACCESS PROTECT VIOLATION ON THE 4 WORD BLOCK
         PAGE
*        ALGORITHM FOR CONVERTING EBCDIC TO BINARY
*
* * 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
UFLAGS   EQU      1                 FOR SYSTEM UTS
         SYSTEM   UTS
*        DEFS
*
         DEF      TIM:              PATCHOING DEF
TIM:     RES
         DEF      MTIME             ENTRY USED WHEN CALLING ROUTINE
         SPACE    2
*        REFS
         REF      TSTACK            TSTACK
         REF      T:ABORTM          ABORT EXIT FOR INVALID BLOCK
         REF      S:CUN             CURRENT USER #
         REF      UH:FLG            SJAC BIT (X1000)
         REF      T:IACU            ROUTINE TO VALIDATE ACCESS PROTECT
         REF      M8                MASK
         REF      M17               MASK
         REF      Y008              MASK
         SPACE    1
*        REFS FOR RAW DATA
*
         REF      DATE              (TWO WORDS)- CONTAINS
*,*                                 WD1 MONTH LEFT HALF WORD
*,*                                         DAY RIGHT HALF WORD
*,*                                 WRD2  YEAR RIGHT HALFWORD
*,*                                 ALL IN EBCDIC
         REF      TIME              HOUR IN LEFT HALF WORD
*,*                                 MINUTE IN RIGHT HALF WORD
*,*                                 IN EBCDIC
         REF      1MIN              CONTAINS 50 MINUS THE NUMBER OF
*,*                                 1/50THS OF A MINUTE SINCE LAST
*,*                                 MINUTE - IN BINARY
         REF      C:CTUN            CONTAINS NUMBER OF CLOCK TICKS
*,*                                 IN THE CURRENTLY ACTIVE
*,*                                 CLOCK INTERVAL
         REF      C:TINC            CONTAINS C:CTUN MINUS THE NUMBER
*,*                                 OF CLOCK TICKS SINCE THE LAST
*,*                                 CLOCK-ZERO INTERRUPT. THE CLOCK'S
*,*                                 MTW WORKS ON C:TINC
         REF      SYSICBTUN         CONTAINS THE NUMBER OF CLOCK
*,*                                 TICKS IN 1/50 MINUTE,
*,*                                 I.E., 600 SINCE A CLOCK TICK IS 2 MS
         REF      SYSICBCLK         CONTAINS SYSICBTUN MINUS
*,*                                 THE NUMBER OF CLOCK TICKS BETWEEN
*,*                                 THE LAST 1/50 MINUTE AND THE LAST
*,*                                 CLOCK-ZERO INTERRUPT.
          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      %
         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
TIMEND   END

