ASMB,R,Q,C
*     NAME:   FTIME 
*     SOURCE: 92070-18195 
*     RELOC:  92070-1X195 
*     PGMR:   GAA,CMM,HLC 
* 
* 
*  **************************************************************** 
*  * (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 FTIME,7  92070-1X195  REV.1941  790205
      ENT FTIME 
      EXT EXEC
*      CALLING SEQUENCE:
* 
*C     GET THE TIME IN A 15 WORD STRING 
*      DIMENSION IBUF(15) 
*      CALL FTIME(IBUF) 
* 
      SUP 
* 
*     GET TIME AND BUILD HEADER MESSAGE 
* 
A     EQU 0 
B     EQU 1 
O13   OCT 13
N1900 DEC -1900 
D12   DEC 12
MD60  DEC -60 
DM12  DEC -12 
O30K  OCT 30000     ASCII 0 IN HIGH WORD
M1    OCT -1
"AM"  ASC 1,AM
"PM"  ASC 1,PM
O3    OCT 3 
* 
* 
P1    NOP 
FTIME NOP 
      DLD FTIME,I 
      STA FTIME 
      RSS 
INDCT LDB B,I       TRACK DOWN INDIRECTS
      RBL,CLE,SLB,ERB 
      JMP INDCT 
      STB P1
* 
      JSB EXEC
       DEF *+4
       DEF O13      GET TIME
       DEF ITIME
       DEF IYEAR
      LDA IMIN
      JSB PD00
      LDB ":" 
      IOR O30K      DON'T SUPPRESS LEADING ZEROS HERE 
      RRR 8         B=1'S BLANK,A= ":"  , 10'S
      DST TMSG+1    SET IN MESSAGE
      LDA IHOUR 
      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+3    SET THE AM PM 
      JSB PD00
      STA TMSG      HOURS 
* 
      LDA IYEAR 
      ADA N1900     SUBTRACT THE HUNDREDS 
      JSB PD00      CONVERT THE YEAR
      STA TMSG+14   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 D31 
      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+8
      LDB ITIME     RECOVER MONTH 
      BLS 
      ADB MOTBA 
      DLD B,I 
      DST TMSG+10 
      CCA           CALCULATE DAY OF WEEK.
      ADA IYEAR 
      ARS,ARS 
      ADA IYEAR 
      ADA IDAY
      CLB 
      DIV O7
      BLS 
      ADB DAYWK 
      DLD B,I 
      DST TMSG+5
      LDB DM15      SET WORD COUNT
      STB COUNT 
      LDA TMSGA     AND THE TIME ARRAY
OLOOP LDB A,I       MOVE IT 
      STB P1,I
      INA 
      ISZ P1
      ISZ COUNT 
      JMP OLOOP 
* 
      JMP FTIME,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
DM15  DEC -15 
COUNT BSS 1 
O5    OCT 5 
O7    OCT 7 
D31   DEC 31
D100  DEC 100 
D153  DEC 153 
D366  DEC 366 
* 
      SPC 1 
* 
ITIME NOP           TENS OF MSEC
      NOP           SEC 
IMIN  NOP           MIN 
IHOUR NOP 
IDAY  NOP 
IYEAR NOP 
* 
      SPC 1 
*    MESSAGE FORMAT:  ASC 15,10:03 AM  MON., 29  DEC., 1975 
*                            001122334455667788990011223344 
* 
TMSGA DEF *+1 
TMSG  ASC 15,12:01 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 
                            