ASMB,R,L,C
      HED COMPILER LIBRARY INITIALIIZE SUBROUTINE 
      IFZ 
      NAM SUP.C,7 92060-18091 770515 REV. 1726 $CLIB
      XIF 
      IFN 
      NAM SUP.C,7 92064-18256 770515 REVM. 1726 $CLIB 
      XIF 
* 
* 
*  Z OPTION GETS YOU AN RTE-II/RTE-III VERSION
*  N OPTION GETS YOU AN RTE-M VERSION 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
* 
* 
* 
*   SOURCE PART NUMBER :       92060-18091
* 
* 
* 
*  ENTRY POINT: 
      ENT SUP.C 
* 
*  EXTERNALS: 
* 
      EXT C.TRN     TURN ON STRING FROM 'RUN' 
      EXT EXEC
      EXT .MVW      MOVE WORDS ROUTINE
      UNL 
      IFZ 
      LST 
      EXT NAMR      PARSE TURN ON STRING
      UNL 
      XIF 
      IFN 
      LST 
      EXT GTF.C     GET FILE NAMES
      EXT C.HLK     HEAD OF LINKED FCB'S
      EXT C.SN0     SOURCE NAME ADDRESS 
      EXT C.BN0     BINARY NAME ADDRESS 
      EXT C.LN0     LIST NAME ADDRESS 
      EXT C.PC0     PAGE COUNT
      EXT RMPAR 
      UNL 
      XIF 
      LST 
* 
* 
* 
* 
*   CALLING SEQUENCE: 
* 
*             JSB SUP.C 
*             DEF STRING
*             ERROR RETURN
*             NO ERROR RETURN 
* 
* 
*             A < 0 INDICATES THE ERROR 
*             B = STRING LENGTH IN WORDS
* 
* 
*   WHERE: STRING IS A FIFTEEN WORD ARRAY CONTAINING THE TIME IN THE
*          FORMAT "12:01 PM MON., 29 DEC., 1982"
* 
* 
*  NOTE: THIS ROUTINE CAN BE CALLED ONCE AT THE BEGINNING OF THE LANGUAGE 
*        PROCESSOR. AFTER THAT IT WILL BE USED AS A BUFFER FOR THE OTHER
*        ROUTINES OF THE COMPILER LIBRARY.
*        IT WILL ALSO GET THE LANGUAGE TURN ON STRING FROM THE OPERATING
*        SYSTEM AND STORE IT IN THE GLOBAL ARRAY C.TRN. ONLY THE FIRST
*        FOUR PARAMTERS ARE RECOVERED.
* 
      SUP PRESS 
* 
A     EQU 0 
B     EQU 1 
O13   OCT 13
N1900 DEC -1900 
D1    DEC 1 
D12   DEC 12
MD60  DEC -60 
DM12  DEC -12 
O30K  OCT 30000     ASCII 0 IN HIGH WORD
M1    OCT -1
M3    DEC -3
M80   DEC -80 
"AM"  ASC 1,AM
"PM"  ASC 1,PM
O3    OCT 3 
O4    OCT 4 
* 
* 
SUP.C NOP 
      UNL 
      IFN 
      LST 
      JSB RMPAR 
      DEF *+2 
      DEF PBUFF 
      CLA           CLEAR OUT 
      STA C.HLK       FOR RESTART 
      UNL 
      XIF 
      LST 
DATE  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 SUP.C,I   GET RETURN ADDRESS
      LDA TMSGA     AND THE TIME ARRAY
      JSB .MVW      MOVE IT 
      DEF D15 
      NOP 
* 
      UNL 
      IFN 
      LST 
      JSB GTF.C     GET THE FILE NAMES
      DEF *+6 
      DEF * 
      DEF PBUFF 
      DEF C.SN0     SOURCE FILE NAME
      DEF C.BN0     BINARY FILE NAME
      DEF C.LN0     LIST FILE NAME
      LDB PBUFF+3 
      STB C.PC0     SETUP THE PAGE COUNT
      SSA           ERROR?
      JMP ERROR     YES 
* 
      LDB ATRN
      RSS 
      LDB B,I 
      RBL,CLE,SLB,ERB MAKE ADDR DIRECT
      JMP *-2 
      STB ATRN
* 
* 
      UNL 
      XIF 
      IFZ 
      LST 
      CLA 
      LDB ADATE 
      STA B,I       CLEAR OUT PROGRAM 
      INB             PRIOR TO
      ISZ MD60          READING IN TURN ON STRING 
      JMP *-3 
* 
      JSB EXEC      GET TURN ON 
      DEF *+5         STRING FROM 
      DEF D14           :RU,<LANGUAGE>,STRING 
      DEF D1              AND STORE ON TOP OF THIS ROUTINE
ADATE DEF DATE
      DEF M80 
* 
      STB LEN       SAVE LENGTH OF PASSED STRING
*  SKIP OVER 'RU,<LANGUAGE>'
* 
GETPR JSB NAMR      SKIP
      DEF *+5 
BUFFA DEF C.TRN       OVER FIRST
      DEF DATE
      DEF LEN           TWO PARAMETERS
      DEF D1
      SSA           DONE? 
      JMP DONE      YES!
      LDA M3
      INA           DONE FIRST
      STA M3
      SSA             TWO?
      JMP GETPR     NO! 
      CPA O4          FINISHED? 
      JMP DONE      YES!
      LDA BUFFA     INCREMENT 
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA STRIP OFF INDIRECT
      JMP *-2 
      ADA D10         TO NEXT 
      STA BUFFA         PARAMETER POSITION
      JMP GETPR 
      UNL 
      XIF 
      LST 
DONE  ISZ SUP.C 
ERROR ISZ SUP.C 
      LDB D15       STRING LENGTH PASSED ON 
      JMP SUP.C,I   RETURN
* 
      SPC 2 
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
LEN   EQU PD00
D14   DEC 14
D15   DEC 15
O5    OCT 5 
O7    OCT 7 
D31   DEC 31
D153  DEC 153 
D366  DEC 366 
      UNL 
      IFN 
      LST 
ATRN  DEF C.TRN 
PBUFF BSS 5 
      UNL 
      XIF 
      LST 
* 
      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 
                                                                                                                                                                                                      