         SYSTEM   SIG7
JULIAN:  CSECT    1
         DEF      JULIAN:
**
**                DEFINE STANDARD REGISTERS AND CONDITION CODES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         TITLE    'JULIAN DATE CONVERSION SUBROUTINE'
         PAGE
**
** CONVFRT TIME AS RETURNED BY M:TIME TO 2 WORD JULIAN DATE
**
** RETURN RESULT IN SR1 AND SR2 AS X'YYYY0DDD''HHMM0000'  PACKED DEC
**
**                  LI,SR3   TIME   LOCATION OF 4 WORD DATE/TIME
** CALLING SEQ IS   BAL,SR4  JULIAN
**
JULIAN   EQU      %
         DEF      JULIAN
         DEF      MONTHS
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         STW,R0   SR2
         LB,D1    *SR3,R1           2ND BYTE OF HR
         SLD,D1   -4                SAVE IN D2
         LB,D1    *SR3
         SLD,D1   4
         STB,D1   SR2               HR IS BYTE 0 OF SR2
         LI,R4    4
         LB,D1    *SR3,R4           MINUTE
         SLD,D1   -4
         LB,D1    *SR3,R3
         SLD,D1   4
         STB,D1   SR2,R1            2ND BYTE OF SR2
         AI,SR3   1                 LOCATE SECOND WORD OF TIME
         LH,D1    *SR3,R1           2ND HALF OF WORD IS PART OF MONTH
         AI,SR3   1
         LW,D2    *SR3              3RD WORD OF TIME
         SLD,D1   16
         LW,D2    MSK
         LI,R4    12                CONVERT MONTH TO ACCUMULATED DAYS
ADDAYS   CS,D1    MONTHS,R4
         BE       FOUND
         LI,D4    X'FF'
         LS,D4    MONTHS,R4            DAYS IN THE MONTH
         AW,R0    D4
         BDR,R4   ADDAYS
FOUND    LW,D4    *SR3              DEFAULT MONTH IS DEC -- SAVE DAY D4
         AI,SR3   1                 LAST WORD OF TIME IS YY
         LI,R4    X'19'
         STB,R4   SR1
         LB,D1    *SR3,R3           BYTE 3 OF WORD 4 = 2ND BYTE OF YR
         SLD,D1   -4                SAVE IN D2
         LB,D1    *SR3,R2           FIRST BYTE OF YEAR
         SLD,D1   4
         STB,D1   SR1,R1            SAVE YEAR
** DETERMINE IF YEAR IS LEAP YR
         CI,R0    59
         BL       NOT:LP
         SLS,D1   4
         LC       D1,R3
         BCS,1    NOT:LP            ODD YEAR
         LC       SR1,R1
         BCS,1    ODD:DC            ODD DECADE
         LC       D1,R3
         BCS,2    NOT:LP
YES:LP   AW,R0    R1
         B        NOT:LP
ODD:DC   LC       D1,R3
         BCS,2    YES:LP
NOT:LP   EQU      %
** ADD DAYS OF THIS MONTH
         LB,D2    D4,R2             HIGH BYTE OF DAY
         AND,D2   SEVEN
         MI,D2    10
         AND,D4   =X'F'
         AW,R0    D2
         AW,R0    D4
** CONVERT BINARY DAYS TO DECIMAL
         LW,D2    R0
         LI,D1    0
         DW,D1    HUNDRED
         STB,D2   SR1,R2            HOW MANY HUNDRED DAYS
         LI,D2    0
         XW,D2    D1
         DW,D1    TEN
         SLS,D2   4                 TENS
         AW,D2    D1                + UNITS
         STB,D2   SR1,R3            =DAYS
         B        *SR4
MONTHS   DATA     X'FFFFFF00'
         GEN,24,8 C'DEC',0
         GEN,24,8 C'NOV',30
         GEN,24,8 C'OCT',31
         GEN,24,8 C'SEP',30
         GEN,24,8 C'AUG',31
         GEN,24,8 C'JUL',31
         GEN,24,8 C'JUN',30
         GEN,24,8 C'MAY',31
         GEN,24,8 C'APR',30
         GEN,24,8 C'MAR',31
         GEN,24,8 C'FEB',28
         GEN,24,8 C'JAN',31
MSK      EQU      MONTHS
SEVEN    DATA     7
TEN      DATA     10
HUNDRED  DATA     100
         END

