*DECK PROFILE 
*IF DEF,PROFILE$
USETEXT CCTTEXT 
USETEXT DNTEXT
PROC PROFILE(OVLNUMBER);
  
BEGIN 
  
  
 CONTROL FTNCALL; 
  # 
  
  PURPOSE 
  ------- 
  
    THIS PROC IS EMPLOYED IF THE "A" OPTION IS USED (THE PROFILE
     OPTION).  IT PERFORMS THE FOLLOWING: 
      1. CREATES A MODULE OF INFORMATION NEEDED TO GENERATE THE 
         FORMATTED PROGRAM MODULE.
      2. PUTS THE MODULE ON THE DESIGNATED SCRATCH FILE.
      3. INSTRUMENTS THE OBJECT MODULE BY ADDING "ENTER" STATEMENTS 
         TO THE GTEXT PRIOR TO CGEN.  AT RUN TIME THESE CALLS 
         PERFORM THE STATISTIC COLLECTION  .
                                                        # 
  # 
  
  GENERAL STRUCTURE 
  ----------------- 
  
    PROFILE IS ACCESSED VIA 3 ENTRY POINTS. THEY ARE: 
      1. PRINIT  - DOES INITIALIZATION
      2. PRDUMP  - PERFORMS THE INFORMATION GATHERING AND GTEXT 
                   MODIFICATION.
      3. PREND   - PERFORMS THE CLEAN-UP
  
                          # 
  # 
  
    GENERAL DESIGN
  --------------- 
  
    AFTER THE 1ST PHASE HAS EXECUTED, A CALL IS MADE TO PRINIT. 
  AFTER LPOOLER HAS EXECUTED, A CALL TO PREND IS MADE. AFTER ALL
  PHASES IN BETWEEN, AND INCLUDING THEM, A CALL IS MADE TO PRDUMP.
  PRDUMP USES THE PHASE-ID TO DETERMINE WHAT INFORMATION TO COLLECT,
  IF ANY.  AFTER PPARSER, PRDUMP ALSO MODIFIES THE GTEXT BY ADDING
  "ENTER" STATEMENT GTEXT, WHICH CAUSE THE RUN-TIME STATISTICS TO BE
  COLLECTED.
                                                            # 
  
  # 
  
  DETAILED DESIGN 
  --------------- 
  
    TERMINOLOGY 
    ----------- 
      A PROGRAM IS MADE UP OF 1 OR MORE SUB-PROGRAMS.  EACH SUB-PROG. 
    CORRESPONDS TO THE RELOCATABLE OBJECT MODULE WHICH IS CREATED 
    WHEN IT IS COMPILED.  THE SUB-PROG. WHICH HAS THE MAIN ENTRY
    POINT IS CALLED THE MAIN SUB-PROGRAM. 
      A FLOW BLOCK IS A SEQUENCE OF GTEXT ATOMS WITH TXE
    FOLLOWING PROPERTY:  THERE IS ONLY 1 WAY INTO THE SEQUENCE, 
    VIA THE 1ST ATOM,  AND ONLY 1 WAY OUT OF THE SEQUENCE, VIA
    VIA THE LAST ATOM. (IE. THERE IS NO TRANSFER OF CONTROL 
    WITHIN THE SEQUENCE.).
  
    WALK-THRU 
    --------- 
  
      DATA
      ----
        ALL THE INFORMATION NEEDED BY THE FORMATTER ROUTINE IS
      CONTAINED IN THE SCRATCH FILE.  THIS IS A WORD ADDRESSABLE
      FILE WHICH CONTAINS A MODULE FOR EACH SUB-PROGRAM OF THE PROGRAM
      WHICH WAS COMPILED WITH THE PROFILE OPTION "ON".
  
        A MODULE CONTAINS ALL OF THE INTERNAL TABLES NEEDED BY
      FORMATTER TO BUILD THE COBOL PROGRAM MODULE(CPM). 
  
        THIS INFORMATION IS ACCESSED VIA A SET OF DIRECTORIES.  THE 
      FILE DIRECTORY (FD) IS FIXED AS THE FIRST 10 WORDS OF THE FILE. 
      IT CONTAINS A WORD ADDRESS POINTER TO THE MASTER MODULE DIRECTORY 
      (MMD) .  EACH ENTRY OF THE MMD CONTAINS A POINTER TO A MODULE 
      DIRECTORY (MD).  EACH MD HAS A POINTER TO EACH OF THE 3 TABLES. 
  
        ALL OF THE RELEVANT INTERNAL TABLES ARE PUT ON THE SCRATCH
      FILE. ( DNAT, PNAT, GTEXT, CTEXT, ETC.).  AS WELL, 3 OTHERS 
      ARE PUT THERE. THESE ARE NOT PART OF THE STANDARD COMPILER
      TABLES.  THEY ARE:  
        1. FBCT    - THE FLOW BLOCK COUNT TABLE IS ALLOCATED. 
                     THERE IS 1 ENTRY FOR EACH FLOW BLOCK IN THE
                     GTEXT.  IT IS UPDATED AT RUN TIME. 
        2. FBST    - THE FLOW BLOCK START TABLE IS BUILT.  THERE
                     IS 1 ENTRY FOR EACH FLOW BLOCK IN THE GTEXT. 
                     IT CONTAINS THE ATOM INDEX FOR THE 1ST ATOM IN 
                     THE FLOW BLOCK.
        3. CPMCOMM - THIS IS A MISCELLANEOUS TABLE WHICH HOLDS
                     SPECIAL STATISTICS NOT AVAILABLE IN REGULAR
                     INTERNAL TABLES. 
  
  
      CODE
      ----
        THERE ARE 3 ENTRY POINTS IN PROFILE:  
          1. PRINIT  - IT IS CALLED ONCE, IMMEDIATELY AFTER SSCANNER, 
                       AND PERFORMS THE FOLLOWING:  
                         - DEFINES AND OPENS THE SCRATCH FILE (ALSO 
                           CALLED THE MODULE FILE)
                         - READS IN THE FILE DIRECTORY(IF IT EXISTS), 
                           OR CREATES IS ( IF IT DOESN"T) 
                         - SETS UP THE MMD FOR THIS SUB-PROG. 
          2. PRDUMP  - THIS IS CALLED AFTER EVERY PHASE FROM SSCANNER 
                       TO LPOOLER.  IT USES THE PHASE-ID TO 
                       DISTINGUISH AMONG CALLS.  IT PERFORMS: 
                         - AFTER ALL PHASES 
                             - DETERMINES THE WANTED TABLES AND 
                               PUTS THEM ON THE FILE
                         - AFTER PPARSER
                             A CALL TO MODIFYGTEXT IS MADE WHICH MODIFIE
                             THE GTEXT, BUILDS THE FBCT AND FBST, AND SA
                             THEM ON THE FILE 
          3. PREND   - THIS IS CALLED ONCE.IT PERFORMS THE FOLLOWING: 
                         - FINISH BUILDING THE FD AND MMD AND PUT THEM
                           BACK ON THE FILE.
                         - CLOSE THE FILE 
  
  
        MODIFYGTEXT IS THE INTERNAL PROC WHICH DOES MOST OF THE WORK. 
      IT SCANS THE GTEXT AND PERFORMS THE FOLLOWING:  
          1. FOR EACH FLOW BLOCK ENCOUNTERED, IT BUILDS A 
             FBCT AND FBST ENTRY, AND INSERTS NEW GTEXT, IN THE FORM OF 
             A "ENTER" STATEMENT.  THE PARAMETER PASSED IS THE FBCT 
             INDEX FOR THIS VERB. 
          2. IF IT IS A MAIN SUB-PROGRAM, "ENTER" GTEXT IS ADDED AT THE 
             BEGINNING.  THE PARAMETER PASSED IS THE NAME OF THE SCRATCH
             FILE WHICH CONTAINS ALL THE INFORMATION. 
          3. AT THE START OF EVERY SUB-PROGRAM, "ENTER" GTEXT IS ADDED, 
             WHICH HAS A PARAMETER OF THE INTERNAL NAME OF THE MODULE 
             FOR THIS SUB-PROGRAM.
          4. AT EVERY "STOP RUN" STATEMENT, "ENTER" GTEXT IS ADDED. THIS
             CALL, AT RUN TIME,DOES CLEAN-UP. 
          5. AT EVERY "EXIT PROGRAM" STATEMENT, "ENTER" GTEXT IS ADDED. 
  
        AT RUN TIME, THE RESULT OF THE GTEXT MODIFICATION IS THAT 
      DYNAMIC STATISTICS ARE COLLECTED FOR EACH FLOW BLOCK IN EACH SUB-P
  
                                             #
  #DECLARATIONS#
  
  
  XREF
    BEGIN 
      PROC CBLIST;
      FUNC OCT C(40); 
      FUNC DEC C(10); 
      PROC GETWAX;
      PROC PUTWAX;
      PROC CLOSEX;
      PROC OUTPUT;
      PROC TMREOP;
      PROC TMRECL;
    END 
  
  XREF
    BEGIN 
      ITEM LISTDAT C(10);  # DATE OF COMPILE# 
      ITEM LISTTIM C(10);  # TIME OF COMPILE# 
    END 
  
  
 #
          THE FOLLOWING IS A LIST OF THE OVERLAYS CALLED BY COBOL5. 
          IT IS IN THE SEQUENCE IN WHICH THEY ARE CALLED. 
          THE ENTRIES WHICH CORRESPOND TO OVERLAY LOADS MUST CORRESPOND 
          TO THE ORDER IN THE OVERLAY STATUS LIST.
 #
  
          STATUS OVERLAY    #NAMES OF COBOL5 LOADER OVERLAYS# 
              NULL,          # NOT USED - FOR LIST ADJUSTMENT # 
              CBINIT,        # INITIALIZATION # 
              SSCANNER,      # SOURCE SCANNER # 
              PICANALYZR,    # PICTURE ANANLYZER #
              DBTRANS,       # DATA BASE TRANSLATOR # 
              DPARSER,       # DATA DIVISION PARSER # 
              DANALYZER,     # DATA DIVISION ANALYZER # 
              RPARSER,       # REPORT WRITER PARSER # 
              RGEN,          # REPORT WRITER GENERATOR #
              PPARSER,       # PROCEDURE DIVISION PARSER #
              LITPOOLER,     # LITERAL POOLER # 
              XFORMATTER,    # CROSS REFERENCE FORMATTER #
              PROCTAB,       # PROCESS TABLES FOR CGEN #
              CGEN,          # CODE GENERATOR # 
              ASSEM,         # ASSEMBLER #
              DMAP,          # DATA MAP # 
              DFORMATTER,    # DIAGNOSTIC FORMATTER # 
              LISTEND;       # END OF LIST - NOT USED FOR OVL CALL #
  
          DEF NBROVLCALLS #16#;   #NUMBER OF OVERLAY CALLS# 
  
  
  DEF PRODEBUG #TRUE#;  # THIS TURNS ON THE DEBUG TRACE # 
  DEF ASLONGAS # FOR DUMMYQQZZ1 = 0 WHILE #;
  DEF DOFOREVER # FOR DUMMYQQZZ1 = 0 DO# ;
  
  
  
*CALL SYSFET
*CALL CPMCOMM 
*CALL PRODCLS 
*CALL RW
*CALL GETSET
*CALL WORKTABS
*CALL DNATVALS
*CALL GTEXT 
*CALL LAT1
*CALL PLT1
*CALL PLTVALS 
*CALL PNT 
*CALL DNT 
*CALL AWRT
*CALL INT1
*CALL CTEXT 
*CALL FNAT1 
*CALL PNAT1 
*CALL AUXT1 
*CALL TABLNAMES 
  
  
  
  ITEM I,J,K;  #TEMPORARIES#
  
  ITEM DUMMYQQZZ1;
  
  ITEM NEXTFREEWORD U;  # INDEX OF NEXT WORD IN MODULE #
  
  ITEM OVLNUMBER S:OVERLAY; 
  
  
  # DEFINE A BASED ARRAY USED TO BUILD THE MODULE # 
  
  BASED ARRAY ONEENTRY[0] S(1); 
          ITEM ONEENTRY1 U(0,0,60); 
  
  
  ITEM MAINSUB B;   #SET TO TRUE IF THE SUBPROGRAM BEING COMPILED 
                       HAS THE MAIN ENTRY POINT IN IT # 
  ITEM NONDCL1STSEC U; #  THIS HOLDS THE INTERNAL NAME OF THE 1ST 
                          NON-DECLARATIVES SECTION-NAME. #
  
  
CONTROL EJECT;
  #INTERNAL PROCEDURES #
  
$BEGIN
  
  PROC PUTDNT;
    # PUT THE DNT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      TMREOP(DNT$); 
      LENGTH = DNT$ENTSZ;   # NUM OF WORDS IN DNT ENTRY # 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[DNT$] = NEXTFREEWORD;
      MDENTRYSIZE[DNT$] = LENGTH; 
      MDENTRYCOUNT[DNT$] = CCTDNTLEN + 1; 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," DNTLEN =",DEC(CCTDNTLEN));
      $END
  
      FOR I = 0 STEP 1 UNTIL CCTDNTLEN DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          $BEGIN
            IF PRODEBUG THEN OUTPUT(2," LOOP I =",DEC(I));
          $END
          J = VIRTUAL(DNT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          $BEGIN
            IF PRODEBUG THEN OUTPUT(2,"  J =",DEC(J));
          $END
          P<ONEENTRY> = LOC(DNT[J]);  # SET UP ENTRY AS AN ARRAY #
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
      TMRECL(DNT$); 
  
      RETURN; 
    END # OF PUTDNT # 
CONTROL EJECT;
  PROC PUTPNT;
    # PUT THE PNT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      TMREOP(PNT$); 
      LENGTH = PNT$ENTSZ;   # NUM. OF WORDS IN PNT ENTRY #
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[PNT$] = NEXTFREEWORD;
      MDENTRYSIZE[PNT$] = LENGTH; 
      MDENTRYCOUNT[PNT$] = CCTPNTLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTPNTLEN DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(PNT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(PNT[J]);  # SET UP ENTRY AS AN ARRAY #
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
      TMRECL(PNT$); 
  
      RETURN; 
    END # OF PUTPNT # 
CONTROL EJECT;
  PROC PUTAWRT; 
    # PUT THE AWRT INTO THE MODULE AND UPDATE THE DIRECTORY # 
    ITEM I,J,LENGTH;
    BEGIN 
      TMREOP(AWRT$);
      LENGTH = 4;  # NUM. OF WORDS IN AWRT ENTRY# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[AWRT$] = NEXTFREEWORD; 
      MDENTRYSIZE[AWRT$] = LENGTH;
      MDENTRYCOUNT[AWRT$] = CCTAWRTLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTAWRTLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(AWRT$,I);   # ENSURE THE ENTRY IS IN MEMORY # 
          P<ONEENTRY> = LOC(AWRT[J]);  # SET UP ENTRY AS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
      TMRECL(AWRT$);
  
      RETURN; 
    END # OF PUTAWRT #
CONTROL EJECT;
  PROC PUTINT;
    # PUT THE INT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN INT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[INT$] = NEXTFREEWORD;
      MDENTRYSIZE[INT$] = LENGTH; 
      MDENTRYCOUNT[INT$] = CCTINTLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTINTLEN DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(INT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(INT[J]);  # SET UP ENTRY AS AN ARRAY #
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTINT # 
CONTROL EJECT;
  PROC PUTCTEXT;
    # PUT THE CTEXT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,K,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN CTEXT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[CTEXT$] = NEXTFREEWORD;
      MDENTRYSIZE[CTEXT$] = LENGTH; 
      MDENTRYCOUNT[CTEXT$] = CCTCTEXTLEN + 3; 
  
      K = CCTCTEXTLEN/2 + 1;  # REAL WORD LENGTH. (2 ATOMS PER WORD)# 
  
      FOR I = 0 STEP 1 UNTIL K DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(CTEXT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(CTEXTARRAY[J]); # SET UP ENTRY AS AN ARRAY# 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTCTEXT # 
CONTROL EJECT;
  PROC PUTFNAT; 
    # PUT THE FNAT INTO THE MODULE AND UPDATE THE DIRECTORY # 
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 16;  # NUM. OF WORDS IN FNAT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[FNAT$] = NEXTFREEWORD; 
      MDENTRYSIZE[FNAT$] = LENGTH;
      MDENTRYCOUNT[FNAT$] = CCTFNATLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTFNATLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(FNAT$,I);   # ENSURE THE ENTRY IS IN MEMORY # 
          P<ONEENTRY> = LOC(FNAT[J]);  # SET UP ENTRY AS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTFNAT #
CONTROL EJECT;
  PROC PUTLAT;
    # PUT THE LAT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN LAT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[LAT$] = NEXTFREEWORD;
      MDENTRYSIZE[LAT$] = LENGTH; 
      MDENTRYCOUNT[LAT$] = CCTLATLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTLATLEN DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(LAT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(LAT[J]);  # SET UP ENTRY AS AN ARRAY #
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTLAT # 
CONTROL EJECT;
  PROC PUTDNAT; 
    # PUT THE DNAT INTO THE MODULE AND UPDATE THE DIRECTORY # 
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 2;  # NUM. OF WORDS IN DNAT ENTRY# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[DNAT$] = NEXTFREEWORD; 
      MDENTRYSIZE[DNAT$] = LENGTH;
      MDENTRYCOUNT[DNAT$] = CCTDNATLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTDNATLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(DNAT$,I);   # ENSURE THE ENTRY IS IN MEMORY # 
          P<ONEENTRY> = LOC(DNAT[J]);  # SET UP ENTRY AS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTDNAT #
CONTROL EJECT;
  PROC PUTPNAT; 
    # PUT THE PNAT INTO THE MODULE AND UPDATE THE DIRECTORY # 
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 2;  # NUM. OF WORDS IN PNAT ENTRY# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[PNAT$] = NEXTFREEWORD; 
      MDENTRYSIZE[PNAT$] = LENGTH;
      MDENTRYCOUNT[PNAT$] = CCTPNATLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTPNATLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(PNAT$,I);   # ENSURE THE ENTRY IS IN MEMORY # 
          P<ONEENTRY> = LOC(PNAT[J]);  # SET UP ENTRY AS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTPNAT #
CONTROL EJECT;
  PROC PUTPLT;
    # PUT THE PLT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN PLT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[PLT$] = NEXTFREEWORD;
      MDENTRYSIZE[PLT$] = LENGTH; 
      MDENTRYCOUNT[PLT$] = CCTPLTLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTPLTLEN DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(PLT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(PLTATTRIBUTE[J]);  # SET IT UPAS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTPLT # 
CONTROL EJECT;
  PROC PUTPLST; 
    # PUT THE PLST INTO THE MODULE AND UPDATE THE DIRECTORY # 
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN PLST ENTRY# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[PLTSTR$] = NEXTFREEWORD; 
      MDENTRYSIZE[PLTSTR$] = LENGTH;
      MDENTRYCOUNT[PLTSTR$] = CCTPLSTLEN + 1; 
  
      FOR I = 0 STEP 1 UNTIL CCTPLSTLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(PLTSTR$,I);   # ENSURE THE ENTRY IS IN MEMORY # 
          P<ONEENTRY> = LOC(PLTSTRING[J]);  # SET UP ENTRY AS ARRAY#
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTPLST #
CONTROL EJECT;
  PROC PUTGTEXT;
    # PUT THE GTEXT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,K,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN GTEXT ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[GTEXT$] = NEXTFREEWORD;
      MDENTRYSIZE[GTEXT$] = LENGTH; 
      MDENTRYCOUNT[GTEXT$] = CCTGTEXTLEN + 3; 
      K = CCTGTEXTLEN/2 + 1;  # REAL NUM. OF WORDS #
  
      FOR I = 0 STEP 1 UNTIL K DO 
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(GTEXT$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(GTEXT[J]);  # SET UP ENTRY AS AN ARRAY #
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTGTEXT # 
CONTROL EJECT;
  PROC PUTAUX;
    # PUT THE AUX INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 1;  # NUM. OF WORDS IN AUX ENTRY#
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[AUX$] = NEXTFREEWORD;
      MDENTRYSIZE[AUX$] = LENGTH; 
      MDENTRYCOUNT[AUX$] = CCTAUXTLEN + 1;
  
      FOR I = 0 STEP 1 UNTIL CCTAUXTLEN DO
        BEGIN 
          # MOVE 1 ENTRY AT A TIME INTO THE MODULE #
          J = VIRTUAL(AUX$,I);   # ENSURE THE ENTRY IS IN MEMORY #
          P<ONEENTRY> = LOC(AUXT[J]);  # SET UP ENTRY AS AN ARRAY # 
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
  
      RETURN; 
    END # OF PUTAUX # 
CONTROL EJECT;
  
  PROC PUTCPMCOMM;
    # PUT THE CPMCOMM INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 4;  #COMMON BLOCK CPMCOMM HAS 4 WORDS# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[CPMC$] = NEXTFREEWORD; 
      MDENTRYSIZE[CPMC$] = LENGTH;
      MDENTRYCOUNT[CPMC$]  = 1; 
      P<ONEENTRY> = LOC(CPMCOPYCOUNT);
      PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
      NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
  
  
      RETURN; 
    END # OF PUTCPMCOMM # 
CONTROL EJECT;
  
  PROC PUTCCT;
    # PUT THE CCT INTO THE MODULE AND UPDATE THE DIRECTORY #
    ITEM I,J,LENGTH;
    BEGIN 
      LENGTH = 138;  #COMMON BLOCK CCT HAS 138 WORDS# 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[CCT$] = NEXTFREEWORD;
      MDENTRYSIZE[CCT$] = LENGTH; 
      MDENTRYCOUNT[CCT$]  = 1;
      P<ONEENTRY> = LOC(CCTSOURCEFIL[0]); 
      PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
      NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
  
  
    RETURN; 
    END # OF PUTCCT # 
CONTROL EJECT;
  
  PROC PUTFBST(LAST); 
    # PUT THE FLOW BLOCK START TABLE INTO THE MODULE AND
      UPDATE THE DIRECTORY #
    ITEM LAST , I,J, LENGTH;
    BEGIN 
      LENGTH = 1;  # NUMBER OF WORDS IN AN FBST ENTRY # 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT PROC."," CALLED."); 
      $END
      MDTABLEPTR[FBST$] = NEXTFREEWORD; 
      MDENTRYSIZE[FBST$] = LENGTH;
      MDENTRYCOUNT[FBST$]  = LAST + 1;
  
      FOR I = 0 STEP 1 UNTIL LAST DO
        BEGIN 
          J = VIRTUAL(WORK2$,I);
          P<ONEENTRY> = LOC(WORK2[J]);
          PUTWAX(ONEENTRY,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
      RETURN; 
    END # OF PUTFBST #
CONTROL EJECT;
  
  PROC PUTFBCTENTRY(LAST);
    # BUILD THE FLOW BLOCK COUNT TABLE DIRECTORY ENTRY #
    ITEM LAST;
    ITEM I,J; 
    BEGIN 
      $BEGIN
        IF PRODEBUG THEN
          OUTPUT(2," PUTFBCT","CALLED."); 
      $END
  
      MDTABLEPTR[FBCT$] = NEXTFREEWORD; 
      MDENTRYSIZE[FBCT$] = 1; 
      MDENTRYCOUNT[ FBCT$] = LAST + 1;
      # FBCT IS FILLED IN AT RUN TIME.  FOR NOW, THE TABLE IS ZEROED
        OUT AND PUT ON THE MODULE # 
      J = 0;
      FOR I = 0 STEP 1 UNTIL LAST DO
        BEGIN 
          PUTWAX(J,10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + 1;
        END 
  
      RETURN; 
    END # OF PUTFBCTENTRY # 
CONTROL EJECT;
  
  PROC PUTSOURCE; 
    # PUT THE COBOL SOURCE INTO THE MODULE AND UPDATE THE 
      MODULE DIRECTORY.  THE LAST LINE OF THE PROGRAM IS IN 
      CCTLASTLINE ( ACTUALLY IT IS CURRENTLY CCTLASTLINE-1) # 
  
    BEGIN 
      XREF PROC BKSPREC;    # USED TO REWIND INPUT FILE # 
      XREF PROC GETSQ;
      ITEM SOURCELINE C(80);   # HOLDS THE INPUT PROGRAM #
      ITEM I,J,K,LENGTH,SRCLINEPTR; 
  
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PUT SOURC","E CALLED.");
      $END
  
      SRCLINEPTR = LOC(SOURCELINE); 
      LENGTH = 8; 
      MDTABLEPTR[SRC$]  = NEXTFREEWORD; 
      MDENTRYSIZE[SRC$] = LENGTH; 
      MDENTRYCOUNT[SRC$]= CCTLASTLINE;
  
      # NOW MOVE THE SOURCE PROGRAM OVER.  LEAVE THE 0TH ENTRY UNUSED#
  
      SOURCELINE = " "; 
      PUTWAX(SOURCELINE,LENGTH*10,NEXTFREEWORD);
      NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
  
      # REWIND THE INPUT FILE BY (CCTLASTLINE  ) LINES  # 
  
      K =   (CCTLASTLINE  );
  
  
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," BEFORE","REWIND."); 
      $END
  
        BKSPREC(INFET); 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," AFTER","REWIND.");
      $END
  
      FOR I = 1 STEP 1 UNTIL K DO 
        BEGIN 
          GETSQ(INFET,SRCLINEPTR,80,EODEXIT); 
          PUTWAX(SOURCELINE,LENGTH*10,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + LENGTH; 
        END 
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," LEAVING","PUTSOURCE");
      $END
  
  
      RETURN; 
    END # OF PUTSOURCE #
CONTROL EJECT;
  
  
  
  
  PROC PUTDIRECTRYS;
    # PUT THE DIRECTORYS ONTO THE MODULE #
    # THE FILE AND MODULE DIRECTORIES HAVE TO BE PUT
      BACK ON THE FILE. THEN THE MASTER MODULE DIRECTORY
      HAS TO BE COPIED INTO A NEW SPOT ON THE FILE ( SO THAT
      THERE IS SPACE FOR THE NEW ENTRY) AND THE NEW ENTRY 
      HAS TO BE ADDED. #
  
    ITEM I,K,J; 
    ARRAY TEMPARRAY [0:0] S(MMDSIZE); 
      BEGIN 
      END 
  
    BEGIN 
      # PUT THE MODULE DIRECTORY ON THE FILE #
  
      PUTWAX(MODDIR,MODDIRSIZE*(MDTABLEMAX+1)*10, 
           FDNEXTFREEWD[0]);
  
      # COPY THE MASTER MODULE DIRECTORY TO A NEW SPOT #
  
      J = FDMASTERPTR[0];    # WORD ADDR. OF MASTER MODULE DIR.#
      FDMASTERPTR[0] = NEXTFREEWORD;  # W.A. OF NEW M.M. DIR.#
      FOR I = 0 STEP 1 UNTIL FDMODCOUNT[0] DO 
        BEGIN   # COPY OVER 1 ENTRY # 
          GETWAX(TEMPARRAY,10*MMDSIZE,J); 
          J = J + MMDSIZE;
          PUTWAX(TEMPARRAY,10*MMDSIZE,NEXTFREEWORD);
          NEXTFREEWORD = NEXTFREEWORD + MMDSIZE;
        END 
  
      FDMODCOUNT[0] = FDMODCOUNT[0] + 1;  #UPDATE MODULE COUNT# 
  
      # NOW ADD THE NEW ENTRY # 
  
      PUTWAX(MASTERMODDIR,10*MMDSIZE,NEXTFREEWORD); 
      NEXTFREEWORD = NEXTFREEWORD + MMDSIZE;
  
      # UPDATE THE FILE DIRECTORY # 
  
      FDNEXTFREEWD[0] = NEXTFREEWORD; 
  
      # PUT THE FILE DIRECTORY BACK ON THE FILE # 
  
      PUTWAX(FILEDIR,FILEDIRSIZE*10,1); 
  
  
  
  
      RETURN; 
    END # OF PUTDIRECTRYS # 
CONTROL EJECT;
  
  
 PROC EODEXIT;
   # CALLED IF HAVE END OF DATA # 
   BEGIN
     OUTPUT(2," EODEXIT","CALLED.");
   END # OF EODEXIT # 
  
  
  
  
  FUNC ZEROFILL(CH) U;
    # REPLACE EACH BLANK IN CH WITH A BYTE OF BINARY ZEROS #
    # (RECORD MANAGER DEMANDS ZERO FILL ON THE RIGHT FOR CHAR.
       STRING PARAMETERS, BUT SYMPL DOES BLANK FILL ) # 
    BEGIN 
      ITEM CH C(10),CH1 C(10), OCTCH U,I; 
      FOR I = 0 STEP 1 UNTIL 9 DO 
        BEGIN 
          CH1 = C<I,1>CH; 
          IF CH1 EQ " " THEN
            B<6*I,6> OCTCH = 0; 
          ELSE
            B<6*I,6> OCTCH = C<I,1>CH;
        END 
      ZEROFILL = OCTCH; 
      RETURN; 
  
    END # OF ZEROFILL # 
CONTROL EJECT;
  
  PROC MODIFYGTEXT; 
    # THIS ROUTINE ADDS CALLS TO THE RUN-TIME ROUTINES, INTO THE
      GTEXT.  IT COPIES THE GTEXT INTO A WORKING TABLE, THEN SCANS
      IT , LOOKING FOR COBOL VERBS. AS IT SCANS, IT COPIES THE
      ATOMS BACK INTO THE GTEXT TABLE.  EACH TIME IT RECOGNIZES A 
      COBOL VERB , IT PUT OUT A GTEXT "ENTER" CLAUSE.  IT ALSO
      BUILDS THE VERB TABLE IN WORKING TABLE WORK2. 
      THIS TABLE AND THE DIRECTORY ENTRY FOR THIS 
      TABLE IS PUT INTO THE MODULE. 
                                          # 
  
    # DECLARATIONS #
  
    DEF NEXTFREEFBST
    #   NEXTFLOWBLOK#;  # NEXT AVAIL. VERB TABLE
                          ENTRY # 
    DEF LASTPINIT   #7#;
    DEF LASTPDEFINE     #7#;
    DEF LASTPCOUNT  #7#;
    DEF LASTPEND    #5#;
    DEF LASTPEXIT   #5#;
  
    DEF GPOINTER(XX) #B<6,15> XX#;  # USED TO ACCESS THE
                                       GTEXT POINTER FIELD #
  
    # THIS DEF IS USED TO REFERENCE THE PROPER BIT POSITION.
      IT"S PARAMETER IS THE CODE OF THE GTEXT VERB (EG. GGOTO)# 
  
    DEF BRGVERB(XX) #B<XX-((XX/60)*60),1> BRVERB[XX/60] #;
  
  
    ITEM I,J,K;   # TEMPORARIES # 
  
    ITEM OLDCURRENT,  # CURSOR FOR GTEXT IN WORK1 # 
         LASTINDEX,  # LAST ORIGINAL GTEXT INDEX #
         NEXTFLOWBLOK ; # INDEX OF NEXT VERB BLOCK #
  
    # THE FOLLOWING DCL IS USED TO UNPACK A GTEXT ATOM INTO#
  
    ITEM CODE,
         POINTER, 
         SUBCODE; 
  
    ITEM NEXTFREEGTXT;  # NEXT AVAIL. GTEXT ATOM IN TABLE GTEXT#
    ITEM NEXTVERB B;  # USED BY FUNC NEWBLOCK # 
  
  
    # THESE NEXT 4 ARRAYS HOLD THE GTEXT PATTERNS FOR THE 4 
      VERB PACKETS THAT ARE ADDED TO THE GTEXT TO GET THE 
      DYNAMIC COUNT INFORMATION.# 
    # NOTE THAT EACH ARRAY ENTRY HAS 1 GTEXT ATOM IN IT.
      THE RIGHTMOST 30 BITS (...PART2) HOLDS THE ATOM. #
  
  
    ARRAY PDEFINE[0:LASTPDEFINE] S(1);
      BEGIN 
        ITEM PDEFINEWORD U(0,0,60); 
        ITEM PDEFINEPART1 U(0,0,30);
        ITEM PDEFINEPART2 U(0,30,30)=[
          O"11 00153 137",  # VERB DESCRIPTION #
          O"07 00000 000",  # LINE AND COLUMN # 
          O"11 00000 031",  # ENTER VERB #
          O"10 00000 000",  # SYS-NAME-REF (LAT POINTER) #
          O"07 00000 066",  # FORTRAN-X # 
          O"07 00001 005",  # NUMBER OF PARAMETERS #
          O"11 00001 067",  # PARAMETER VERB #
          O"04 00000 000"   # LITREF ( SCRATCH FILE NAME)#
                                   ]; 
      END 
  
    ARRAY PINIT[0:LASTPINIT] S(1);
      BEGIN 
        ITEM PINITWORD U(0,0,60); 
        ITEM PINITPART1 U(0,0,30);
        ITEM PINITPART2 U(0,30,30)=[
          O"11 00153 137",  # VERB DESCRIPTION #
          O"07 00000 000",  # LINE AND COLUMN # 
          O"11 00000 031",  # ENTER VERB #
          O"10 00000 000",  # SYS-NAME-REF (LAT POINTER) #
          O"07 00000 066",  # FORTRAN-X # 
          O"07 00001 005",  # NUMBER OF PARAMETERS #
          O"11 00001 067",  # PARAMETER VERB #
          O"04 00000 000"   # LITREF ( MASTER MODULE INDEX)#
                                   ]; 
      END 
  
    ARRAY PCOUNT [0:8] S(1);
      BEGIN 
        ITEM PCOUNTWORD U(0,0,60);
        ITEM PCOUNTPART1 U(0,0,30); 
        ITEM PCOUNTPART2 U(0,30,30)=[ 
          O"11 00153 137",  # VERB DESCRIPTION #
          O"07 00000 000",  # LINE AND COLUMN # 
          O"11 00000 031",  # ENTER VERB #
          O"10 00000 000",  # SYS-NAME-REF (LAT POINTER) #
          O"07 00000 066",  # FORTRAN-X # 
          O"07 00001 005",  # NUMBER OF PARAMETERS #
          O"11 00001 067",  # PARAMETER VERB #
          O"04 00000 000"   # LIT-REF ( VERB BLOCK INDEX ) #
                                    ];
      END 
  
    ARRAY PEND [0:6] S(1);
      BEGIN 
        ITEM PENDWORD U(0,0,60);
        ITEM PENDPART1 U(0,0,30); 
        ITEM PENDPART2 U(0,30,30)=[ 
          O"11 00153 137",  # VERB DESCRIPTION #
          O"07 00000 000",  # LINE AND COLUMN # 
          O"11 00000 031",  # ENTER VERB #
          O"10 00000 000",  # SYS-NAME-REF (LAT POINTER) #
          O"07 00000 066",  # FORTRAN-X # 
          O"07 00000 005"   # NUMBER OF PARAMETERS #
                                  ];
      END 
  
    ARRAY PEXIT [0:6] S(1); 
      BEGIN 
        ITEM PEXITWORD U(0,0,60); 
        ITEM PEXITPART1 U(0,0,30);
        ITEM PEXITPART2 U(0,30,30)=[
          O"11 00153 137",  # VERB DESCRIPTION #
          O"07 00000 000",  # LINE AND COLUMN # 
          O"11 00000 031",  # ENTER VERB #
          O"10 00000 000",  # SYS-NAME-REF (LAT POINTER) #
          O"07 00000 066",  # FORTRAN-X # 
          O"07 00000 005"   # NUMBER OF PARAMETERS #
                                  ];
      END 
  
  
    # THIS ARRAY IS USED AS A BIT ARRAY . IF THE BIT IS ON, 
      THEN THE GTEXT VERB WHICH CORRESPONDS TO THIS BIT IS A
      BRANCH TYPE VERB ( IE. STARTS OR ENDS A FLOW BLOCK). THE
      VERB CODES 0-59 ARE IN WORD 0, 60 TO 119 IN WORD 1 ETC.#
  
    ARRAY BRVERBARRAY[0:2] S(1);
      ITEM BRVERB U(0,0,60)=[0,0,0];
  
  
  
    # INTERNAL PROCEDURES # 
  
    PROC LATBUILD(CODE,STRING,LENGTH);
      # BUILD THE NEXT LAT ENTRY AND THE ASSOCIATED PLT AND 
        DNAT ENTRIES, USING THE CHARACTER STRING IN "STRING". 
        CODE = 1 IF STRING IS "PROINIT","PRODEF","PRCOUNT","PROEND".
        CODE = 2 IF STRING IS A VERB BLOCK INDEX.  THE NEXT FREE
        ENTRIES FOR THE TABLES INVOLVED IS GIVEN IN THE CCT.# 
  
      ITEM CODE I,
           STRING C(10),
           LENGTH I;
      ITEM I,K,J; 
      BEGIN 
        # FIRST INCREMENT THE CCT FIELDS TO SHOW 1 MORE ENTRY IN
          THE APPROPRIATE TABLES.#
  
        CCTLATLEN = CCTLATLEN + 1;
        CCTDNATLEN = CCTDNATLEN + 1;
        CCTPLTLEN  = CCTPLTLEN + 1; 
  
        # BUILD LAT ENTRY # 
  
        L$DNAT[VIRTUAL(LAT$,CCTLATLEN)] = CCTDNATLEN; 
        L$PLT[VIRTUAL(LAT$,CCTLATLEN)]  = CCTPLTLEN;
  
        IF CODE EQ 1 THEN 
          BEGIN 
            DN$LEVEL[VIRTUAL(DNAT$,CCTDNATLEN)] = LITLEVL;
            DN$ITMLEN[VIRTUAL(DNAT$,CCTDNATLEN)] = LENGTH;
            DN$TYPE[VIRTUAL(DNAT$,CCTDNATLEN)] = NONDATA; 
            PL$LENGTH[VIRTUAL(PLT$,CCTPLTLEN)] = LENGTH;
          END 
        ELSE
          BEGIN 
            DN$LEVEL[VIRTUAL(DNAT$,CCTDNATLEN)] = LITLEVL;
            DN$TYPE[VIRTUAL(DNAT$,CCTDNATLEN)] = ALPHNUM; 
            DN$ITMLEN[VIRTUAL(DNAT$,CCTDNATLEN)] = 10;
            PL$LENGTH[VIRTUAL(PLT$,CCTPLTLEN)] = 10;
          END 
  
        PL$CODE[VIRTUAL(PLT$,CCTPLTLEN)] = PLTQUOTEDLIT;
        SETPLST(CCTPLTLEN,LOC(STRING)); 
      END # OF LATBUILD # 
  
  
  
    PROC COPYGTEXT; 
      # THIS COPIES THE GTEXT TO WORK1 #
      ITEM I,J,K U; 
      BEGIN 
        $BEGIN
          IF PRODEBUG THEN OUTPUT(2," COPYGTEXT"," CALLED."); 
        $END
  
        J = CCTGTEXTLEN/2 + 1;
        FOR I = 0 STEP 1 UNTIL J DO 
          BEGIN 
            K = GATOM[VIRTUAL(GTEXT$,I)]; 
            WORK1WORD[VIRTUAL(WORK1$,I)] = K; 
          END 
        RETURN; 
  
  
      END # OF COPYGTEXT #
  
    PROC GETATOM(INDEX);
      # PUT THE ASSOCIATED ATOM FIELDS INTO THE DATA ITEMS NAMED
        CODE, POINTER AND SUBCODE.  "INDEX" IS THE LOGICAL INDEX
        FOR THIS ATOM # 
      ITEM INDEX; 
      ITEM I, J, ATOM U;
      BEGIN 
        I = INDEX/2;  # CALCULATE THE WORD INDEX #
        ATOM = WORK1WORD[VIRTUAL(WORK1$,I)];
        IF INDEX - I*2 EQ 0 THEN  #ATOM IS IN 1ST HALF OF WORD# 
          BEGIN 
            CODE = B<0,6> ATOM; 
            POINTER = B<6,15> ATOM; 
            SUBCODE = B<21,9> ATOM; 
          END 
        ELSE
          BEGIN 
            # THE ATOM IS IN THE 2ND HALF OF THE WORD # 
            CODE =    B<30,6> ATOM; 
            POINTER = B<36,15> ATOM;
            SUBCODE = B<51,9> ATOM; 
          END 
        $BEGIN
          IF PRODEBUG THEN OUTPUT(8," INDEX =",DEC(INDEX),
          " CODE =",DEC(CODE)," POINTER =",DEC(POINTER),
          " SUBCODE =",DEC(SUBCODE)  ); 
        $END
  
      END # OF GETATOM #
  
    PROC MOVEATOM(OLDINDEX ); 
      # MOVE THE ATOM WITH INDEX "OLDINDEX" ( IN WORK1) INTO THE
        POSITION "NEXTFREEGTXT" (IN GTEXT) #
      ITEM OLDINDEX;
      ITEM I,J, ATOM U; 
      BEGIN 
        I = OLDINDEX/2;  # I IS THE WORD INDEX #
        ATOM = WORK1WORD[VIRTUAL(WORK1$,I)];
        IF OLDINDEX - I*2 EQ 0 THEN  # IN 1ST HALF OF THE WORD #
          I = 0;  # ATOM STARTS IN BIT POSITION ZERO #
        ELSE
          I = 30;  # ATOM STARTS IN BIT POSITION 30 # 
  
        J = NEXTFREEGTXT/2;  # WORD INDEX OF NEXT FREE ENTRY IN THE 
                                GTEXT TABLE # 
        IF NEXTFREEGTXT - J*2 EQ 0 THEN  # IN 1ST HALF OF THE WORD #
          GATOM1[VIRTUAL(GTEXT$,J)] = B<I,30>ATOM;
        ELSE
          GATOM2[VIRTUAL(GTEXT$,J)] = B<I,30>ATOM;
  
        $BEGIN
          IF PRODEBUG THEN OUTPUT(4," MOVE ", DEC(OLDINDEX),
                                    " TO ", DEC(NEXTFREEGTXT)); 
        $END
  
        NEXTFREEGTXT = NEXTFREEGTXT + 1;
        RETURN; 
  
      END 
  
    PROC ADDENTERVERB(WHICHENTER,LAST); 
      # MOVE THE GTEXT FOR THE "ENTER" VERB, WHICH IS IN ARRAY
        "WHICHENTER" AND HAS LENGTH OF "LAST" + 1 ATOMS, INTO THE 
        GTEXT TABLE. UPDATE THE NEXT FREE ATOM POINTER #
      ITEM LAST;
      ARRAY WHICHENTER [0:5] S(1);
        BEGIN 
          ITEM ENTERWORD U(0,0,60); 
          ITEM ENTERPART2 U(0,30,30); 
        END 
      ITEM I,J; 
  
      BEGIN 
        FOR I = 0 STEP 1 UNTIL LAST DO
          BEGIN 
            J = NEXTFREEGTXT/2;  # WORD INDEX OF GTEXT ATOM # 
            IF NEXTFREEGTXT - 2*J EQ 0 THEN  # PUT IN 1ST HALF OF 
                                               THE WORD # 
              GATOM1[VIRTUAL(GTEXT$,J)] = ENTERPART2[I];
            ELSE
              GATOM2[VIRTUAL(GTEXT$,J)] = ENTERPART2[I];
            NEXTFREEGTXT = NEXTFREEGTXT + 1;
          END 
        RETURN; 
  
      END # OF ADDENTERVERB # 
  
   PROC BUILDENTER; 
      # BUILD THE GTEXT CLAUSE FOR THE "ENTER" VERB FOR THIS FLOW 
        BLOCK.  THE NUMBER OF THIS FLOW BLOCK IS 1 MORE THAN THAT OF
        THE LAST BLOCK.  THE GTEXT IS BUILT IN ARRAY "PCOUNT".  THE 
        ASSOCIATED LAT AND DNAT ENTRIES ARE BUILT , AND THE CCT IS
        UPDATED TO REFLECT THESE ADDITIONS. # 
      # THE FBST   TABLE IS ALSO BUILT BY CALLING 
        BUILDSTARTBL. # 
  
      ITEM I,J,K; 
      ITEM CH C(10);
      DEF PARAMCODE #2#;
      DEF ROUTINECODE #1#;
      BEGIN 
        $BEGIN
          IF PRODEBUG THEN OUTPUT(2," BUILDENTE","R CALLED.");
        $END
        # 1ST CALCULATE THELENGTH OF THE FLOW BLOCK NUMBER AS A 
          CHARACTER STRING.  THEN SET UP THE GTEXT FOR THE CALL.# 
  
        CH = DEC(NEXTFLOWBLOK); 
  
        LATBUILD(ROUTINECODE,"PRCOUNT",7);
        GPOINTER(PCOUNTPART2[3]) = CCTLATLEN; 
        LATBUILD(PARAMCODE,CH,10);
        GPOINTER(PCOUNTPART2[7]) = CCTLATLEN; 
  
        BUILDSTARTBL;  # ADD NEW ENTRY TO FBST# 
        RETURN; 
  
      END # OF BUILDENTER # 
  
    PROC ENTERINIT; 
      # INITIALIZE ARRAYS "PINIT", "PDEFINE",  AND "PEND" WHICH HOLD
        THE GTEXT "ENTER" SKELETONS FOR CALLING THE RUN-TIME ROUTINES 
        PROINIT,PROEND,PRODEF.   ASSOCIATED LAT, PLT AND DNAT ENTRIES 
        ARE BUILT AND THE CCT IS UPDATED TO REFLECT THIS. # 
  
      DEF ROUTINECODE #1#;
      DEF PARAMCODE #2#;
      ITEM I,J, CH C(10); 
  
      BEGIN 
        $BEGIN
          IF PRODEBUG THEN OUTPUT(2," ENTERINIT"," CALLED."); 
        $END
  
        # BUILD GTEXT FOR THE CALL TO PROINIT # 
        # BUILD LAT ENTRIES FOR THE PROCEDURE NAME AND THE
          MASTER MODULE INDEX FOR THIS MODULE. #
  
        CH = DEC(FDMODCOUNT[0] + 1);
        LATBUILD(PARAMCODE,CH,10);
        GPOINTER(PINITPART2[7]) = CCTLATLEN;
  
        LATBUILD(ROUTINECODE,"PROINIT",7);
        GPOINTER(PINITPART2[3]) = CCTLATLEN;
  
  
        # BUILD GTEXT FOR THE CALL TO PROEND #
  
        LATBUILD(ROUTINECODE,"PROEND",6); 
        GPOINTER(PENDPART2[3]) = CCTLATLEN; 
  
        # BUILD THE GTEXT FOR THE CALL TO PROEXIT # 
  
        LATBUILD(ROUTINECODE,"PROEXIT",7);
        GPOINTER(PEXITPART2[3]) = CCTLATLEN;
  
        # BUILD GTEXT FOR THE CALL TO PRODEF #
        # BUILD LAT ENTRIES FOR THE PROCEDURE NAME AND
          THE SCRATCH FILE NAME # 
  
        # BLANK FILL THE FILE NAME FOR LAT ENTRY #
        BEGIN 
          ITEM III, CCTTEMP C(10);
          CCTTEMP = CCTUARFILE; 
          FOR III = 0 STEP 1 UNTIL 9 DO 
            IF C<III,1> CCTTEMP EQ 0 THEN 
              C<III,1> CCTTEMP = " "; 
        END 
  
        LATBUILD(PARAMCODE,CCTTEMP,10); 
        GPOINTER(PDEFINEPART2[7]) = CCTLATLEN;
  
        LATBUILD(ROUTINECODE,"PRODEF",6); 
        GPOINTER(PDEFINEPART2[3]) = CCTLATLEN;
  
        RETURN; 
  
      END # OF ENTERINIT #
  
  
  
  
    PROC BUILDSTARTBL;
      # ADD A NEW ENTRY TO THE FLOW BLOCK START TABLE.  THIS TABLE
        USES WORK2 AS ITS WORK SPACE. # 
      BEGIN 
        # THE BLOCK STARTS WITH GTEXT[OLDCURRENT] # 
  
        WORK2WORD[VIRTUAL(WORK2$,NEXTFREEFBST)] = OLDCURRENT; 
        NEXTFREEFBST = NEXTFREEFBST + 1;
        RETURN; 
  
      END # OF BUILDSTARTBL # 
  
    PROC BRVERBINIT;
      # INITIALIZE BRVERBARRAY WHICH CONTAINS A 1 IN THE ITH
        BIT POSITION IF THE GTEXT VERB WITH CODE I IS A BRANCH
        TYPE VERB # 
      BEGIN 
  
        BRGVERB( GALPHA ) = 1;
        BRGVERB( GATEND ) = 1;
        BRGVERB( GCALL ) = 1; 
        BRGVERB( GCOMPARE ) = 1;
        BRGVERB( GENTRY ) = 1;
        BRGVERB( GEQUAL ) = 1;
        BRGVERB( GGOTO ) = 1; 
        BRGVERB( GGOTODEP ) = 1;
        BRGVERB( GGREATER ) = 1;
        BRGVERB( GINTO ) = 1; 
        BRGVERB( GINVKEY ) = 1; 
        BRGVERB( GIOSUCC ) = 1; 
        BRGVERB( GLABEL ) = 1;
        BRGVERB( GLESS ) = 1; 
        BRGVERB( GNOTALPH ) = 1;
        BRGVERB( GNOTEQ ) = 1;
        BRGVERB( GNOTGT ) = 1;
        BRGVERB( GNOTLT ) = 1;
        BRGVERB( GNOTNUM ) = 1; 
        BRGVERB( GNUMERIC ) = 1;
        BRGVERB( GOVERFLO ) = 1;
        BRGVERB( GPERFORM ) = 1;
        BRGVERB( GPERFACT ) = 1;
        BRGVERB( GPERFCPX ) = 1;
        BRGVERB( GPERFEND ) = 1;
        BRGVERB( GPERFIO ) = 1; 
        BRGVERB( GPERIP ) = 1;
        BRGVERB( GPEROP ) = 1;
        BRGVERB( GPEROM ) = 1;
        BRGVERB( GPERFTM ) = 1; 
        BRGVERB( GPROC ) = 1; 
        BRGVERB( GRETATND ) = 1;
        BRGVERB( GSIZEND ) = 1; 
        BRGVERB( GSIZEIR ) = 1; 
        BRGVERB( GSTRING ) = 1; 
        BRGVERB( GSWITCH ) = 1; 
        BRGVERB( GUNSTRNG ) = 1;
        BRGVERB( GNOTSSW ) = 1; 
        BRGVERB( GPOSITV ) = 1; 
        BRGVERB( GNEGATV ) = 1; 
        BRGVERB( GNOTPOS ) = 1; 
        BRGVERB( GNOTNEG ) = 1; 
        $BEGIN
          IF PRODEBUG THEN OUTPUT(8," BRVERB=",OCT(BRVERB[0], 
          0,10)," ",OCT(BRVERB[0],10,10)," ",OCT(BRVERB[1],0,10), 
          " ",OCT(BRVERB[1],10,10)  );
        $END
        RETURN; 
      END # OF BRVERBINIT # 
  
  
    FUNC NEWBLOCK B;
      # RETURNS TRUE IF "OLDCURRENT" POINTS TO THE START OF A NEW 
        FLOW BLOCK.  #
  
      FUNC BRANCHVERB B;
        BEGIN 
          IF BRGVERB(SUBCODE) EQ 1 THEN  # HAVE BRANCH-TYPE VERB# 
            BRANCHVERB = TRUE;
          ELSE
             BRANCHVERB = FALSE;
          RETURN; 
  
        END # OF BRANCHVERB # 
  
      BEGIN 
        IF CODE NQ GVERB THEN  # CAN"T START NEW BLOCK #
          BEGIN 
            NEWBLOCK = FALSE; 
            RETURN; 
          END 
  
        # HAVE A GTEXT VERB TO GET TO HERE. # 
  
        IF NEXTVERB THEN  # THIS IS THE START OF THE GTEXT CODE 
                            FOR A NEW BLOCK # 
          NEWBLOCK = TRUE;
        ELSE
          NEWBLOCK =FALSE;
  
        # NOW CHECK TO SEE IF THIS VERB OR THE NEXT 
          VERB IS THE START OF A NEW BLOCK #
  
        IF BRANCHVERB THEN  # NEXT VERB STARTS NEW BLOCK #
          BEGIN 
            IF SUBCODE EQ GPROC OR SUBCODE EQ GLABEL THEN 
              # HAVE PROCEDURE-NAME DEFINITION #
              BEGIN 
                NEWBLOCK = TRUE;
                NEXTVERB = FALSE; 
              END 
            ELSE
              NEXTVERB = TRUE;
          END 
  
        ELSE
          NEXTVERB = FALSE; 
  
      END # OF NEWBLOCK # 
  
  
    FUNC STOPRUN B; 
      # RETURNS TRUE IF "OLDCURRENT" POINTS TO THE VERB 
        DESCRIPTION ATOM FOR A "STOP RUN" STATEMENT. #
  
      BEGIN 
        IF CODE NQ GVERB OR POINTER NQ RWSTOP OR SUBCODE NQ GVERBDES
          THEN
          BEGIN 
            STOPRUN = FALSE;
            RETURN; 
          END 
        # WE HAVE "STOP", SO NOW SEE IF IT IS " STOP RUN" # 
  
        GETATOM(OLDCURRENT + 3);  # GET POTENTIAL "RUN" ATOM #
        IF CODE NQ GSUBVERB OR SUBCODE NQ 31 THEN 
          STOPRUN = FALSE;
        ELSE
          STOPRUN = TRUE; 
        GETATOM(OLDCURRENT);  # RESTORE VALUES IN "CODE" ETC. # 
        RETURN; 
      END  # OF STOPRUN # 
  
  
    FUNC EXITPRGM B;
      # RETURNS TRUE IF "OLDCURRENT" POINTS TO THE VERB 
        DESCRIPTION ATOM FOR A "EXIT PROGRAM" STATEMENT. #
  
      BEGIN 
        IF CODE NQ GVERB OR POINTER NQ RWPROGRAM OR SUBCODE NQ GVERBDES 
          THEN
          BEGIN 
            EXITPRGM = FALSE; 
            RETURN; 
          END 
        #   SO NOW SEE IF IT IS " EXIT PROGRAM" # 
        # AND NOT A NULL OR ABORT ATOM #
  
        GETATOM(OLDCURRENT + 2);  # GET POTENTIAL "EXITP" ATOM #
        IF CODE NQ GVERB OR SUBCODE NQ GEXITP THEN
          EXITPRGM = FALSE; 
        ELSE
          EXITPRGM = TRUE;
        GETATOM(OLDCURRENT);  # RESTORE VALUES IN "CODE" ETC. # 
        RETURN; 
      END  # OF EXITPRGM #
  
    PROC STOPEXITCHEK;
      # THIS PROC PUTS OUT THE APPROPRIATE GTEXT IF "STOP RUN"
        OR "EXIT PROGRAM" IS POINTED TO BY OLDCURRENT # 
      BEGIN 
  
          IF STOPRUN THEN # LOOKING AT VERB DESCRIPTION ATOM
                             FOR "STOP RUN", SO PUT OUT THE 
                             "ENTER .. PROEND" GTEXT #
            ADDENTERVERB(PEND,LASTPEND);
          ELSE
          IF EXITPRGM THEN  # LOOKING AT VERB DESC. ATOM FOR
                              "EXIT PROGRAM". PUT OUT GTEXT # 
            ADDENTERVERB(PEXIT,LASTPEXIT);
        RETURN; 
      END # OF STOPEXITCHEK # 
  
  
  
    # START OF BODY OF MODIFYGTEXT #
  
    BEGIN 
      #INITIALIZATION # 
  
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," MODIFYGTE","XT CALLED."); 
      $END
  
      NEXTFLOWBLOK = 1; # FLOW BLOCKS ARE NUMBERED FROM 1 # 
      # ZERO OUT THE 1ST FBST TABLE ENTRY. THE FBST TABLE IS
        BUILT IN WORK2 #
      WORK2WORD[VIRTUAL(WORK2$,0)] = 0; 
      WORK2WORD[VIRTUAL(WORK2$,1)] = 0; 
      NEXTVERB = FALSE; 
  
      OLDCURRENT = 0; 
  
      # CCTGTEXTLEN GIVES THE NUMBER OF GTEXT ATOMS. HOWEVER, 
        THE FIRST WORD OF MEMORY IS NOT USED. THUS THE LAST 
        ATOM HAS AN INDEX OF CCTGTEXTLEN + 1.  THE LAST COMPILER
        GENERATED SECTION-NAME IS AT CCTGTEXTLEN - 3 #
  
      LASTINDEX = CCTGTEXTLEN - 4;
      NEXTFREEGTXT = 0; 
      BRVERBINIT;  # INITIALIZE THE BRVERBARRAY # 
  
    NONDCL1STSEC = CCTDCLLOWBND + 1;  # 1ST NON-DECLARATIVE SECTION#
  
  
      ENTERINIT;
  
      COPYGTEXT; # COPY GTEXT INTO WORK1 #
  
    # SCAN THE GTEXT FOR THE FIRST PARAGRAPH- OR SECTION-NAME.EACH
        SCANNED ATOM IS ALWAYS COPIED BACK INTO THE ORIGINAL
        GTEXT TABLE. #
      # THE START IS AT THE FIRST 
        PROCEDURE-NAME DEFINITION. #
  
      GETATOM(OLDCURRENT);
      ASLONGAS (CODE NQ GVERB OR SUBCODE NQ GPROC) AND
                OLDCURRENT LQ LASTINDEX  DO 
        BEGIN 
          MOVEATOM(OLDCURRENT); 
          OLDCURRENT = OLDCURRENT + 1;
          GETATOM(OLDCURRENT);
        END 
  
  
  
      # FOUND THE 1ST PROC-NAME DEFINITION #
  
      # NOW LOOP THRU ALL THE REST OF THE GTEXT ON WORK1, LOOKING 
        FOR AND PROCESSING FLOW BLOCKS #
      # A FLOW BLOCK IS A SEQUENCE OF GTEXT ATOMS WHICH 
        HAS 1 ENTRY POINT (AT THE BEGINNING), AND 1 EXIT POINT ( AT THE 
        END).    #
  
  
  
  
      ASLONGAS OLDCURRENT LQ LASTINDEX DO 
        BEGIN 
  
          IF NEWBLOCK THEN # HAVE START OF NEW BLOCK #
            BEGIN 
              BUILDENTER; 
              IF SUBCODE EQ GLABEL OR SUBCODE EQ GPROC THEN 
                BEGIN 
                  ITEM FLAG1 B; 
                  IF POINTER EQ NONDCL1STSEC THEN 
                    FLAG1 = TRUE;    # THIS SIGNIFIES THE START OF
                                        THE PROGRAM # 
                  ELSE
                    FLAG1 = FALSE;
                  MOVEATOM(OLDCURRENT); # MOVE  PROC. DEF. ATOM OVER #
                  OLDCURRENT = OLDCURRENT + 1;
                  GETATOM(OLDCURRENT);
                  IF CODE EQ GVERB AND SUBCODE EQ GSEPARAT THEN 
                    MOVEATOM(OLDCURRENT);  # MOVE THE SEPARATOR # 
                  ELSE   # NO SEPARATOR SO BACK UP POINTER #
                    OLDCURRENT = OLDCURRENT - 1;
  
                IF FLAG1 THEN  # PUT OUT "ENTER" STATEMENTS WHICH COME
                                 AT THE START OF THE PROGRAM #
                  BEGIN 
                    IF MAINSUB THEN  #THIS PROGRAM HAS THE MAIN ENTRY 
                                     POINT, SO ADD THE CALL TO "PRODEF"#
                      ADDENTERVERB(PDEFINE,LASTPDEFINE);
                    ADDENTERVERB(PINIT,LASTPINIT);
                  END 
  
                  ADDENTERVERB(PCOUNT,LASTPCOUNT);
                END 
              ELSE
              IF CODE EQ GVERB AND SUBCODE EQ GSEPARAT THEN 
                BEGIN  # MOVE SEPARATOR ATOM, THEN "ENTER" #
                  MOVEATOM(OLDCURRENT); 
                  ADDENTERVERB(PCOUNT,LASTPCOUNT);
                END 
              ELSE
                BEGIN 
                  ADDENTERVERB(PCOUNT,LASTPCOUNT);
                  MOVEATOM(OLDCURRENT); 
                END 
              STOPEXITCHEK;  # CHECK FOR "STOP RUN" OR
                                  "EXIT PROGRAM" #
            END 
          ELSE
          BEGIN 
            STOPEXITCHEK; 
            MOVEATOM(OLDCURRENT); 
          END 
  
        OLDCURRENT = OLDCURRENT + 1;
        GETATOM(OLDCURRENT);    # UNPACK THE GTEXT ATOM  #
        END # OF ASLONGAS LOOP #
  
      # NOW DO CLEAN-UP # 
  
      ASLONGAS OLDCURRENT LQ LASTINDEX+5 DO # MOVE REMAINING GTEXT
                                               OVER # 
        BEGIN 
          MOVEATOM(OLDCURRENT); 
          OLDCURRENT = OLDCURRENT + 1;
        END 
  
  
      CCTGTEXTLEN = NEXTFREEGTXT - 2;  # SET UP GTEXT LENGTH #
  
      # NOW PUT START TABLE INTO THE MODULE # 
  
      # NOW ADD THE DIRECTORY ENTRY FOR COUNT AND START TABLES AND PUT
        THE FLOW BLOCK START TABLE ON THE MODULE #
  
      PUTFBST(NEXTFREEFBST - 1);
      PUTFBCTENTRY(NEXTFLOWBLOK - 1); 
  
    END # OF MODIFYGTEXT #
CONTROL EJECT;
  
  # END OF THE INTERNAL PROCEDURES FOR PROFILE #
  
  
  
  # MAIN BODY OF PROFILE #
  BEGIN 
  
  
  
  
  
  ENTRY PROC PRINIT; # INITIALIZATION # 
    BEGIN 
  
      # THE INITIALIZATION WORK IS DONE HERE.  IF 
        THESE LOOK LIKE A VALID FILE DIRECTORY, THEN THE
        SUB-PROGRAM BEING COMPILED DOES NOT HAVE THE MAIN ENTRY 
        POINT( THE MAIN ENTRY POINT SUB-PROGRAM IS THE 1ST PUT
        INTO THE SCRATCH FILE, BY DEFINITION).  IF THE USER 
        PROVIDED A SCRATCH FILE, THEN ITS NAME IS IN CCTUARFILE,
        ELSE IT IS GIVEN THE DEFAULT NAME OF "MODULE".  THE FILE
        DIRECTORY IS UPDATED OR BUILT AS NECESSARY. # 
  
      XREF  ITEM LFNINST C(10); 
  
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PRINIT","CALLED."); 
      $END
  
      LFNINST = CCTUARFILE;    #MAKE LFN AVAILABLE TO INST I-O# 
  
      # GET THE FIRST WORDS OF THE FILE.  IF IT IS NOT A FILE 
        DIRECTORY, THEN ONE MUST BE BUILT#
  
      GETWAX(FILEDIR,10*FILEDIRSIZE,1); 
      MAINSUB = NOT CCTSUBPROGR[0];  # FALSE IF THIS SUB-PRGM 
                                       IS A SUBROUTINE #
  
      IF FDNAME EQ CCTUARFILE THEN  # HAVE VALID DIRECTORY #
        BEGIN 
          # 
            SEARCH THE MASTER MODULE DIRECTORY TO SEE IF THERE
            IS A MODULE FOR THIS SUB-PROGRAM ALREADY ON THE 
            FILE.  IF SO, THEN IT IS MARKED AS NOT BEING THE MOST 
            RECENT. # 
  
          J = FDMASTERPTR[0] + MMDSIZE;  # W.A. OF 1ST ENTRY (0TH 
                                           ENTRY IS NOT USED) # 
          FOR I = 1 STEP 1 UNTIL FDMODCOUNT[0] DO 
            BEGIN 
              GETWAX(MASTERMODDIR,10*MMDSIZE,J);
              IF MMDPROGID[0] EQ CCTPROGRAMID[0] THEN   # FOUND 1#
                BEGIN 
                  MMDOLDMODULE[0] = TRUE;   # MARK MODULE AS HAVING 
                                              BEEN REPLACED # 
                  PUTWAX(MASTERMODDIR,10*MMDSIZE,J);
                END 
              J = J + MMDSIZE;
            END  # OF FOR LOOP #
  
        END 
      ELSE  # HAVE NEW FILE, SO BUILD DIRECTORY # 
        BEGIN 
          FDNAME[0]      = CCTUARFILE;
          FDDATE[0]      = LISTDAT; 
          FDTIME[0]      = LISTTIM; 
          FDMODCOUNT[0]  = 0; 
          FDNEXTFREEWD[0]= FILEDIRSIZE + MMDSIZE + 1; 
          FDMASTERPTR[0] = FILEDIRSIZE + 1; 
        END 
  
      # NOTE THAT THE MASTER MODULE DIRECTORY HAS A 
        0TH ENTRY WHICH IS NOT USED. #
  
      # SET UP THE MASTER MODULE DIRECTORY ENTRY FOR THIS PROGRAM#
  
      MMDPROGID[0]    = CCTPROGRAMID[0];
      MMDDATE[0]      = LISTDAT;
      MMDTIME[0]      = LISTTIM;
      MMDMODULEPTR[0] = FDNEXTFREEWD[0];
      MMDOLDMODULE[0] = FALSE;
      MMDSUBPROG[0] = CCTSUBPROGR[0]; 
  
      # NOTE THAT THE MODULE STARTS AT FDNEXTFREEWD[0] #
  
      # SET NEXTFREEWORD TO LEAVE ROOM FOR THE MODULE DIRECTORY # 
  
      NEXTFREEWORD = FDNEXTFREEWD[0] + MODDIRSIZE*(MDTABLEMAX+1); 
  
  
      RETURN; 
    END # OF PRINIT # 
CONTROL EJECT;
  
  ENTRY PROC PRDUMP (OVLNUMBER);
    BEGIN 
      # THIS ENTRY POINT IS CALLED AFTER EVERY PHASE FROM 
        S-SCANNER TO L-POOLER.  THE OVLNUMBER IS USED TO DETERMINE
        WHAT IS TO BE DONE.  BASICALLY,  TABLES ARE ADDED 
        TO THE MODULE.AFTER P-PARSER, GTEXT MODIFICATION IS NECESSARY 
                      # 
      SWITCH PHASESW : OVERLAY
                 NL1 : NULL,
                 NL1 : CBINIT,        # NL1 IS USED WHEN THERE IS NO
                                        WORK TO DO AFTER THIS PHASE#
                 SS1 : SSCANNER,
                 NL1 : PICANALYZR,
                 NL1 : DBTRANS, 
                 NL1 : DPARSER, 
                 NL1 : DANALYZER, 
                 NL1 : RPARSER, 
                 RG1 : RGEN,
                 PP1 : PPARSER, 
                 LP1 : LITPOOLER; 
  
      $BEGIN
        IF PRODEBUG THEN
          BEGIN 
            OUTPUT(2," PRDUMP","CALLED.");
            OUTPUT(2," OVLNUM=",DEC(OVLNUMBER));
          END 
      $END
  
      GOTO PHASESW[OVLNUMBER];
  
    SS1:  
      BEGIN 
  
        # PUT THE DNT, PNT, AWRT, INT AND CTEXT ONTO THE RAW
          PROGRAM MODULE (RPM).#
        $BEGIN
          IF PRODEBUG THEN OUTPUT(2," PRDUMP ","OF SS."); 
        $END
  
        PUTPNT; 
        PUTDNT; 
        PUTAWRT;
        PUTINT; 
        PUTCTEXT; 
        PUTSOURCE;
  
        RETURN; 
      END 
  
    NL1:  
      # THERE ARE NO TABLES TO DUMP # 
      BEGIN 
        RETURN; 
      END 
  
    RG1:  
      BEGIN 
        # RGEN ADDS CTEXT, SO HAVE TO GET A NEW COPY OF CTEXT#
        PUTCTEXT; 
        RETURN; 
      END 
  
    PP1:  
      BEGIN 
        # ALSO, MODIFY THE GTEXT TO INCLUDE CALLS TO THE COUNTING 
          ROUTINES #
  
        $BEGIN
          IF PRODEBUG THEN OUTPUT(2," PRDUMP ","OF PP");
        $END
  
        PUTFNAT;
        PUTLAT; 
        PUTDNAT;
        PUTPNAT;
        PUTPLT; 
        PUTPLST;
        PUTGTEXT; 
        PUTCCT; 
        PUTAUX; 
  
  
        #   DO THE GTEXT MODIFICATION # 
  
        MODIFYGTEXT;
  
        RETURN; 
      END 
  
    LP1:  
      BEGIN 
        # PUT THE LOW AND HIGH VALUES FOR THE PROGRAM INTO
          CPMCOMM AND PUT IT ON THE MODULE# 
  
        CPMHIGHVALUE = CCTHIVALUE;
        CPMLOWVALUE  = CCTLOVALUE;
        PUTCPMCOMM; 
        RETURN; 
      END # OF LP1 #
  
    END # OF ENTRY PRDUMP#
CONTROL EJECT;
  
  ENTRY PROC PREND; 
    BEGIN 
      # THIS IS THE CLEAN-UP ROUTINE #
      # CLOSE THE FILE WHICH CONTAINS THE MODULE #
  
      $BEGIN
        IF PRODEBUG THEN OUTPUT(2," PREND","CALLED.");
      $END
      PUTDIRECTRYS; # PUT THE DIRECTORYS ON THE MODULE #
      CLOSEX; 
      RETURN; 
    END 
  END 
$END
END # OF PROFILE #
TERM
*ENDIF
