ASMB,L,C
      HED COMPILER LIBRARY INITIALIZE SUBROUTINE -- SUP.C 
      NAM SUP.C,7 92060-16104 781106 REV. 1901 $CLIB
* 
*  SOURCE: 92060-18091
* 
* 
* 
*   CALLING SEQUENCE: 
* 
*         JSB SUP.C 
*         DEF STRING
*         ERROR RETURN
*         RETURN
* 
*         A<0 INDICATES THE ERROR 
*         B ::=  STRING LENGTH IN WORDS 
* 
*         STRING IS A 15 WORD ARRAY WHERE YOU WANT THE TIME STRING
*           (FORMAT:  12:01 PM MON., 29 DEC., 1982 )
* PROCEDURE SUP.C(TIMESTRING);
*  STRING TIMESTRING; 
* BEGIN 
* GLOBAL BOOLEAN SONFLAG; 
* GLOBAL INTEGER TURN_ON_STRING;
* GLOBAL STRING LIBRARYTIME;
* INTEGER ARRAY MONTHS[0:23] := "MAR.APR.MAY JUNEJULYAUG. 
*                                SEP.OCT.NOV.DEC.JAN.FEB."; 
* INTEGER ARRAY DAYS[0:14] := "FRI.SAT.SUN.MON.TUE.WED.THU."; 
*   C.TTY(3) := LOGLU OR 400B 
*   FETCH_TURN_ON_STRING; 
*   IF LENGTH(TURN_ON_STRING) = 114 THEN
*     SONFLAG := TRUE 
*   ELSE
*   BEGIN 
*     TURN_ON_STRING_LENGTH := B; 
*     BUILD_THE_TIMESTRING; 
*   END;
*   PASS_TIME_STRING_TO USER; 
* END OF SUP.C; 
      SKP 
* PROCEDURE SUP.C(TIMESTRING);
      ENT SUP.C 
*  STRING TIMESTRING; 
* BEGIN 
* GLOBAL BOOLEAN SONFLAG; 
      EXT C.SON     THE I WAS SCHEDULED BY SOMEBODY FLAG
      EXT C.CRD     THE DEFAULT CATRIDGE NUMBER 
      EXT C.HLK     THE HEAD LINK POINTER 
* GLOBAL INTEGER ARRAY
      EXT C.TTY     THE FCB FOR THE LOGLU 
      EXT LOGLU     THE ROUTINE TO RETURN USERS LU# 
* GLOBAL INTEGER TURN_ON_STRING;
      EXT C.TRN      THE TURN ON STRING IN ALL ITS GLORY
      EXT C.LEN     THE LENGTH OF THE TURN ON STRING
* GLOBAL STRING LIBRARYTIME;
      EXT C.TIM     THE LIBRARY TIME STRING 
      EXT EXEC      GUES WHO
      EXT .MVW      THE MOVE WORDS ROUTINE
      SPC 5 
A     EQU 0 
B     EQU 1 
D1    DEC 1 
O13   OCT 13
D224  DEC -224       THE MAX LENGTH OF THE C.TRN BUFFER 
":"   ASC 1, :
D14   DEC 14
.CTIM DEF C.TIM     A LOCAL POINTER TO THE GLOBAL 
* INTEGER ARRAY TIME[MSEC,SEC,MINUT,HOUR,DAY,YEAR]; 
TIME EQU *
MSEC  BSS 1 
SEC   BSS 1 
MINUT BSS 1 
HOUR  BSS 1 
DAY   BSS 1 
YEAR  BSS 1 
* INTEGER ARRAY MONTH[0:23] :=
MONTH DEF *-1 
      ASC 12,MAR.APR.MAY JUNEJULYAUG. 
      ASC 12,SEP.OCT.NOV.DEC.JAN.FEB. 
* INTEGER ARRAY DAYS[0:14] := 
DAYS  DEF *+1 
      ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. 
D15   DEC 15
      SKP 
************** START PROGRAM ***************
SUP.C BSS 1 
*  C.TTY(3) := LOGLU OR 400B
      JSB LOGLU 
      DEF *+2 
      DEF * 
      IOR =B400 
      STA C.TTY+2 
      CLB 
      STB C.HLK 
      STB C.SON 
*   FETCH_TURN_ON_STRING; 
      JSB EXEC
      DEF *+4+1 
      DEF D14 
      DEF D1
      DEF C.TRN 
      DEF D224
*   IF LENGTH(TURN_ON_STRING) = 224 THEN
      LDA B 
      ADA D224
      SZA 
      JMP L1
*     SONFLAG := TRUE;
      CCA 
      STA C.SON 
      JMP L2
*   ELSE
*   BEGIN 
*     TURN_ON_STRING_LENGTH := B; 
L1    EQU * 
      STB C.LEN 
      CLB 
      STB C.CRD 
*   BUILD_THE_TIMESTRING; 
      JSB EXEC
      DEF *+3+1 
      DEF O13 
      DEF TIME
      DEF YEAR
      LDA MINUT 
      JSB PD00
      LDB ":" 
      IOR =B30000   PUT IN LEADING ZERO IF NECESSARY
      RRR 8         B=UNITS-BLANK;A= ":"-TENS 
      DST C.TIM+1 
      LDA HOUR      TEST FOR AM OR PM 
      LDB =APM
      ADA =D-12 
      SSA,RSS 
      JMP PM
      LDB =AAM
      LDA HOUR
PM    STB C.TIM+3 
      SZA,RSS 
      LDA =D12      HOUR  := 12 
      JSB PD00
      STA C.TIM+0 
      LDA YEAR
      ADA =D-1900 
      JSB PD00      CONVERT THE YEAR
      STA C.TIM+14
      LDB DAY 
      ADB =D-60 
      LDA YEAR
      AND =D3 
      SZA           LEAP YEAR CHECK 
      SSB 
      ADB =D-1
      SSB 
      ADB =D366 
      ADB =D31
      LDA B 
      RAL,RAL 
      ADA B         MULTIPLY BY 5 
      CLB 
      DIV =D153 
      STA TIME      SAVE THE MONTH FOR A WHILE
      LDA B 
      CLB 
      DIV =D5 
      INA 
      JSB PD00      GET DAY OF MONTH
      STA C.TIM+8 
      LDB TIME      NOW GET THE MONTH 
      BLS 
      ADB MONTH     INDEX INTO MONTH TABLE
      DLD B,I 
      DST C.TIM+10
      CCA           ITS TIME TO GET THE DAY OF THE WEEK 
      ADA YEAR
      ARS,ARS 
      ADA YEAR
      ADA DAY 
      CLB 
      DIV =D7 
      BLS 
      ADB DAYS      INDEX INTO DAY TABLE
      DLD B,I 
      DST C.TIM+5 
*   END;
      SPC 3 
*   PASS_TIME_STRING_TO_USER; 
L2    LDA .CTIM 
      JMP *+2 
ILOP1 LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP ILOP1 
      LDB SUP.C 
ILOP2 LDB B,I 
      RBL,CLE,SLB,ERB 
      JMP ILOP2 
      JSB .MVW
      DEF D15 
      NOP 
      LDB D15 
      ISZ SUP.C 
      ISZ SUP.C 
      JMP SUP.C,I 
      SPC 3 
PD00  BSS 1 
      CLB 
      DIV =D10
      SZA 
      ADA =A 0
      ALF,ALF 
      ADA B 
      IOR =A 0
      JMP PD00,I
* END OF SUP.C; 
      END 
                                                                                                                                          