ASMB,R,Q,C
      HED TIME PRINT SUBROUTINE 
*     NAME:   ACLTM 
*     SOURCE: XXXXX-18XXX 
*     RELPC:  92067-16361 
*     PGMR:   G.A.A.,C.M.M.,J.M.N 
* 
*  ***************************************************************
* 
*     SOURCE PART NUMBER :92067-18397 
* 
*     RELOCATABLE PART NUMBER : 92067-16361 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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.       *
*  ***************************************************************
* 
      NAM ACLTM,7 92067-16361 REV.1940 780823 
      ENT ACLTM 
      EXT .ENTR 
*      CALLING SEQUENCE:
* 
*C     PUT THE DOUBLE PRECISION INTEGER IN ARRAY
*      CALL FTIME(ITIME,IBUF) 
* 
      SUP 
* 
*     GET TIME AND BUILD HEADER MESSAGE 
* 
A     EQU 0 
B     EQU 1 
O13   OCT 13
N1900 DEC -1900 
D12   DEC 12
B77   OCT 77
MD60  DEC -60 
DM12  DEC -12 
O30K  OCT 30000     ASCII 0 IN HIGH WORD
D1978 DEC 1978      YEAR OFFSET 
M1    OCT -1
"AM"  ASC 1,AM
"PM"  ASC 1,PM
O3    OCT 3 
* 
* 
P1    NOP 
P2    NOP 
ACLTM NOP 
      JSB .ENTR 
      DEF P1
* 
* 
      LDA P1,I      GET SECONDS MINUTES AND YEAR
      STA IYEAR 
      AND B77       SRTIP OFF MINUTES AND YEAR
      STA ISEC
      LDA IYEAR 
      ALF,ALF 
      RAL,RAL       POSITION MINUTES
      AND B77 
      STA IMIN
      LDA IYEAR 
      ALF           POSITION YEAR 
      AND B17 
      ADA D1978     ADD OFFSET
      STA IYEAR 
      ISZ P1
      LDA P1,I      GET HOURS AND DAYS
      AND B37       SRTIP OFF DAYS
      STA IHOUR 
      XOR P1,I
      ALF,ALF 
      ALF,RAR 
      ADA DM366     CHECK THE NUMBER OF DAYS
      SSA,RSS 
      CLA           IF TO MANY MAKE 366 
      ADA D366
* 
      STA IDAY
* 
* 
      LDA ISEC      GET SECONDS 
      JSB PD00
      IOR O30K      DON'T SUPPRESS LEADING ZEROS HERE 
      STA TMSG+3    PUT SECONDS IN MESSAGE
* 
      LDA IMIN      GET MINUTES 
      JSB PD00
      LDB "::"
      IOR O30K      DON'T SUPPRESS LEADING ZEROS HERE 
      RRR 8         B=1'S ":"  ,A= ":"  , 10'S
      DST TMSG+1    SET IN MESSAGE
      LDA IHOUR     GET HOURS 
      LDB "PM"      ASSUME PM FOR NOW 
      ADA DM12      IS IT 
      SSA,RSS       TEST AND ADJUST 
      JMP PM        YES 
* 
      LDB "AM"      NO USE AM 
      LDA IHOUR     RESTORE THE CORRECT HOUR
PM    SZA,RSS       IF ZERO USE 
      LDA D12       TWELVE
      STB TMSG+5    SET THE AM PM 
      JSB PD00
      STA TMSG      HOURS 
* 
      LDA IYEAR     GET YEAR
      ADA N1900     SUBTRACT THE HUNDREDS 
      JSB PD00      CONVERT THE YEAR
      STA TMSG+16   YEARS 
      LDB IDAY
      ADB MD60      -60 
      LDA IYEAR 
      AND O3
      SZA           SKIP IF LEAP YEAR 
      SSB 
      ADB M1        ADJUST FOR LEAP YEAR
      SSB 
      ADB D366
      ADB B37       DEC 31
      LDA B 
      RAL,RAL 
      ADA B         *5
      CLB 
      DIV D153
      STA ITIME     QUOTIENT=MONTH. 
      LDA B 
      CLB 
      DIV O5
      INA           GET DAY OF MONTH. 
      JSB PD00
      STA TMSG+10 
      LDB ITIME     RECOVER MONTH 
      BLS 
      ADB MOTBA 
      DLD B,I 
      DST TMSG+12 
      CCA           CALCULATE DAY OF WEEK.
      ADA IYEAR 
      ARS,ARS 
      ADA IYEAR 
      ADA IDAY
      CLB 
      DIV O7
      BLS 
      ADB DAYWK 
      DLD B,I 
      DST TMSG+7
      LDB DM17      SET WORD COUNT
      STB COUNT 
      LDA TMSGA     AND THE TIME ARRAY
OLOOP LDB A,I       MOVE IT 
      STB P2,I
      INA 
      ISZ P2
      ISZ COUNT 
      JMP OLOOP 
* 
      JMP ACLTM,I   RETURN
* 
* 
* 
PD00  NOP           CONVERT TO 2 ASCII DIGITS 
      CLB 
      DIV D10       DIVIDE BY 10  A=HIGH ,B=LOW 
      SZA           SUPPRESS
      ADA "0"       LEADING ZEROS 
      ALF,ALF       PUT HIGH TO HIGH
      ADA B         ADD IN THE LOW
      IOR "0"       ADD ASCII BLANK 0 
      JMP PD00,I    RETURN
* 
"0"   ASC 1, 0
"::"  ASC 1,::
D10   DEC 10
DM17  DEC -17 
COUNT BSS 1 
O5    OCT 5 
O7    OCT 7 
B17   OCT 17
B37   OCT 37
D100  DEC 100 
D153  DEC 153 
D366  DEC 366 
DM366 DEC -366
* 
      SPC 1 
* 
ITIME NOP           TENS OF MSEC
IHOUR NOP 
IDAY  NOP 
IYEAR NOP 
IMIN  NOP 
ISEC  NOP 
* 
      SPC 1 
*    MESSAGE FORMAT:  ASC 17,10:03:22  AM  MON., 29  DEC., 1975 
*                            0011223344556677889900112233445566 
* 
TMSGA DEF *+1 
TMSG  ASC 17,12:01:00  PM  MON., 29  DEC., 1975 
* 
DAYWK DEF *+1 
      ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. 
* 
MOTBA DEF *-1 
      ASC 2,MAR.
      ASC 6,APR.MAY JUNE
      ASC 6,JULYAUG.SEPT
      ASC 6,OCT.NOV.DEC.
      ASC 4,JAN.FEB.
* 
      END 
                                                                                                                                                                              