ASMB,L,C
      HED TIME AND DATE TRANSLATION ROUTINE * (C) HEWLETT-PACKARD CO.1978 * 
      NAM TMDA,7,0 91780-16017 REV.1840 780725
      ENT TMDA,TMDA1,TMDA2
      EXT .ENTR,EXEC,.MVW 
* 
*     DATE:         780725
*     NAME:         TMDA
*     SOURCE:       91780-18019 
*     RELOC:        91780-16017 (PART OF) 
*     PGMR:         GARY E. MODRELL 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*     THIS ROUTINE RETURNS THE DATE IN DAY OF WEEK, MONTH,
*     DAY OF MONTH, AND YEAR, AND THE TIME IN HOURS, MINUTES, 
*     SECONDS, AND HUNDREDTHS OF SECONDS AS PACKED ASCII
*     CHARACTERS IN THE PROPER FORMAT.   THESE CHARACTERS 
*     ARE RETURNED IN A 16 WORD BUFFER. 
* 
*     PROPER USE: 
*           DIMENSION IA(16)
*           CALL TMDA(IA) 
*           WRITE (6,10) IA 
*     10    FORMAT(16A2)
* 
*     FOR EACH CALL TO TMDA, AN EXEC CALL (RCODE=11) IS MADE
*     THEN THE RETURNED VALUES FOR YEAR, DAY OF YEAR (1,366)
*     AND TIME ARE TRANSLATED; DAY OF YEAR TO MONTH-DAY, AND
*     THE NUMERIC DATA TO ASCII CHARACTERS AS SHOWN BELOW.
* 
*     ENTRY POINT TMDA1 IS USED TO TRANSLATE A PROVIDED TMVAL 
*     ARRAY RATHER THAN THE SYSTEM TIME.
* 
*     PROPER USE: 
*           DIMENSION IA(16),IDAT(6)
*           CALL TMDA1(IA,IDAT) 
*           WRITE (6,10) IA 
*     10    FORMAT(16A2)
* 
*     FOR EACH CALL TO TMDA1, THE CALLERS VALUE FOR YEAR,DAY
*     AND TIME ARE TRANSLATED; DAY OF YEAR TO MONTH-DAY, AND
*     THE NUMERIC DATA TO ASCII CHARACTERS IN THE FOLLOWING FORMAT: 
* 
*     CONTENTS:  MON JAN 01, 1973   16:02:19.53 
*     WORD #  :01020304050607080910111213141516 
* 
*     IF ERROR IN IDAT ARRAY, DATE "  SUN JAN 00, 1900   00:00:00.00" 
*     IS RETURNED.
*     THE ROUTINE IS NOT PRIVILEDGED SO IT IS RTE-IV COMPATABLE 
* 
BFAD  NOP           BUFFER ADDRESS
DAT   NOP           ADDR OF DATE TO BE TRANSLATED 
TMDA  NOP           ENTRY POINT 
      JSB .ENTR 
      DEF BFAD
      LDA DAT       GET 2ND ARG ADDR
      SZA           IS THERE TWO? 
      JMP TMD1      YES, TMDA1 ENTRY
      JSB EXEC      GET TIME OF DAY 
      DEF *+4 
      DEF D11 
DIMS  DEF IMS 
      DEF IYR 
      JMP TMD2
TMD1  LDB DIMS      A=ADDR OF SOURCE, B=ADDR OF DESTINATION 
      JSB .MVW      MOVE THE WORDS
      DEF D6        6 WORDS 
      NOP 
      CLA 
      STA DAT       CLEAR DAT FOR NEXT CALL 
TMD2  JSB DATE      CONVERT DATE
      SSA           CHECK FOR ERROR 
      JMP ERR       YES, DO ERROR EXIT
      BLS           GET TABLE ADDRESS 
      ADB DTBL3 
      DLD B,I       GET ASCII DAY OF WEEK 
      DST DW        STORE IN PROPER FORMAT
      LDA MO        NUMBER OF MONTH 
      ALS           GET TABLE ADDRESS 
      ADA DTBL2 
      DLD A,I       GET ASCII MONTH NAME
      DST MON       STORE IN PROPER POSITION
* 
*     NOW CONVERT DAY OF MONTH, YEAR, HOURS, MINUTES, SECONDS 
*     AND HUNDREDTHS OF SECONDS TO ASCII
* 
      LDA IMS       HUNDREDTHS OF SECONDS 
      JSB ACONV     CONVERT TO ASCII
      STA MS
      LDA IMN       MINUTES 
      JSB ACONV     CONVERT TO ASCII
      STA MN
      LDA DA        DAY OF MONTH
      JSB ACONV     CONVERT TO ASCII
      STA DAY 
      LDA IYR 
      CLB 
      DIV D100
      STB T1        HUNDREDS OF YEARS 
      JSB ACONV     CONVERT TO ASCII
      STA YR
      LDA T1        TENS & UNIT YEARS 
      JSB ACONV     CONVERT TO ASCII
      STA YR+1
      LDA IHR       HOURS 
      JSB ACONV     CONVERT TO ASCII
      LDB CNSP      GET COLON-SPACE IN B-REG
      RRR 8         POSITION CHARS
      DST HR        STORE INTO ASCII ARRAY
      LDA ISC 
      JSB ACONV     CONVERT TO ASCII
      LDB PDCN      GET ASCII PERIOD-COLON
      RRR 8         POSITION CHARS
      DST SC        STORE INTO ASCII ARRAY
      LDA DBUF      ADDR OF SOURCE
      LDB BFAD      ADDR OF DESTINATION 
      JSB .MVW      MOVE THE WORDS
      DEF D16       16 WORDS
      NOP 
      JMP TMDA,I    RETURN
* 
*     FOR ERROR RETURN USE JAN 00,1900 00:00:00.00
* 
ERR   CLA           ZERO TMVAL ARRAY
      STA IMS 
      STA ISC 
      STA IMN 
      STA IHR 
      STA IDA 
      STA IYR 
      JMP TMD2      DECODE ERROR VALUES 
* 
*     CONVERTS BINARY NUMBER IN A-REG (0-99)
*     TO TWO PACKED ASCII CHARACTERS RETURNED IN A
* 
ACONV NOP 
      CLB           PREPARE FOR DIVIDE
      DIV D10       RESULT A = TENS VALUE, B = UNITS VALUE
      ALF,ALF       POSITION TENS VALUE 
      IOR B         MERGE IN UNITS VALUE
      IOR ASB       MERGE IN ASCII BASE VALUE 
      JMP ACONV,I 
* 
*     DATE CONVERSION ROUTINE 
*     CONVERTS DAY OF YEAR (1-366) TO DAY OF WEEK,
*     MONTH, DAY OF MONTH, ACCOUNTING FOR ALL LEAP
*     YEARS.   CORRECT FOR ANY DATE AFTER JAN 00,1900 
*     UNTIL FEB 28,2100 
*     ON EXIT B-REG CONTAINS # OF DAY OF WEEK (0-6) 
*     DAY ON MONTH IN "DA" (1-31) 
*     MONTH NUMBER IN "MO" (1-12) 
*     IF A-REG = -1 ERROR 
* 
DATE  NOP 
      CLB 
      STB MO        MO=0
      LDA IYR       GET YEAR
      ADA MYB       SUBTRACT 1900 
      SSA           IF YEAR <= 1900 
      CLA           DEFAULT TO 1900 
      STA Y0        YEARS AFTER 1900
      SZA           IF Y0=0 SKIP NEXT STEP
      ADA M1        MINUS ONE FOR # PREV LP-YR
      DIV D4        DETERMINE # OF LEAP YEARS 
      STA NLP       SAVE # LEAP YEARS PREVIOUSLY
      CLA 
      CPB D3        YEAR ENTERED A LEAP YEAR? 
      CMA           YES, MAKE FEB HAVE 29 DAYS
      STA LPFLG     IF LP-YR, LPFLG=-1 ELSE =0
      LDA IDA       DAY OF YEAR (1-366) 
      LDB DTBL1 
L1    STA DA        SUBTRACT DAYS IN EACH MONTH 
      ADA B,I       UNTIL DAY COUNT NEG 
      CPB DTB11     IS MONTH FEB? 
      ADA LPFLG     YES, SUBTRACT EXTRA DAY 
      SZA 
      SSA 
      JMP OT1 
      INB           NEXT ADDR IN TABLE
      ISZ MO        MONTH # LEFT IN MO
      CPB DEND      DAY OF MONTH LEFT IN DA 
      JMP ERR1      ERROR IF MORE THAN 366 DAYS 
      JMP L1
OT1   CLE           DETERMINE DAY OF WEEK 
      LDA Y0        YEARS AFTER 1900
      MPY D365      DAYS AFTER JAN 0,1900 (RES=31 BIT INT)
      ADA NLP       ADD LEAP DAYS 
      SEZ 
      CLE,INB       CARRY OVERFLOW BIT
      ADA IDA       ADD DAYS THIS YEAR
      SEZ 
      INB           CARRY OVERFLOW BIT
      DIV D7        REMAINDER=NUMBER OF DAY OF WEEK (0-6) 
      JMP DATE,I    RETURN
* 
ERR1  CCA           SET A<0 FOR 
      JMP DATE,I    ERROR RETURN
      SKP 
* 
*     DECIMAL DATE ENTRY POINT
*     GIVEN ITIME ARRAY IT(6), THIS ROUTINE EXTRACTS THE JULIAN 
*     DAY OF YEAR [IT(5)], AND THE YEAR [IT(6)], AND RETURNS THE
*     DAY OF WEEK # (0-6, 0=SUNDAY), THE MONTH # (1-12), AND THE
*     DAY OF MONTH NUMBER (1-31) AS BINARY NUMBERS. 
*     USE:   INTEGER IT(6)
*            CALL EXEC(11,IT,IT(6)) 
*            CALL TMDA2(IT,IDOW,IMON,IDOM)
*     IF IT(5)=281  AND  IT(6)=1976 THE RETURNED VALUES WOULD BE
*     IDOW=4, IMON=10, & IDOM=7.
*     IF ERROR IN GIVEN IT ARRAY, IDOW SET = -1 
* 
* 
ADAT  NOP           ADDR OF TIME ARRAY
ADOW  NOP           ADDR FOR RETURN OF DAY OF WEEK
AMON  NOP           ADDR FOR RETURN OF MONTH NUMBER 
ADOM  NOP           ADDR FOR RETURN OF DAY OF MONTH NUMBER
TMDA2 NOP           ENTRY POINT 
      JSB .ENTR     GET ARG ADDRESSES 
      DEF ADAT
      LDA ADAT      GET ADDR OF START OF ITIME ARRAY
      ADA D4        COMPUTE ADDR OF ITIME(5)
      DLD A,I       GET ITIME(5) & ITIME(6) 
      STA IDA       STORE JULIAN DAY OF YEAR
      STB IYR       STORE JULIAN YEAR 
      JSB DATE      CONVERT DATE
      SSA           CHECK FOR ERROR 
      CCB           YES, SET B=-1 
      STB ADOW,I    RETURN DAY OF WEEK NUMBER (0-6) 
      LDA MO        GET MONTH NUMBER
      INA           CONVERT 0-11 TO 1-12
      LDB DA        GET DAY OF MONTH NUMBER 
      STA AMON,I    RETURN MONTH NUMBER 
      STB ADOM,I    RETURN DAY OF MONTH 
      JMP TMDA2,I   NORMAL RETURN 
* 
*     CONSTANTS & STORAGE 
* 
D3    DEC 3 
D4    DEC 4 
D6    DEC 6 
D7    DEC 7 
D10   DEC 10
D11   DEC 11
D16   DEC 16
D100  DEC 100 
D365  DEC 365 
M1    DEC -1
MYB   DEC -1900     -BASE YEAR
ASB   ASC 1,00      ASCII ZERO-ZERO 
CNSP  ASC 1,:       ASCII COLON-SPACE 
PDCN  ASC 1,.:      ASCII PERIOD-COLON
DA    OCT 0         DAY OF MONTH
MO    OCT 0         MONTH NUMBER (0-11) 
Y0    OCT 0         YEARS AFTER 1900
NLP   OCT 0         # LEAP YEARS AFTER 1900 
*                   6 WORD ARRAY - DO NOT SEPERATE
IMS   NOP           HUNDREDTHS OF SECONDS 
ISC   NOP           SECONDS 
IMN   NOP           MINUTES 
IHR   NOP           HOURS 
IDA   NOP           DAY OF YEAR (1-366) 
IYR   DEC 1900      YEAR (BINARY) 
* 
DBUF  DEF BUF 
BUF   ASC 1,        OUTPUT BUFFER 
DW    ASC 2,SUN 
MON   ASC 2,JAN 
DAY   ASC 1,00
      ASC 1,, 
YR    ASC 2,1900
      ASC 1,
HR    ASC 1, 0
      ASC 1,0:
MN    ASC 1,00
SC    ASC 1,:0
      ASC 1,0.
MS    ASC 1,00
* 
DTBL1 DEF TBL1      DAYS IN MONTH TABLE 
TBL1  DEC -31,-28,-31,-30,-31,-30 
      DEC -31,-31,-30,-31,-30,-31 
DEND  DEF TBL1+12 
DTB11 DEF TBL1+1
* 
DTBL2 DEF TBL2
TBL2  ASC 2,JAN     MONTH NAME TABLE
      ASC 2,FEB 
      ASC 2,MAR 
      ASC 2,APR 
      ASC 2,MAY 
      ASC 2,JUN 
      ASC 2,JUL 
      ASC 2,AUG 
      ASC 2,SEP 
      ASC 2,OCT 
      ASC 2,NOV 
      ASC 2,DEC 
* 
DTBL3 DEF TBL3
TBL3  ASC 2,SUN 
      ASC 2,MON 
      ASC 2,TUE 
      ASC 2,WED 
      ASC 2,THU 
      ASC 2,FRI 
      ASC 2,SAT 
* 
A     EQU 0 
B     EQU 1 
T1    EQU Y0
TMDA1 EQU TMDA
LPFLG EQU MS        LP YR FLAG
* 
LEN   EQU * 
      END 
                                                                                                                                                            