*DECK COBOL5
USETEXT CCTTEXT 
          PRGM COBOL5;
          BEGIN 
  
*CALL CPMCOMM 
*CALL ASSEMOP 
  
*CALL TABLETYP
*CALL TABLEDF 
 CONTROL IFNQ CB5$CDCS,"NO";
 CONTROL FI;
*CALL RALINE
 CONTROL IFEQ CB5$TIMR,"NO";
 $BEGIN 
 CONTROL FI;
              XREF PROC INITTIM;
              XREF PROC TIMEIN; 
              XREF PROC TIMEOUT;
              XREF PROC TREPORT;
 CONTROL IFEQ CB5$TIMR,"NO";
 $END 
 CONTROL FI;
          $BEGIN
              XREF PROC DEBUG;
              XREF ITEM SKIP$DF I;     #SKIP TO DFORMATER FLAG# 
              XREF ITEM WANTED I;  #DEBUG: REQUESTED OVLY NUMBER# 
              XREF PROC OUTPUT; 
              XREF PROC PRINIT;     # THESE PROCS ARE # 
              XREF PROC PRDUMP;    # USED ONLY WITH  #
              XREF PROC PREND;     # THE A OPTION ON #
          CONTROL WEAK PRINIT, PRDUMP, PREND; 
          $END
*CALL OVLCOM
  
*CALL     SYSFET
          ITEM I    I;
          ITEM TIMERNBR I;
          ITEM OVLNUMBER S:OVERLAY; 
          ITEM OVERLAYCALL C(10); 
          ITEM J; 
          ITEM   ABT$MSG2 C(31) = "COBOL5 COMPILER ABORT";
          ITEM   ZEROS2X  I = 0;
  
          STATUS BPROC     #LIST OF BEFORE LOADING OVERLAY PROCS# 
              NULL,          #UNUSED# 
              BSSCANNER,
              BDBTRANS, 
              BRPARSER, 
              BXFORMATTER,
              BPROCTAB, 
              BCGEN,
              BDMAP,
              NULL2;         #NOT USED - SAVES COMMA# 
  
          SWITCH BOVLPROC:BPROC 
              PBSSCANNER   :BSSCANNER,
              PBDBTRANS  :BDBTRANS, 
              PBRPARSER   :BRPARSER,
              PBXFORMATTER:BXFORMATTER, 
              PBPROCTAB   :BPROCTAB,
              PBCGEN      :BCGEN, 
              PBDMAP      :BDMAP
              ; 
  
          ARRAY OVLTABLE [1:NBROVLCALLS] P(2);
              BEGIN 
              ITEM OVLTPHASEID   I (0,00,05)  #PHASE ID FOR DFORMATTER# 
                  =[
                  1,         #CBINIT# 
                  1,         #SSCANNER# 
                  2,         #PICANALYZR# 
                  3,         #DBTRANS#
                  3,         #DPARSER#
                  4,         #DANALYZR# 
                  5,         #RPARSER#
                  6,         #RGEN# 
                  7,         #PPARSER#
                  8,         #LITPOOLER#
                  0,         #XFORMATTER# 
                  8,         #PROCTAB#
                  0          #NO MORE#
                  ];
  
              ITEM OVLTTIMENBR U(0,05,05)  #NBR OF TIMER REPORT ENTRY#
                  =[
                  1,         #CBINIT# 
                  3,         #SSCANNER# 
                  4,         #PICANALYZR# 
                  0,         #DBTRANS#
                  6,         #DPARSER#
                  7,         #DANALYZR# 
                  8,         #RPARSER#
                  10,        #RGEN# 
                  11,        #PPARSER#
                  12,        #LITPOOLER#
                  13,        #XFORMATTER# 
                  14,        #PROCTAB#
                  15,        #CGEN# 
                  16,        #ASSEM#
                  0,         #DMAP# 
                  17,        #DFORMATTER# 
                  ];
  
              ITEM OVLTBPROC  S:BPROC (0,10,05)  #BEFORE LOADING PROC#
                  =[
                  0,         #CBINIT# 
                  S"BSSCANNER", 
                  0,         #PICANALYZR# 
                  S"BDBTRANS",
                  0,         #DPARSER#
                  0,         #DANALYZER#
                  S"BRPARSER",
                  0,         #RGEN# 
                  0,         #PPARSER#
                  0,         #LITPOOLER#
                  S"BXFORMATTER", 
                  S"BPROCTAB",
                  S"BCGEN", 
                  0,         #ASSEM#
                  S"BDMAP", 
                  0,         #DFORMATTER# 
                  ];
  
              ITEM OVLTLOVERP  C(1,00,07)   #LOVER PARAMETER# 
                  =[
                  "COB5010", #CBINIT# 
                  "COB5021", #SSCANNER# 
                  "COB5022", #PICANALYZR# 
                  "COB5023", #DBTRANS#
                  "COB5050", #DPARSER#
                  "COB5060", #DANALYZR# 
                  "COB5070", #RPARSER#
                  "COB5110", #RGEN# 
                  "COB5120", #PPARSER#
                  "COB5140", #LITPOOLER#
                  "COB5160", #XFORMATTER# 
                  "COB5201", #PROCTAB#
                  "COB5202", #CGEN# 
                  "COB5203", #ASSEM#
                  "COB5205", #DMAP# 
                  "COB5300", #DFORMATTER# 
                  ];
              END 
  
          XREF
              BEGIN 
              PROC  ABTME;   #DOES ABORT W/ NO DUMP#
              ITEM BLKGID I;
              ITEM  DEN$FLG C(10);     # RESET PRINT DENSITY FLAG # 
              FUNC  DECR;    #INTEGER TO R. JUST DISP CODE# 
              PROC  PUTMSG; 
              PROC  PUTUMSG;
              PROC  CBLIST; 
              PROC  CLOSTF;  # CLOSE CMM TRACE FILE # 
              PROC  CLOSVTR;
              FUNC  CPTIME;  #RETURNS CPU TIME IN INTEGER MSECS#
              PROC CMM$OP1; 
              PROC CMM$OP2; 
              PROC CMM$OP3; 
              PROC CMM$OP4; 
              FUNC CMM$GSS; 
              PROC SFETS; 
              PROC LOVER;    #OVERLAY LOADER# 
              PROC RETRN; 
              PROC PUTSQ; 
              PROC  RLSCRF;  #RELEASE COMPILER SCRATCH FILES# 
              FUNC  OCT      C(40); 
              PROC TMRTNTB; 
              PROC TMFIXSZ; 
              PROC TMSETRO;  #SET READ ONLY ON TABLE# 
              PROC TMSPLIT;  #SPLIT THE TABLE#
              PROC TMSTATS; 
              PROC TMRECL;
              FUNC CMI$ALV I; 
              PROC CMI$FRV; 
              PROC  DISPLAY;
              PROC GETWA; 
              ITEM ZRPARAM I; 
              END 
          XDEF
              BEGIN 
              PROC ABORT; 
              ITEM CUMT$ERR I = 0;   #CUMULATIVE ERRORS FOR STACKED COM#
              ITEM CUMW$ERR I = 0;
              ITEM CUMF$ERR I = 0;
              ITEM CUMC$ERR I = 0;
              ITEM  TOTF$ERR I = 0; 
              ITEM  TOTW$ERR I = 0; 
              ITEM  TOTT$ERR I = 0; 
              ITEM  TOTC$ERR I = 0; 
              ITEM  CC$ET    I = CB5$ET;    #ERROR LEVEL TO ABORT AT# 
              ITEM FIRSTIME I = 0;
              ITEM ECSUSED I=0; 
              END 
  
  
 PROC ABORT;
            BEGIN 
            PUTMSG(ABT$MSG2); 
          PUTSQ(OUTFET,0,0);   # FLUSH OUTPUT BUFFER #
          CBLIST(9);   # TERMINATE OUTPUT FILE #
          $BEGIN
          XREF PROC BOMBIT; 
          CONTROL WEAK BOMBIT;
          BOMBIT;  # ABORT WITH ERROR MODE #
          $END
          ABTME;   # GO DIE # 
            END 
  
  
          CONTROL EJECT;
#                                                                     # 
#         BEGIN MAIN ROUTINE                                          # 
#                                                                     # 
          P<RALINE> = RA$LOCN;   #SET BASE OF RA+N LINE NBR, ETC# 
          FIRSTIME = CPTIME(0); 
  
          CCTFLAGINFO = 0;   # INITIALIZE CCT FLAG INFO WORD           #
          CCT1STCOMPIL[0] = TRUE; 
  
 MAINLOOP:                         #RETURN HERE IF STACKED COMPILE# 
  
          $BEGIN
          CPMCOPYCOUNT = 0; 
          CPMCREPCOUNT = 0; 
          WANTED = 0; 
          $END
 CONTROL IFEQ CB5$TIMR,"NO";
 $BEGIN 
 CONTROL FI;
 #     SET CCTTIMRPT ON BECAUSE CBINIT WILL CLEAR IT BEFORE DEBUG      #
 #     HAS A CHANCE TO SET IT - THIS CAUSES A VERY SMALL OVERHEAD LOSS #
 #     ALSO, IN THE NON DEBUG CASE, THE CONTROL TIM PARAMETER IS NOT   #
 #     KNOWN AT THIS TIME  #
          CCTTIMRPT = TRUE; 
          FOR J = 1 STEP 1 UNTIL 20 DO
              INITTIM (J,0,0);   #INITIALIZE TIMER CELLS# 
          TIMEIN (19);   #SET TIME FOR OVERHEAD CALC# 
 CONTROL IFEQ CB5$TIMR,"NO";
 $END 
 CONTROL FI;
# 
  
          WARNING:           * * * * * * * * * *
  
                 DO NOT CALL CBLIST OR DISPLAY UNTIL AFTER BOTH 
                             CBINIT AND SFITS HAVE BEEN CALLED. 
  
# 
  
  
 #     CALL COMPILER OVERLAYS (PHASES) IN ORDER   # 
  
          FOR OVLNUMBER = 1 STEP 1 UNTIL NBROVLCALLS DO 
              BEGIN 
          IF OVLTBPROC [OVLNUMBER] NQ 0 
          THEN
              GOTO BOVLPROC [OVLTBPROC [OVLNUMBER]];  #DO BEFORE PROC#
 LOADOVL:    # RETURN HERE TO LOAD OVERLAY #
              $BEGIN
              IF CCTCHKOUT [0] NQ 0 
              AND OVLNUMBER NQ S"CBINIT"   #NO DEBUG IN CBINIT# 
              THEN      #CALL DEBUGGER IF REQUESTED # 
                  DEBUG (OVLNUMBER);
              IF OVLNUMBER NQ S"CBINIT" 
              THEN
                  OUTPUT (2, "** PHASE= ", COMMAND [OVLNUMBER]);
              $END
 CONTROL IFEQ CB5$TIMR,"NO";
 $BEGIN 
 CONTROL FI;
              TIMERNBR = OVLTTIMENBR [OVLNUMBER]; 
              IF CCTTIMRPT AND TIMERNBR NQ 0
              THEN
                  TIMEIN(TIMERNBR); 
 CONTROL IFEQ CB5$TIMR,"NO";
 $END 
 CONTROL FI;
              CCTPHASEID = OVLTPHASEID [OVLNUMBER]; 
              OVERLAYCALL = OVLTLOVERP [OVLNUMBER]; 
              B<42,18>OVERLAYCALL = 0;   #CLEAR LOWER 3 CHARS#
              CMM$OP3;   #TELL CMM A NEW PAHSE STARTS#
              LOVER (OVERLAYCALL,ZRPARAM);  # LOAD AND GO TO OVERLAY #
              $BEGIN
              # CALL THE PROFILE ROUTINES IF REQUIRED # 
              IF CCTUARWANTED[0] AND
              OVLNUMBER GR S"CBINIT" AND OVLNUMBER LQ S"LITPOOLER" THEN 
                BEGIN 
                  IF OVLNUMBER EQ S"SSCANNER" THEN
                    PRINIT; 
                  PRDUMP(OVLNUMBER);
                  IF OVLNUMBER EQ S"LITPOOLER" THEN 
                    PREND;
                END 
              $END
  
 CONTROL IFEQ CB5$TIMR,"NO";
 $BEGIN 
 CONTROL FI;
              IF CCTTIMRPT
              AND TIMERNBR NQ 0 
              OR OVLNUMBER EQ S"CBINIT" 
              THEN
                  TIMEOUT (TIMERNBR);   #TIME DONE IF TIME REPORT#
 CONTROL IFEQ CB5$TIMR,"NO";
 $END 
 CONTROL FI;
          $BEGIN
          TMSTATS;   #OUTPUT TABLE STATS IF REQUESTED#
          $END
 SKIPOVL:     #RETURNED FROM BEFORE PROC IF OVERLAY NOT TO BE LOADED# 
 #     FIX SIZE OR RELEASE TABLES WHICH MEET REQUIREMENTS # 
          CMM$OP1;   #TELL CMM TO HOLD OFF ON FL ADJUSTING# 
              FOR J = 1 STEP 1 UNTIL NBRTABLES DO 
                  BEGIN 
                  IF (TTABRTNOVL [J] NQ 0 
                  AND TTABRTNOVL [J] LQ OVLNUMBER)
                  OR J GQ TABLETYPE "WORK1$"
                  THEN
                      BEGIN   #RETURN THE TABLE#
                      TMRTNTB (J);   #RETURN (RELEASE) TABLE# 
                      TTABRTNOVL [J] = 0; 
                      END 
                  IF TTABROOVL [J] NQ 0 
                  AND TTABROOVL [J] LQ OVLNUMBER
                  THEN
                      BEGIN   #SET READ ONLY FOR THIS TABLE#
                      TMSETRO (J);
                      TTABROOVL [J] = 0;
                      END 
                  IF TTABFIXOVL [J] NQ 0
                  AND TTABFIXOVL [J] LQ OVLNUMBER 
                  THEN
                      BEGIN   #FIX SIZE OF TABLE# 
                      TMFIXSZ (J);   #FIX SIZE OF TABLE#
                      TTABFIXOVL [J] = 0; 
                      END 
                  IF TTABREOPEN [J] 
                  THEN
                  TMRECL (J);     #RE-CLOSE THE TABLE#
              END    #END OF TABLE PROC LOOP# 
          CMM$OP2;   #TELL CMM IT CAN AGAIN ADJUST FL AND SUCH# 
              $BEGIN
              IF SKIP$DF NQ 0 
              THEN
                  CCTABORT = TRUE;   # SET TO SKIP TO DIAG FORMAT#
              $END
              IF CCTABORT 
              THEN    #ABORT COMPILE OR SKIP REST DUE TO DEBUG REQ# 
               BEGIN
                  CCTABORT = FALSE;   #CLEAR FLAG#
                  OVLNUMBER = S"DFORMATTER" - 1;    #SKIP TO DIAG # 
               CCTABORT = FALSE;  #SET FOR ONE LOOP ONLY# 
                  END 
              END  # END OF LOAD OVERLAY LOOP # 
          RLSCRF;            #GO RLS SCRATCH FILES# 
  
 #      THE OVERLAY DFORMATTER PUTS OUT FINAL MESSAGES ET AL  # 
  
  
          IF NOT CCT1STCOMPIL[0] THEN  #IF WE HAVE A STACKED COMPILE# 
              GOTO MAINLOOP;
  
  
          CLOSTF;   #CLOSE THE CMM TRACE FILE IF IT IS USED#
          $BEGIN
          CLOSVTR;   # CLOSE VIRTUAL TRACE FILE IF NECESSARY #
          PUTSQ(OUTFET,0,0);   # FLUSH OUTPUT BUFFER IN CASE MORE DB  # 
          RETRN(OUTFET);   # RETURN THE BUFFER #
          $END
          STOP;              #ALL DONE# 
  
          CONTROL EJECT;
 #     PROCEDURES TO BE EXECUTED BEFORE LOADING OVERLAY   # 
 PBSSCANNER:  
          LOVER (SSCON,I);  # LOAD SSCANNER BASE OVERLAY #
          GOTO LOADOVL; 
  
  
 PBCGEN:  
          IF CCTSYNTXONLY 
          OR CCTGTEXTLEN EQ 0 
          THEN
              BEGIN 
              CCTABORT = TRUE;     # SET TO SKIP TO DIAG FORMATTER #
              GOTO SKIPOVL;  #DO NOT LOAD THIS OVERLAY# 
              END 
          GOTO LOADOVL; 
  
 PBDBTRANS: 
          IF CCTDBFSCTXT EQ 0 
            AND NOT CCTFDLCDCS
          THEN
              GOTO SKIPOVL;    #NO DATABASE IN THIS CASE# 
          ELSE
              GOTO LOADOVL;    #DATABSE HERE# 
  
 PBDMAP:  
          IF CCTMEMORYMAP OR CCTTDF OR CCTDUMPDATA
          THEN
              GOTO LOADOVL; 
          ELSE
              GOTO SKIPOVL; 
  
 PBPROCTAB: 
          LOVER  (GENCOM,I);   #LOAD CGEN BASE OVERLAY# 
          GOTO LOADOVL; 
  
 PBRPARSER: 
          IF NOT CCTREPORTSEC 
          THEN
              BEGIN 
              OVLNUMBER = S"RGEN";    #SET TO SKIP REPORT WRITER STUFF# 
              GOTO SKIPOVL; 
              END 
          ELSE
              GOTO LOADOVL; 
  
 PBXFORMATTER:  
          IF CCTXREFLIST
          THEN
              GOTO LOADOVL; 
          ELSE
              GOTO SKIPOVL; 
  
          END    #COBOL5# 
          TERM
