*DECK PROCTAB 
USETEXT CCTTEXT 
USETEXT DNTEXT
          PROC PROCTAB; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  PROCTABLES                                            #
 #                                                                     #
 #        GIVEN- OBJECT GENERATOR TABLES                               #
 #                   CCT                                               #
 #                   DNAT                                              #
 #                   LAT                                               #
 #                   FNAT                                              #
 #                   LPOOL                                             #
 #                                                                     #
 #        DOES-  INITIALIZES THE OBJECT CODE FILE - OTEXT              #
 #               CREATES THE IDENT                                     #
 #               CREATES WORKING-STORAGE, DATA RECORDS, FILE TABLES,ETC#
 #                   TRANSFERS TO CGEN                                 #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
 #        PRINTVAL ERRORS PRODUCED BY PROCTAB 
  
ERROR   MEANING                             PROC     MEANING OF NUMBER
  
  1     UNRECOGNIZED LEVEL NBR IN DNAT      LEVELTEST DNAT INDEX
  2    MAJOR M-SEC NOT RECOGNIZED           PROCITEM  DNAT INDEX
  3    BAD FILE ORGANIZATION                CRFIT     FNAT INDEX
  4    NO MAXOCCUR AUXTABLE FOR SUBS DNAT   PROCITEM  DNAT INDEX
 15    NO LAT FOR DNAT WHICH NEEDS ONE      PROCITEM  DNAT INDEX
  
 #
  
 #                                                                     #
 #        COMMON DECKS                                                 #
 #                                                                     #
          BEGIN #MAIN PROC# 
*CALL,DNT 
*CALL,NAMET 
*CALL ASMSEQ
*CALL FNAT1 
*CALL FNATVALS
*CALL LAT1
*CALL PLT1
*CALL PLTVALS 
*CALL DNATVALS
*CALL AUXT1 
*CALL AUXTVALS
*CALL PNAT1 
*CALL SEGPTR
*CALL WORKTABS
*CALL OPNAMES 
*CALL TABLETYP
*CALL INSTDEFS
 #
       PHASES OF PROCTAB - PLACED INTO RA$SUBPHASE (RA+22)
 #
          DEF RA$SFFNATP     #0#;  #FNATPROC# 
          DEF RA$SFDNATP     #1#;  #DNAT PROCESS LOOP#
          DEF RA$SFCRFIT     #2#;  #CRFIT - CREATION OF FITS# 
          DEF RA$SFPNATP     #3#;  #PNATPROC# 
          DEF RA$SFPERFT     #4#;  #PERFTIME# 
  
*CALL DEFOTEXT
*CALL FIELDS
*CALL LDSET 
*CALL LPOOL 
*CALL USETAB
*CALL FDLT
*CALL,ASSEMOP 
*CALL RALINE
 #                                                                     #
 #   GLOBAL DATA DEFS AND EXTERNALS                                    #
 #                                                                     #
  
 #   COMPILER STATISTICS ITEMS AND DEFS                                #
              ITEM STATLINE C(130); 
              DEF TABLENAME   #10#; 
              DEF SIZEDECIMAL #20#; 
              DEF SIZEOCTAL   #40#; 
              DEF HOWGROWS    #65#; 
  
 #   CBLIST FUNCTION CODES                                             #
              DEF SSP       #1#;
              DEF DBSP      #2#;
              DEF EJECTPAGE #3#;
              DEF DEFTITLE  #4#;
              DEF OPENF     #8#;
              DEF CLOSEF    #9#;
  
 #     DIAGNOSTICS PRODUCED IN PROCTAB                                 #
  
          DEF  D026  #26#;   #MAX GTEXT ENTRIES EXCEEDED# 
          DEF  D039  #39#;
          DEF D043   #043#;  #SYNC ITEM IN PRINT FILE                  #
          DEF  D045  #45#;
          DEF  D046  #46#;
          DEF  D047  #47#;
          DEF  D048  #48#;
  
 #        OTEXT FILE AREA AND ITEMS FOR OTEXT CREATION                 #
 #                                                                     #
          XREF BEGIN
          ITEM  LITBLK       I; 
          ITEM CBSEG; 
          ITEM CBSEGI;
          ITEM  CBSEGIS;
          ITEM CBSEGP;
          ITEM  CBSEGPS;
          ITEM  CBSEGS; 
          ITEM  REGSEQ; 
          ITEM  CODEBLK;
          ARRAY OTEXTWSA[0:OTEXTLEN]; 
              BEGIN 
              ITEM OTEXTCONS   DCONS ;
              ITEM OTEXTCONST  DCONST;
              ITEM OTEXTCOUNT  DCOUNT;
              ITEM OTEXTINDEX  DINDEX;
              ITEM OTEXTMOD    DMOD  ;
              ITEM OTEXTNUM    DNUM  ;
              ITEM OTEXTOC     DOC   ;
              ITEM OTEXTTABLE  DTABLE;
              ITEM OTEXTTEXT   DTEXT ;
               END
          PROC OTEXTWRITE;   #CALLED TO WRITE THE ARRAY#
          PROC OTEXTOPEN;    #CALLED TO OPEN THE OTEXT FILE#
          END 
          ITEM ARRAYINDEX  I=0 ;   #THE INDEX INTO OTEXTWSA#
          ITEM DATAHDR     I=-2;   #POINTS TO OTEXT DATA HEADER#
          ITEM  CODE;        #PLT CODE (VALUE)                         #
          ITEM CREATEFLAG  U=0;    #SET IF DATA TO BE CREATED#
          ITEM CSBLOCK     I=0;    #BLOCK NBR OF COMMON STORAGE BLOCK  #
          ITEM CURRBCP     I=0 ;   #CURRENT BCP#
          ITEM CURRHDR     I=0;    #POINTER TO LWD IN DNAT PROCESS# 
          ITEM CURRLATDNAT I=0;    #CURRENT DNAT PTR IN LAT#
          ITEM CURRMMSEC   U=0;    #CURRENT MAJOR M SEC#
          ITEM CURRSMSEC   U=0;    #CURRENT MINOR M SEC#
          ITEM CURRWDAD    I=0 ;   #CURRENT WORD ADDRESS# 
          ITEM CURRWORD    C(10) = "          ";   #CURRENT WORD# 
          ITEM  DDBLK1; 
          ITEM  DDBLK2; 
          ITEM ELASTWORD I; 
          ITEM ENDSRCH     I=0;    #END OF DNAT SEARCH# 
          ITEM EREPCOUNT I=0; 
          ITEM EXTNFLAG B=FALSE;
          ITEM FIELDVAL    I=0;    #VALUE OF FIELD FOR TABLE REFS#
          ITEM FIRSTONE    B;      #FIRST CALL TO OUTPUTWORD FLAG#
          ITEM FLUSHFLAG   B;      #SET TO FLUSH LAST ITEM IN OUTPUTWOR#
          ITEM INDEXBLOCK  I=0;    #INDEX BLOCK NUMBER# 
          ITEM INDEXWORD   I=0;    #NEXT AVAIL WORD FOR INDEX ITEM# 
          ITEM INDXTBLPTR  I=0;    #INDEX INTO ENTRY/EXIT INDEX TABLE#
          ITEM LATINDEX    I=0;    #INDEX INTO LAT# 
          ITEM LATPTR      I=0;    #VIRTUAL POINTER FOR LAT#
          ITEM LEVELNUMBER I=0;    #LEVEL NUMBER FROM DNAT# 
          ITEM LIT2RNSIZE  I=0;    #SIZE OF RETURNED ITEM FOR LIT2RN# 
          ITEM LIT2RNPOINT I=0;    #POINT LOCN FOR LIT2RN#
          ITEM LIT2RNSIGN  I=0;    #SIGN RETURN OR NOT FOR LIT2RN#
          ITEM LIT2RNWD1   I=0;    #FIRST RETURN WORD FROM LIT2RN#
          ITEM LIT2RNWD2   I=0;    #SECOND RETURN WORD# 
          ITEM MAJMSEC     I=0;    #DNAT MAJOR M SEC# 
          ITEM MAXBYTEOFF  I=0;    #MAXIMUM BYTE OFFSET#
          ITEM MAXTEMP     I=0;    #MAX SIZE OF TEMP AREA#
          ITEM SBLOCK I=0;
          ITEM SCURRBCP I;
          ITEM SCURRWDAD I; 
          ITEM SEXTIXPTR   I=0;    #PTR TO EXIT INDEX FOR LAST SECTION #
          ITEM SMAXBYTEOFF I; 
          ITEM SRCHTYPE    I=0 ;   #TYPE OF DNAT NOW SEARCHING# 
          ITEM SREGBLOCK   I;      #SPECIAL REGISTER BLOCK NUMBER#
          ITEM STARTSRCH   I=0;    #START OF SEARCH OF DNAT#
          ITEM TEMPBLOCK   I=0;    #TEMP BLOCK NUMBER#
          ITEM TEMPWORD    I=0;    #NEXT AVAIL WORD FOR TEMP ITEM#
          ITEM  TYPE;        #DNAT TYPE                                #
          ITEM WORDOFF     I=0;    #WORD OFFSET OF ITEM#
          ITEM WSAHDR      I=0;    #LOCN OF WSA HEADER# 
          ITEM WSAENSPREG  I=0;    #END OF SPECIAL REGS AT FRONT OF DNT#
*CALL PTCOMMON
          BASED ARRAY LITTABLE [0] S; 
              BEGIN 
              ITEM LITWORD C(0,0,10); 
              END 
          ARRAY [0:100];
              ITEM  ORD = [101(0)]; 
 #                                                                     #
 #        EXTERNAL PROCEDURES                                          #
 #                                                                     #
          XREF BEGIN
          PROC CBLIST;
          PROC COPYD4;       # COPY 4 WORD DNAT # 
          PROC CGINIT;
          PROC CRFIT; 
          FUNC DEC C(10); 
          FUNC DEFBLOCK;     #CALLED TO DEFINE A STORAGE BLOCK# 
          FUNC GETLFN C(10); #GETS LOGICAL FILE NAME ZERO FILLED# 
          PROC GETPLST;      #GET A PLT STRING# 
          PROC INITBLK;      #INITIALIZE DEFBLOCK#
          PROC INTERCEPTOR;  #DIAGNOSTIC OUTPUTTING ROUTINE#
          PROC LIT2RN;
          FUNC NEXTLABEL;    #CALLED TO GET A LOCAL LABEL NUMBER# 
          FUNC OCT C(40); 
          PROC PRINTVAL;     #PRINT ERROR MESSAGES# 
          PROC PRINTOCT;     #PRINT OCTAL ERROR MESSAGES# 
          PROC PROCUSE;      #PROCESS USE LITERAL#
          PROC RN2BIN;
          PROC  SCANLIT;
          PROC TMRECL;
          PROC TMREOP;       #RE-OPEN A TABLE#
          PROC TMRTNTB;      #RELEASE TABLE#
          FUNC VIRTUAL;      #VIRTUAL TABLE MANAGER#
          END 
          XDEF
              BEGIN 
              FUNC CONVINT; 
              PROC DEFLOCLAB; 
              PROC FINDAUX; 
              PROC GENLDSET;
              PROC OUTPUTBSS; 
              PROC OUTPUTDATA;
              PROC OUTPUTREPL;
              PROC OUTPUTUSE; 
            PROC PRINTDIAG; 
              PROC RELOCLOWER;
              PROC RELOCUL; 
              PROC RESETLEV;
              END 
          CONTROL EJECT;
          PROC ADDAUX (AUXINDX);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  ADDAUX                                                #
 #                                                                     #
 #        GIVEN- AUXINDX = PTR TO AUXT ENTRY OR 0                      #
 #                                                                     #
 #        DOES-  ADDS A NEW AUX TABLE ENTRY AND RETURNS ITS INDEX IN   #
 #               AUXINDX.  IF AUXINDX NQ 0 ON ENTRY LINKS THIS NEW     #
 #               ENTRY IN AUX TABLE CHAIN                              #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM   AUXINDX I; 
  
          CCTAUXTLEN = CCTAUXTLEN + 1;
          IF AUXINDX NQ 0 
          THEN
              BEGIN 
              AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDX);
              FOR I = I WHILE AX$TNEXTPTR [AUXPTR] NQ 0  DO 
                  BEGIN 
                  AUXINDX = AX$TNEXTPTR [AUXPTR]; 
                  AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDX);
                  END 
              AX$TNEXTPTR [AUXPTR] = CCTAUXTLEN;
              END 
          AUXINDX = CCTAUXTLEN; 
          RETURN; 
          END 
          CONTROL  EJECT; 
          PROC  ALTERINDEX; 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  #
#                                                                      #
#         OUTPUT ALTER INDEX FOR SEGMENTED PROGRAMS                    #
#                                                                      #
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  #
          BEGIN 
          AUXINDEX = PN$AUXREF[PNATPTR];
          IF  AUXINDEX NQ 0 
          THEN
              ADDAUX(AUXINDEX); 
          ELSE
              BEGIN 
              ADDAUX(AUXINDEX); 
              PN$AUXREF[PNATPTR] = AUXINDEX;
              END 
          AUXPTR = VIRTUAL(TABLETYPE"AUX$",AUXINDEX); 
          AX$TTYPE[AUXPTR] = SEGALTERIX;
          INDXTBLPTR= INDXTBLPTR + 1; 
          AX$ALTERIX[AUXPTR] = INDXTBLPTR;
          TEMP = PN$SEGMENTNO[PNATPTR] - CCTSEGLIMIT + 1; 
          TEMP1 = 0;
          IF  CCTSUBPROGR 
          THEN
              B<30,12>TEMP1 = TEMP; 
          ELSE
              B<12,7>TEMP1 = TEMP;
          RELOCLOWER(TEMP1,0,TABLETYPE"NULL");
          RETURN; 
          END 
          CONTROL EJECT;
          PROC BUMPARINDX(INCREM, NEXTSIZE);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  BUMPARINDX                                            #
 #                                                                     #
 #        GIVEN- ARRAYINDEX - POINTER TO OPTEXT ARRAY                  #
 #               INCREM - AMOUNT TO BUMP IT BY                         #
 #               NEXTSIZE - SIZE OF NEXT ITEM TO BE ADDED              #
 #                                                                     #
 #        DOES-  INCREMENTS ARRAYINDEX                                 #
 #               FLUSHES ARRAY TO FILE IF NEEDED                       #
 #               ZEROS ARRAY IF FLUSHED (WRITEOTEXT DOES THIS)         #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM INCREM   I;
          ITEM NEXTSIZE I;
          IF ARRAYINDEX EQ OTEXTLEN 
          THEN
               BEGIN
              OTEXTWRITE (ARRAYINDEX+1);
              ARRAYINDEX = 0; 
              END 
          ELSE
              BEGIN 
              ARRAYINDEX = ARRAYINDEX + INCREM; 
              IF ARRAYINDEX+NEXTSIZE GQ OTEXTLEN
              THEN
                  BEGIN 
                  OTEXTWRITE(ARRAYINDEX); 
                  ARRAYINDEX = 0; 
                  END 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          FUNC CONVINT (PLTPTRL); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - CONVINT
 *
 *        DOES -  CONVERTS A PLT ENTRY TO AN INTEGER
 *
 *        INPUTS  ONLY PARAMETER IS PLT POINTER TO LIT
 *
 *        RETURNS VALUE 
 *
 *        USES CONVLIT2RN 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM PLTPTRL I; 
  
          LIT2RNPOINT = 0;
          LIT2RNSIGN = 0; 
          PLTINDEX = PLTPTRL; 
          PLTPTR = VIRTUAL (TABLETYPE "PLT$", PLTINDEX);
          LIT2RNSIZE = PL$LENGTH [PLTPTR];
          CONVLIT2RN;  #CONVERT TO REG NUMERIC# 
          RN2BIN (LIT2RNWD1, LIT2RNWD2, LIT2RNPOINT, LIT2RNWD1, 
              LIT2RNWD2, TEMP); 
          CONVINT = TEMP; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC CONVLIT2RN;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME -  CONVLIT2RN
 *
 *        DOES-   CONVERTS A PLT NUMERIC LITERAL STRING TO REG NUMERIC
 *
 *        INPUTS  LIT2RNPOINT - SET TO POINT LOCATION OF RETURN 
 *                LIT2RNSIGN  - SET TO 0 IF NO SIGN RETURN - 1 IF SIGNED
 *                LIT2RNSIZE  - SET TO SIZE OF ITEM TO BE RETURNED
*                PLTINDEX - SET TO PLT ENTRY
 *
 *        RETURNS LIT2RNWD1 AND LIT2RNWD2 WITH REGISTER NUMERIC ITEM
 *                IF NEGATIVE IS NINES COMPLIMENT 
 *                HIGH ORDER IN LIT2RNWD1 
*         IF LIT2RNSIZE IS ORIGINALLY -1,  THE SIZE AND POINT LOCATION
*                WILL BE TAKEN FROM THE LITERAL.
*         A LITERAL WITH AN *E* EXPONENT WILL CAUSE LIT2RNWD1 TO BE 
*                SET = 0 AND LIT2RNWD2 SET = COMP-2 VALUE,
*                REGARDLESS OF LIT2RNSIZE, LIT2RNPOINT OR LIT2RNSIGN. 
 *
 *        CALLS LIT2RN FOR CONVERSION 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM LIT2RNREF U = O"20000000000000000000"; 
  
          PLTPTR = VIRTUAL (TABLETYPE"PLT$", PLTINDEX); 
          B<2, 10> LIT2RNREF = PL$LENGTH [PLTPTR];
          GETPLST (PLTINDEX, LOC(PLTSTRDATA));  #GET PLT LITERAL# 
          B<12, 48> LIT2RNREF = LOC (PLTSTRDATA); 
          IF LIT2RNSIGN NQ 0
          AND PL$SIGNEDFLG [PLTPTR] EQ 1
          THEN    #THE FIELD IS SIGNED AND SO IS THE LITERAL# 
              # SET IF - #
              B<41, 1> LIT2RNREF = LNO PL$SIGNFLAG [PLTPTR];
  
          IF LIT2RNSIZE LS 0  THEN
              BEGIN                              # COMP-2 CONVERSION   #
              SCANLIT(LIT2RNREF, LIT2RNSIZE, LIT2RNPOINT);
              END 
  
          LIT2RN (LIT2RNREF, LIT2RNSIZE, LIT2RNPOINT, LIT2RNSIGN, 
              LIT2RNWD1, LIT2RNWD2);
          RETURN; 
          END 
          CONTROL EJECT;
          PROC DEFLOCLAB (LABNUMBER); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  DEFLOCLAB                                             #
 #                                                                     #
 #        DOES-  DEFINES A LOCAL LABEL GIVEN IN THE INPUT PARAM        #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM LABNUMBER  U;
          IF ARRAYINDEX - 1 EQ DATAHDR
          THEN ARRAYINDEX = DATAHDR;
          OTEXTOC [ARRAYINDEX] = S"LABEL$"; 
          OTEXTTABLE [ARRAYINDEX] = S"LOCAL$";
          OTEXTINDEX [ARRAYINDEX] = LABNUMBER;
          BUMPARINDX (1, 3);
          FORMDATAHD; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC ENTRYINDEX;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  ENTRYINDEX                                            #
 #                                                                     #
 #        DOES-  OUTPUTS ENTRY AND RESET INDICES                       #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM   INDEX I; 
 #     DO NOT GENERATE ENTRY INDEX FOR COMPILER GENERATED PNATS#
          IF  PNATINDEX GR CCTLSTGLPN  THEN RETURN; 
  
#      WE MUST CREATE AN AUXTABLE ENTRY TO CONTAIN THE INFORMATION     #
#      ABOUT THE INDICES WE GENERATE.  IF THIS PNAT ENTRY ALREADY HAS  #
#      AN AUXTABLE ENTRY WE ADD ANOTHER, OTHERWISE WE CREATE ONE AND   #
#      PUT THE POINTER TO IT IN THE PAUXREF FIELD                      #
  
          AUXINDEX = PN$AUXREF [PNATPTR]; 
          IF AUXINDEX NQ 0
          THEN
              ADDAUX (AUXINDEX);
          ELSE
              BEGIN 
              ADDAUX (AUXINDEX);
              PN$AUXREF [PNATPTR] = AUXINDEX; 
              END 
  
#      SET TYPE OF AUXTABLE ENTRY TO INDICATE THAT IT CONTAINS ENTRY   #
#      AND/OR RESET INDICES                                            #
  
          AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
          AX$TTYPE [AUXPTR] = SEGENTRYIX; 
  
#      B U I L D   I N D E X                                           #
  
          TEMP = PN$SEGMENTNO [PNATPTR];
          IF  CCTSUBPROGR    #SUBCOMPILE                               #
          THEN
              BEGIN 
              IF  TEMP LS 50
              THEN
 #   GENERATE ENTRY INDEX                                              #
 #        + RJ  = XC.SEGPS                                             #
 #        - VFD 30/ADDR                                                #
                  BEGIN 
                  INDEX = O"01000000000000000000";
                  RELOCUL(INDEX,CBSEGPS,TABLETYPE"EXT$",
                                PNATPTR,TABLETYPE"PNAT$");
                  END 
              ELSE
                  BEGIN 
 #   GENERATE ENTRY INDEX                                              #
 #        + RJ  =XC.SEGIS                                              #
 #        - VFD 12/OVERLAY-NO,18/ADDR                                  #
                  INDEX = O"01000000000000000000";
                  B<30,12>INDEX = TEMP-CCTSEGLIMIT+1; 
                  RELOCUL(INDEX,CBSEGIS,TABLETYPE"EXT$",
                                PNATPTR,TABLETYPE"PNAT$");
                  END 
              INDXTBLPTR = INDXTBLPTR + 1;
              AX$ENTRYIX[AUXPTR] = INDXTBLPTR;
              RETURN; 
              END 
          IF TEMP LS CCTSEGLIMIT
          THEN
  
#      FOR ENTRIES IN THE PERMANENT SEGMENT, PUT OUT A TYPE 3 INDEX    #
#                                                                      #
#                +         SX1    18/ADR                               #
#                -         EQ     =XC.SEGP                             #
  
              BEGIN 
              INDEX = O"71100000000400000000";    #+SX1...-EQ....#
              RELOCUL(INDEX,PNATINDEX,TABLETYPE"PNAT$", 
                  CBSEGP, TABLETYPE"EXT$"); 
              END 
          ELSE
              BEGIN 
              IF TEMP LS 50 OR
                  NOT CCTALTINDSEG [0]
              THEN
  
#      FOR ENTRIES IN FIXED-OVERLAYABLE SEGMENTS, OR IN ANY SEGMENTS   #
#      IF THERE ARE NO ALTERS OF INDEPENDENT SEGMENTS, PUT OUT A       #
#      TYPE 2 INDEX.                                                   #
#                                                                      #
#                +         SX1    7/ON,11/ORD                          #
#                -         EQ     =XC.SEG                              #
#                                                                      #
 #               WHERE ON = OVERLAY NUMBER                             #
 #                        = SEGMENT NUMBER - SEGMENT LIMIT + 1         #
 #                        = 0 IF SEGMENT NUMBER < SEGMENT LIMIT        #
 #                     ORD= JUMP VECTOR ORDINAL                        #
  
                  BEGIN 
                  INDEX = O"71100000000400000000";    #+SX1...-EQ....#
                  B<12,7>INDEX = TEMP - CCTSEGLIMIT + 1;
                  B<19,11>INDEX = ORD [TEMP]; 
                  ORD [TEMP] = ORD [TEMP] + 1;
                  RELOCLOWER (INDEX, CBSEG, TABLETYPE"EXT$"); 
                  END 
              ELSE
                  BEGIN 
  
#      PUT OUT TYPE 1 INDEX FOR ENTRIES IN INDEPENDENT SEGMENTS.       #
#                                                                      #
#                +         SX1    7/ON,11/ORD                          #
#                -         RJ     =XC.SEGI                             #
  
                  INDEX = O"71100000000100000000";    #+SX1...-RJ....#
                  TEMP = PN$SEGMENTNO [PNATPTR];
                  B<12,7>INDEX = TEMP - CCTSEGLIMIT + 1;
                  B<19,11>INDEX = ORD [TEMP]; 
                  ORD [TEMP] = ORD [TEMP] + 1;
                  RELOCLOWER (INDEX, CBSEGI, TABLETYPE"EXT$");
                  END 
              END 
  
#      UPDATE INDEX TABLE POINTER AND PUT ORDINAL IN AUXTABLE ENTRY    #
#      FOR THE ENTRY INDEX JUST GENERATED                              #
  
          INDXTBLPTR = INDXTBLPTR + 1;
          AX$ENTRYIX [AUXPTR] = INDXTBLPTR; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC EXITINDEX; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME   EXITINDEX                                             #
 #                                                                     #
 #        DOES-  OUTPUTS EXIT INDICES FOR SEGMENTED PROGRAMS           #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM   INDEX I; 
          ITEM  NEXTPNAT; 
          ITEM  NEXTPNATPTR;
  
 #     IF THE NEXT SECTION/PARAGRAPH IS IN THE PERMANENT SEGMENT,      #
 #     PUT OUT A TYPE 3 INDEX, ELSE PUT OUT A TYPE 2 INDEX.            #
  
 #     COMPILER GENERATED PNATS DO NOT HAVE ENTRY INDEX AUXTABLE ENTRY# 
          AUXINDEX = PN$AUXREF[PNATPTR];
          FINDAUX(SEGENTRYIX);
          IF AUXPTR EQ 0
          THEN
              BEGIN 
              ADDAUX(AUXINDEX); 
              PN$AUXREF[PNATPTR] = AUXINDEX;
              AUXPTR = VIRTUAL(TABLETYPE"AUX$",AUXINDEX); 
              AX$TTYPE[AUXPTR] = SEGENTRYIX;
              END 
          TEMP = PN$SEGMENTNO [PNATPTR];
          IF PN$PROCKIND [PNATPTR] NQ 0 
          THEN               # IF THIS IS A SECTION                    #
              BEGIN 
              SEXTIXPTR = INDXTBLPTR + 1; 
              TEMP2 = PN$NEXTSECTN [PNATPTR] - PNATINDEX; 
              NEXTPNAT = PN$NEXTSECTN [PNATPTR];
              NEXTPNATPTR = VIRTUAL(TABLETYPE"PNAT$", 
                  PN$NEXTSECTN [PNATPTR]);
              END 
          ELSE               # IF THIS IS A PARAGRAPH                  #
              BEGIN 
              TEMP2 = 1;
              NEXTPNAT = PNATINDEX+1; 
              NEXTPNATPTR = VIRTUAL(TABLETYPE"PNAT$",NEXTPNAT); 
              IF PN$PROCKIND [NEXTPNATPTR] NQ 0 AND SEXTIXPTR NQ 0
              THEN           # IF AT LAST PARAGRAPH IN SECTION         #
                  BEGIN 
  
 #     IN THIS CASE, DO NOT PUT OUT AN EXIT INDEX.  INSTEAD,           #
 #     SET AUXTABLE ENTRY AND INSERT POINTER TO LAST SECTION EXIT INDEX#
  
                  AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
                  AX$TTYPE [AUXPTR] = SEGENTRYIX; 
                  AX$EXITIX [AUXPTR] = SEXTIXPTR; 
                  RETURN; 
                  END 
              END 
          IF  CCTSUBPROGR    #SUBCOMPILE                               #
          THEN
              BEGIN 
              IF  TEMP3 LS 50 
              THEN
                  BEGIN 
                  INDEX = O"01000000000000000000";
                  RELOCUL(INDEX,CBSEGPS,TABLETYPE"EXT$",
                                NEXTPNAT,TABLETYPE"PNAT$"); 
                  END 
              ELSE
                  BEGIN 
                  INDEX = O"010000000000000000000"; 
                  B<30,12>INDEX = TEMP3-CCTSEGLIMIT+1;
                  RELOCUL(INDEX,CBSEGIS,TABLETYPE"PNAT$", 
                                NEXTPNAT,TABLETYPE"PNAT$"); 
                  END 
              END 
          ELSE
          BEGIN 
              TEMP3 = PN$SEGMENTNO[NEXTPNATPTR];
          IF TEMP3 LS CCTSEGLIMIT 
          THEN     # NEXT PARA/SECT IN PERM SEG, BUILD TYPE 3 INDEX    #
              BEGIN 
              INDEX = O"71100000000400000000";    #+SX1...-EQ....#
              RELOCUL (INDEX, NEXTPNAT, TABLETYPE"PNAT$", CBSEGP, 
                      TABLETYPE"EXT$"); 
              END 
          ELSE     # NEXT PARA/SECT IN NON-PERM SEG, BUILD TYPE 2 INDEX#
              BEGIN 
              INDEX = O"71100000000400000000";    #+SX1...-EQ....#
              IF TEMP EQ TEMP3
              THEN
  
 #     CASE WHERE EXIT INDEX POINTS TO SECTION OR PARAGRAPH WHICH IS   #
 #     IN THE SAME SEGMENT  # 
 #     THE ORDINAL IS SET UP BY THE PROPER AMOUNT                      #
  
                  B<19,11>INDEX = ORD [TEMP] + TEMP2 - 1; 
              ELSE
                  B<19,11>INDEX = ORD[TEMP3]; 
  
 #     FOR CASE WHERE THE EXIT INDEX POINTS TO THE START OF THE        #
 #     NEXT SECTION, THE ORDINAL IS LEFT = 0.                          #
  
              B<12,7>INDEX = TEMP3 - CCTSEGLIMIT + 1;      #OVERLAY NO #
              RELOCLOWER (INDEX, CBSEG, TABLETYPE"EXT$"); 
              END 
          END 
  
 #     SET AUXTABLE ENTRY AND INSERT POINTER TO EXIT INDEX             #
  
          AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
          AX$TTYPE [AUXPTR] = SEGENTRYIX; 
          INDXTBLPTR = INDXTBLPTR + 1;
          AX$EXITIX [AUXPTR] = INDXTBLPTR;
          RETURN; 
          END 
          CONTROL  EJECT; 
          PROC  FDLPROC;
# 
          DOES - BUILDS COMMON BLOCK CONTAINING FDL PROGRAM INFORMATION 
# 
          ITEM  FDLINDX;
          ITEM  GROUP;
          ITEM  WORD; 
          BEGIN 
          BLOCKNUMBER = DEFBLOCK("C.FDLCM",TRUE,FALSE); 
          OUTPUTUSE(FALSE); 
          WORD = NEXTLABEL; 
          FOR I = 6 STEP -1 WHILE C<I,1>CCTPROGRAMID[0] EQ " " DO TEST; 
          C<0,I+1> GROUP = C<0,I+1>CCTPROGRAMID[0]; 
          RELOCLOWER(GROUP, WORD, TABLETYPE"LOCAL$"); 
          COMMONFLAG = FALSE;          #LOCAL BLOCK#
          BLOCKNAME = "PROGEQU";
          OUTPUTUSE(TRUE);
          DEFLOCLAB(WORD);
          FOR   I = 1 STEP 1 UNTIL CCTFDLTLEN DO
              BEGIN 
              FDLINDX = VIRTUAL( TABLETYPE"FDLT$",I); 
              IF  FDLTENTTYPE[FDLINDX] NQ S"PROGEQUIV"  THEN TEST;
              OUTPUTDATA(C<0,10>FDLTPROGNAME[FDLINDX]); 
              OUTPUTDATA(C<10,10>FDLTPROGNAME[FDLINDX]);
              OUTPUTDATA(C<20,10>FDLTPROGNAME[FDLINDX]);
              WORD = 0; 
              C<0,7>WORD = FDLTINTNAME[FDLINDX];
              OUTPUTDATA(WORD); 
              IF  FDLTSTATICF[FDLINDX]
              THEN
                  RELOCLOWER(O"40000000000000000000", I,
                             TABLETYPE"FDLT$"); 
              ELSE
                  BEGIN 
                  CCTCAPCOUNT = CCTCAPCOUNT + 1;
                  OUTPUTDATA(0);
                  END 
              WORD = 0; 
              C<0,7>WORD = FDLTLIBNAME[FDLINDX];
              OUTPUTDATA(WORD); 
              END 
          OUTPUTDATA(0);
          END 
          CONTROL EJECT;
          PROC FINDAUX (FINDAUXVALUE);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC   FINDAUX
 *
 *        DOES   FINDS AN AUXTABLE ENTRY
 *
 *        USES - INPUTS ARE AUXINDEX MUST POINT TO THE AUX TABLE ENTRY
 *                   TO LOOK AT FIRST.
 *                   FINDAUXVALUE IS THE AUX TYPE TO LOOK FOR 
 *
 *        RETURNS AUXPTR IS THE VIRTUAL INDEX FOR THE MATCHING ENTRY
 *                IF NONE IS FOUND, AUXINDEX RETURNS AS ZERO
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM FINDAUXVALUE;
  
          FOR AUXPTR = VIRTUAL (TABLETYPE "AUX$", AUXINDEX) 
              WHILE NOT (AUXINDEX EQ 0 OR AX$TTYPE [AUXPTR] 
              EQ FINDAUXVALUE) DO 
              BEGIN 
              AUXINDEX = AX$TNEXTPTR [AUXPTR];
              AUXPTR = VIRTUAL (TABLETYPE "AUX$", AUXINDEX);
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC FNATPROC;
 # * * * *
 *
 *        NAME - FNATPROC 
 *
 *        DOES - GOES THROUGH FNAT ASSIGNING BLOCKS FOR FILES 
 *               ASSIGNS BLOCK AND SPACE FOR RECORD AREAS 
 *               PROCESSES SAME RECORD AREA 
 *
 *        USES - WORK TABLE 2 
 *
 * * * #
          BEGIN 
          ITEM EXTFLAG       B=FALSE;  #EXTERNAL FILE WAS LAST# 
          ITEM RELFILEFLG    B;    #RELATIVE FILE FLAG# 
          ITEM RECBLOCKOFF   I=0;  #OFFSET FOR RECS IN REC BLOCK# 
          ITEM RECLABEL      I;    #LABEL FOR THIS RECORD#
          ITEM RECMSEC       I=0;  #THIS RECORD SUB MSEC NBR# 
          ITEM RECOFFSET     I=0;  #OFFSET FOR RECORDS# 
          ITEM RECSIZE       I=0;  #RECORD SIZE#
          IF CCTFNATLEN EQ 0
          THEN
              RETURN;  #NO FILES - DO NOTHING#
          SETGLOBAL ("RECAREA", TRUE); #ASSIGN BLOCK FOR RECS + USE HDR#
          RECBLOCK = BLOCKNUMBER; 
          FOR FNATINDEX = 1 STEP 1 UNTIL CCTFNATLEN DO
              BEGIN   # GO THROUGH SETTING PRINTF AND PRUF FM USE LIT#
                    # NEEDED BECAUSE OF SAME RECORD AREA PROCESS #
              FNATPTR = VIRTUAL (TABLETYPE"FNAT$", FNATINDEX);
              PLTINDEX = FN$USLITPTR [FNATPTR]; 
              IF PLTINDEX NQ 0
              THEN
                  BEGIN 
                  TEMP = FN$ORG [FNATPTR];
                  IF TEMP EQ RELATIVE OR TEMP EQ SEQUENTIAL 
                  THEN
                      PROCUSE (FALSE);   # GO SEE IF PRINTF OR PRUF # 
                  END 
              IF FN$ORG [FNATPTR] EQ SEQUENTIAL 
              THEN
                  BEGIN   # SEE IF PRINTF - IF SO MUST BUMP LEN # 
                  IF CCTAUDIT 
                  AND FN$PRINTF [FNATPTR] NQ 1
                  THEN
                      BEGIN    # NOT A PRINT FILE AND AUDIT TEST #
                      TEMP = PL$STRINGPTR [VIRTUAL(TABLETYPE"PLT$", 
                        FN$DVCEPTR [FNATPTR])]; 
                      CURRWORD = PLT$CHAR [VIRTUAL(TABLETYPE"PLTSTR$",
                        TEMP)]; 
                      IF CURRWORD EQ "OUTPUT" 
                      THEN
                          FN$PRINTF [FNATPTR] = 1;  #SET AS PRINT FILE# 
                      END 
                  IF FN$LINAGPTR [FNATPTR] NQ 0 
                  OR FN$RPTPTR [FNATPTR] NQ 0 
                  OR FN$PRINTF [FNATPTR] EQ 1 
                  THEN
                      BEGIN  # BUMP MAX AND MINS FOR CARR CTL FOR PRT F#
                      FN$PRINTF [FNATPTR] = 1;  # IS PRINT FILE # 
                      FN$ACCUMMAX [FNATPTR] = FN$ACCUMMAX [FNATPTR] 
                        + 1;
                      FN$ACCUMMIN [FNATPTR] = FN$ACCUMMIN [FNATPTR] + 1;
                      IF FN$RCTMAX [FNATPTR] NQ 0 
                      THEN
                          FN$RCTMAX [FNATPTR] = FN$RCTMAX [FNATPTR] + 1;
                      IF FN$RCTMIN [FNATPTR] NQ 0 
                      THEN
                          FN$RCTMIN [FNATPTR] = FN$RCTMIN [FNATPTR] + 1;
                      END 
                  END 
              END 
          FOR FNATINDEX = 1 STEP 1 UNTIL CCTFNATLEN DO
              BEGIN 
              RA$LINE = FNATINDEX;
              FNATPTR = VIRTUAL (TABLETYPE"FNAT$", FNATINDEX);
             CONTROL IFNQ CB5$CDCS,"NO";
              IF FN$SSRELATN [FNATPTR] EQ 1 
              THEN
                  TEST FNATINDEX;  #IGNORE IF A CDCS -RELATION-#
             CONTROL FI;
              TEMP = FN$DVCEPTR [FNATPTR];    #GET PLT PTR TO LFN#
              IF TEMP NQ 0
              THEN
                  FN$LFN [FNATPTR] = GETLFN (TEMP); 
              ELSE
                  FN$LFN [FNATPTR] = "DUMMYFT"; 
              IF FN$EXTERNAL [FNATPTR] EQ 1 
              THEN
                  BEGIN 
                  RECOFFSET = 0;
                  BLOCKNAME = FN$LFN [FNATPTR]; 
                  COMMONFLAG = TRUE;
                  OUTPUTUSE (TRUE);   #DEFINE BLOCK AND PUT HDR OUT#
                  FN$BLOCKNBR [FNATPTR] = BLOCKNUMBER;
                  EXTFLAG = TRUE; 
                  END 
              ELSE
                  BEGIN 
                  BLOCKNUMBER = RECBLOCK; 
                  RECOFFSET = RECBLOCKOFF;
                  IF EXTFLAG
                  THEN
                      BEGIN 
                      EXTFLAG = FALSE;
                      OUTPUTUSE (FALSE);  #PUT USE HDR OUT AGAIN# 
                      END 
                  END 
              RECMSEC = FN$SMSECNO [FNATPTR]; #SMSEC OF RECORD# 
              RECSIZE = FN$ACCUMMAX [FNATPTR];
              IF RECSIZE EQ 0 
              THEN
                  RECSIZE = 80; 
              IF FN$CODEPTR[FNATPTR] NQ 0 
              THEN
                  BEGIN 
                  TEMP = FN$CODEPTR[FNATPTR]; 
                  TEMP1 = VIRTUAL(TABLETYPE"DNAT$",TEMP); 
                  IF DN$ANTYPE[TEMP1] EQ ANASC64 OR 
                     DN$ANTYPE[TEMP1] EQ ANSTANDARD1 OR 
                     DN$ANTYPE[TEMP1] EQ ANEBCDIC 
                  THEN
                  RECSIZE = RECSIZE * 2;
                  END 
              IF FN$ORG [FNATPTR] EQ RELATIVE 
              THEN
                  RELFILEFLG = TRUE;    #REL FILE - SET FLG#
              ELSE
                  RELFILEFLG = FALSE;  #NOT REL#
              IF FN$SRECPTR [FNATPTR] NQ 0
              THEN
                  BEGIN 
                  AUXPTR = VIRTUAL (TABLETYPE"AUX$",FN$SRECPTR
                      [FNATPTR]); 
                  IF AX$SAMRECNAM [AUXPTR] NQ FN$DNATPTR [FNATPTR]
                  THEN
                      TEST FNATINDEX;  #NO PROC IF NOT OWNER FNAT#
                  ELSE
                      BEGIN   #FIND LARGEST RECORD SIZE#
                      FOR AUXINDEX = AX$TNEXTPTR [AUXPTR] WHILE 
                          AUXINDEX NQ 0 DO
                          BEGIN 
                          AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
                          TEMP = AX$SAMRECNAM [AUXPTR]; 
                          AUXINDEX = AX$TNEXTPTR [AUXPTR];
                          TEMP = DN$FNATPTR [VIRTUAL (TABLETYPE"DNAT$", 
                              TEMP)]; 
                          TEMP = VIRTUAL (TABLETYPE"FNAT$", TEMP);
                          IF FN$ORG [TEMP] EQ RELATIVE
                          THEN
                              RELFILEFLG = TRUE;    #REL FILE - SET FLG#
                          ELSE
                              RELFILEFLG = FALSE;  #NOT REL#
                          TEMP = FN$ACCUMMAX [TEMP];  #MAX REC# 
                          IF TEMP GR RECSIZE
                          THEN
                              RECSIZE = TEMP; 
                          END 
                      END 
                  END 
              IF RELFILEFLG 
              THEN
                  BEGIN   #RELATIVE FILE - ALLOW WORD FOR REC ID# 
                  OUTPUTBSS (1);
                  RECOFFSET = RECOFFSET + 1;
                  END 
              #SAVE RECORD OFFSET IN TABLE# 
              TEMP = VIRTUAL (TABLETYPE"WORK2$", RECMSEC);
              RECLABEL = NEXTLABEL;   #GET A LABEL# 
              DEFLOCLAB (RECLABEL);  #DEFINE THE LABEL# 
              WORK2RECLAB [TEMP] = RECLABEL;
              WORK2RECOFF [TEMP] = RECOFFSET; 
              WORK2BLKNBR [TEMP] = BLOCKNUMBER; 
              #COMPUTE NEW OFFSET (IN WORDS)# 
              TEMP = RECSIZE / 10 + 1;   #REC SIZE + 1 CHAR IN WORDS# 
              OUTPUTBSS (TEMP);     #ALLOCATE SPACE#
              RECOFFSET = RECOFFSET + TEMP; 
              IF NOT EXTFLAG
              THEN
                  RECBLOCKOFF = RECOFFSET;
              ELSE
                  FN$RECOFF [FNATPTR] = RECOFFSET;
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC FORMDATAHD;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  FORMDATAHD                                            #
 #                                                                     #
 #        GIVEN- ARRAYINDEX - POINTS TO NEXT WORD IN OTEXT ARRAY       #
 #                                                                     #
 #        DOES-  FORMS A DATA HEADER                                   #
 #               BUMPS ARRAYINDEX BY 1                                 #
 #                                                                     #
 #               SETS DATAHDR TO ARRAYINDEX                            #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          OTEXTOC  [ARRAYINDEX] = S"DATA$"; 
          DATAHDR = ARRAYINDEX; 
          ARRAYINDEX = ARRAYINDEX+1;
          RETURN; 
          END 
          CONTROL EJECT;
          PROC GENLDSET (TYPE, NAME); 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         NAME - GENLDSET 
* 
*         DOES - GENERATES AN LDSET INSTRUCTION 
* 
*         INPUTS
              TYPE - TYPE OF LDSET - USES LDSETVALS (USE, OMIT, LIBRARY)
              NAME - NAME OF LIBRARY OR ENTRY POINT 
* 
*         USES - LDSET VIRTUAL TABLE ONLY 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
          BEGIN 
          ITEM TYPE I;
          ITEM NAME C(10);
          ITEM LDSETINDX I; 
  
          CCTLDSETLEN = CCTLDSETLEN + 1;
          LDSETINDX = VIRTUAL (TABLETYPE"LDSET$", CCTLDSETLEN); 
          LDSETNAME [LDSETINDX] = NAME; 
          LDSETTYPE [LDSETINDX] = TYPE; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC LEVELTEST; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  LEVELTEST                                             #
 #                                                                     #
 #        DOES-  CHECKS FOR VALID LEVELS OF DNAT ENTRIES AND CALLS     #
 #               PROCESSORS IF NEEDED                                  #
 #                                                                     #
 #        USES-  ON INPUT LEVELNUMBER MUST CONTAIN THE DNATLEVEL       #
 #               FIELD                                                 #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          DEF  SETLSTWSDNAT 
               #IF CCTLSTWSDNAT EQ 0 THEN CCTLSTWSDNAT = DNATINDEX - 1#;
          SWITCH LEVELS 
              FDDESCR$        #51#   #AN FD ENTRY#
          ,   SDDESCR$        #52#   #AD SD ENTRY#
          ,   CDDESCR$        #53#   #A CD ENTRY# 
          ,   IGNORE          #54#   #REPORT DESCR - PROCESSED ELSEWHER#
          ,                   #55#   #INDEX IS PROCESSED ELSEWHERE# 
          ,   MNEMNAME$       #56#   #MNEMONIC NAME#
          ,   LITLEVEL$       #57#   #LITERALS# 
          ,                   #58#   #TEMPS THE SAME# 
          ,   ERRORLEV$       #59#   #AN ERROR ENTRY# 
          ,   IGNORE          #60#   #EDIT PATTERNS SKIPPED#
          ,   IGNORE          #61#   #MODIFICATION NOT PROC#
          ,   FDSECTN$        #62#   #FILE SECTION HDR# 
          ,   WSSECTN$        #63#   #WORKING STORAGE#
          ,   LKSECTN$        #64#   #LINKAGE#
          ,   CDSECTN$        #65#   #COMM# 
          ,                   #66#   #RENAMES ELSEWHERE#
          ,   RDSECTN$        #67#   #REPORT SECTION# 
          ,   IGNORE          #68#   #BRTABLE#
          ,   IGNORE          #69#   #BRHEADER# 
          ,   IGNORE          #70#   #PERFFLAG# 
          ,   IGNORE          #71#   #CONTVECT# 
              ,   ALPHNAME$   #72#   #ALPHABET NAME#
              ,   IGNORE      #73#   #SORT USING HEADER#
              ,   IGNORE      #74#   #SORT KEY HEADER#
              ,   IGNORE      #75#   #RESULT TEMP#
              ,   CSSECTN$    #76#   #COMMON STORAGE SECTION# 
              ,               #77#   #77 LEVEL ITEM - ELSEWHERE#
              ,   SSSECTN$    #78#   #SECONDARY STORAGE SECTION#
              ,    FDSECTN$    #79#   #DDL FILE SECTION # 
          ; 
          ITEM EXTFLAG     U; 
          ITEM FILENBR     I;      #FILE NUMBER - FNAT POINTER# 
          ITEM FIRSTSD     B = TRUE;   # TRUE IF FIRST SD NOT PROCESSED#
          ITEM INDEX  I;
          XREF ITEM SORTLIB C(10); #NAME OF SORT LIBRARY - IN LOVER#
  
          IF LEVELNUMBER GR LEVVALMAX 
              THEN GOTO ERRORLEV$;  #JUMP IF BAD LEVEL# 
          IF SBLOCK NQ 0
          THEN    #LAST WAS EXTERNAL# 
              BEGIN 
              OUTPUTEXT;
              END 
          RESETLEV;   #RESET ANY ITEMS LEFT FROM PREVIOUS LEVEL#
          GOTO LEVELS [LEVELNUMBER - DATANAMEMAX - 1];
  
 ALPHNAME$: 
          IF DN$ANTYPE [DNATPTR] NQ ANLITERAL 
          THEN
              RETURN;   #IGNORE IF NOT  A LITERAL#
          INDEX = DN$BYTEOFFS [DNATPTR];
          WORDOFF = INDEX / 10; 
          DN$CHARPOS [DNATPTR] = INDEX - (WORDOFF * 10);
          DN$WORDOFF [DNATPTR] = WORDOFF; 
          DN$SUBMSEC [DNATPTR] = LITBLK;
          RETURN; 
 CDDESCR$:  
          RETURN; 
  
 CDSECTN$:  
         NOGENFLAG = FALSE; 
         CURRMMSEC = CDMSEC;
         CURRSMSEC = 0; 
         SETGLOBAL("CDSECTN",TRUE); 
          RETURN; 
  
 CSSECTN$:    #COMMON STORAGE SECTION#
          BLOCKNAME = "CCOMMON";
          NOGENFLAG = FALSE;
          CURRMMSEC = COMSMSEC; 
          CURRSMSEC = 0;
          BLOCKNUMBER = CSBLOCK;
          OUTPUTUSE (FALSE);
          RETURN; 
  
 ERRORLEV$:       #AN UNRECOGNIZABLE LEVEL NUMBER#
          $BEGIN
          PRINTVAL (1, "PROCTAB", DNATINDEX); 
          $END
          RETURN; 
  
 FDDESCR$:        #FILE DESCRIPTION ENTRY#
          FILENBR = DN$FNATPTR [DNATPTR]; 
          FNATPTR = VIRTUAL (TABLETYPE "FNAT$", FILENBR); 
          TEMP = VIRTUAL (TABLETYPE"WORK2$", FN$SMSECNO[FNATPTR]);
          RECBLOCK = WORK2BLKNBR [TEMP];   #GET BLOCK NBR FOR THIS REC# 
          DN$SUBMSEC[DNATPTR] = RECBLOCK; 
          CRECOFFSET = WORK2RECOFF [TEMP] * 10;  #REC OFFSET IN CHARS # 
          IF FN$PRINTF [FNATPTR] EQ 1 
          THEN
              CRECOFFSET = CRECOFFSET + 1;  #OFFSET BY 1 FOR PRINT FILE#
          RETURN; 
  
 FDSECTN$:  
          NOGENFLAG = TRUE;   #DO NOT GENERATE DATA#
          CURRMMSEC = FDMSEC; 
          RETURN; 
  
 IGNORE:   #IGNORE THIS ITEM# 
          RETURN; 
  
 LITLEVEL$: 
          IF CURRMMSEC EQ LITMSEC 
          THEN
              BEGIN 
 #     INITIALIZATION HAS BEEN DONE ALREADY#
              PROCITEM;   #PROCESS THIS ITEM# 
              RETURN; 
              END 
          BLOCKNUMBER = LITBLK;   #LITERAL BLOCK NUMBER#
          CURRMMSEC = LITMSEC;
          CURRSMSEC = 0;
          PROCITEM; 
          RETURN; 
  
 LKSECTN$:  
          CURRMMSEC = LINKMSEC; 
          NOGENFLAG = TRUE;    #DO NOT GENERATE ANY CODE# 
          SETLSTWSDNAT;      # LAST WSSEC DNAT ENTRY FOR TERMNATION DMP#
  
          RETURN; 
  
 MNEMNAME$: 
          RETURN; 
  
  
 RDSECTN$:  
          NOGENFLAG = FALSE;
          CURRMMSEC = RDMSEC; 
          SETGLOBAL ("RDSECTN", TRUE);   #ASSIGN REPORT DESCRIPTION BLK#
          CRECOFFSET = 0;   #ZERO OUT FOR PROCITEM TEST#
          SETLSTWSDNAT;      # LAST WSSEC DNAT ENTRY FOR TERMNATION DMP#
  
          RETURN; 
 SDDESCR$:  
          IF FIRSTSD
          THEN
              BEGIN   #FIRST SD PROCESSED#
              FIRSTSD = FALSE;
              GENLDSET (LDSETVAL"LIBRARY", SORTLIB);
              END 
          GOTO FDDESCR$;
          RETURN; 
  
 SSSECTN$:       #SECONDARY STORAGE SECTION#
          BLOCKNAME = "SSECTN"; 
          NOGENFLAG = FALSE;
          CURRMMSEC = SECSMSEC; 
          CURRSMSEC = 0;
          COMMONFLAG = TRUE;
          OUTPUTUSE (TRUE); 
          SETLSTWSDNAT;      # LAST WSSEC DNAT ENTRY FOR TERMNATION DMP#
  
          RETURN; 
  
 WSSECTN$:  
          NOGENFLAG = FALSE;
          CURRMMSEC = WSMSEC; 
          CURRSMSEC = 0;
          SETGLOBAL ("WSSECTN", TRUE);   #ASSIGN BLOCK FOR WORKING STO# 
          RETURN; 
  
          END 
          CONTROL  EJECT; 
          PROC  NUMLITCHECK;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
#                                                                      #
#         NAME - NUMLITCHECK                                           #
#                                                                      #
#     DOES - CHECK LEGALITY OF NUMERIC LITERAL IN VALUE CLAUSE         #
#                                                                      #
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
          ITEM  LITNUMLEN;
          ITEM  LITPOINT; 
          ITEM  LITREF; 
          BEGIN 
          IF  CODE EQ PLTQUOTEDLIT
              OR CODE EQ PLTBOOLLIT 
          THEN
              BEGIN 
              PRINTDIAG(D046,DNATINDEX);  #VALUE NOT NUMERIC# 
              RETURN; 
              END 
          IF  TYPE EQ COMP2  THEN RETURN; #NO FURTHER CHECK NECESSARY  #
          IF  PL$SIGNEDFLG[PLTPTR] EQ 1 AND DN$SIGNGRP[DNATPTR] EQ 0
          THEN  PRINTDIAG(D047,DNATINDEX);
          B<0,2>LITREF = 1; 
          B<2,10>LITREF = PL$LENGTH[PLTPTR];
          GETPLST(PLTINDEX,LOC(PLTSTRDATA));
          B<42,18>LITREF = LOC(PLTSTRDATA); 
          SCANLIT(LITREF,LITNUMLEN,LITPOINT); 
          IF LITNUMLEN LS 0  THEN  RETURN;   #FLOATING POINT LITERAL   #
          IF  (DN$POINT[DNATPTR] GQ 0 AND 
              DN$POINT[DNATPTR] LS  LITPOINT) 
              OR  (DN$POINT[DNATPTR] LS 0 AND LITPOINT NQ 0)
              OR ((LITNUMLEN - LITPOINT) GR 
                  (DN$NUMLEN[DNATPTR] - DN$POINT[DNATPTR])
                  AND  DN$NUMLEN[DNATPTR] GQ  DN$POINT[DNATPTR])
          THEN  PRINTDIAG(D045,DNATINDEX);  #TRUNCATION#
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OUTPUTBSS (BSSSIZE); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  OUTPUTBSS                                             #
 #                                                                     #
 #        DOES-  CREATES A BSS OF THE SIZE OF THE ONE PARAMETER        #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM BSSSIZE   U; 
          IF DATAHDR EQ ARRAYINDEX - 1
          THEN ARRAYINDEX = DATAHDR;
          OTEXTOC [ARRAYINDEX] = S"BSS$"; 
          OTEXTCONST [ARRAYINDEX] = BSSSIZE;
          BUMPARINDX (1, 2);
          FORMDATAHD; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OUTPUTDATA(OPWORD);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  OUTPUTDATA                                            #
 #                                                                     #
 #        GIVEN- A WORD OF DATA TO PUT ON THE OTEXT FILE               #
 #                                                                     #
 #        DOES-  PUTS IT THERE                                         #
 #             BUMPS THE COUNT IN THE DATA HEADER                      #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM OPWORD U;
          OTEXTCOUNT[DATAHDR] = OTEXTCOUNT[DATAHDR]+1;
          OTEXTTEXT[ARRAYINDEX] = OPWORD; 
         BUMPARINDX(1,1); 
         IF ARRAYINDEX EQ 0 
         THEN 
              FORMDATAHD; 
         RETURN;
         END
          CONTROL EJECT;
          PROC OUTPUTEXT; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  OUTPUTEXT                                             #
 #                                                                     #
 #        DOES-  OUTPUT EXTERNAL DATA WORD                             #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          BLOCKNUMBER = SBLOCK; 
          SBLOCK = 0; 
          CURRWDAD = (MAXBYTEOFF + 9)/10; 
          ELASTWORD = "          "; 
          EREPCOUNT = EREPCOUNT + CURRWDAD - 1; 
          IF EREPCOUNT NQ 0 
          THEN
              BEGIN 
              OUTPUTREPL(ELASTWORD,EREPCOUNT);
              EREPCOUNT = 0;
              END 
          ELSE
              OUTPUTDATA(ELASTWORD);
          MAXBYTEOFF = SMAXBYTEOFF; 
          CURRBCP = SCURRBCP; 
          CURRWDAD = SCURRWDAD; 
          IF EXTNFLAG 
          THEN
              BEGIN 
              EXTNFLAG = FALSE; 
              OUTPUTUSE(FALSE); 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OUTPUTREPL(REPLWD, REPLCT);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
#                                                                      #
#         NAME-  OUTPUTREPL                                            #
#                                                                      #
#         GIVEN- WORD TO REPLICATE IN REPLWD                           #
#                COUNT OF REPLICATIONS IN REPLCT                       #
#                                                                      #
#         DOES-  CREATES REPLICATION TABLE                             #
#                                                                      #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM REPLWD  I; 
          ITEM REPLCT  I; 
          ITEM LABELNO I; 
          ITEM LOOPCT  I; 
  
          IF REPLCT LS 5
          THEN
 #     DO NOT OUTPUT REPLICATION TABLE IF LESS THAN 6 WORDS TO DO      #
 #     NOTE THAT REPLCT IS 1 LESS THAN THE ACTUAL NUMBER OF WORDS      #
              BEGIN 
              FOR LOOPCT = 0 STEP 1 UNTIL REPLCT DO 
                  OUTPUTDATA (REPLWD);
              RETURN; 
              END 
          IF REPLWD EQ "          " 
          THEN
              BEGIN 
              OUTPUTBSS (REPLCT + 1); 
              RETURN; 
              END 
          IF ARRAYINDEX - 1 EQ DATAHDR
          THEN
              ARRAYINDEX = DATAHDR; 
          LABELNO = NEXTLABEL;     #GET A LOCAL LABEL NUMBER# 
          DEFLOCLAB (LABELNO);    #DEFINE LOCAL LABEL FOR REPL# 
          OUTPUTDATA (REPLWD);   #PUT OUT WORD TO BE REPLICATED#
          OTEXTOC    [ARRAYINDEX] = S"REPL";
          OTEXTCONST[ARRAYINDEX] = REPLCT;
          OTEXTCOUNT [ARRAYINDEX] = 1;
          OTEXTTABLE [ARRAYINDEX + 1] = S"LOCAL$";
          OTEXTINDEX [ARRAYINDEX + 1] = LABELNO;
          OTEXTNUM[ARRAYINDEX+1] = 1; 
          BUMPARINDX(2,2);
          FORMDATAHD; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OUTPUTUSE (DEFBLKFLAG);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #        NAME-  OUTPUTUSE                                             #
 #                                                                     #
 #        DOES-  OUTPUTS THE USE ENTRY AND DEFINES THE BLOCK           #
 #                                                                     #
 #                                                                     #
 #                                                                     #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM DEFBLKFLAG  B; 
          IF DATAHDR EQ ARRAYINDEX - 1
          THEN ARRAYINDEX = DATAHDR;
          OTEXTOC [ARRAYINDEX] = S"USE$"; 
          IF DEFBLKFLAG 
          THEN
              BLOCKNUMBER = DEFBLOCK(BLOCKNAME,COMMONFLAG,FALSE); 
          OTEXTINDEX [ARRAYINDEX] = BLOCKNUMBER;
          BUMPARINDX (1,2); 
          FORMDATAHD; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OUTPUTWORD;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  OUTPUTWORD                                            #
 #                                                                     #
 #        GIVEN- NEW DATA WORD TO BE OUTPUT IN CURRWORD                #
 #               LAST WORD PROCESSED IN LASTWORD                       #
 #               LAST WORD ADDR IN LASTWDAD                            #
 #                                                                     #
 #        DOES-  WRITES THE LAST WORD ON THE FILE IF DIFFERENT         #
 #               OR GENS REPL DEPENDING ON REPEATS OF LAST WORD.       #
 #               CURR WORD BECONES LAST                                #
 #               SET CBCP TO 0                                         #
 #               SET CEDADD UP BY 1                                    #
 #               PUTS SPACES IN CURRWORD                               #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM LASTWDAD   I;
          ITEM LASTWORD I;
          ITEM REPCOUNT I = 0;
          ITEM ITEMP     I; 
  
          IF FIRSTONE 
          THEN
              BEGIN   #FIRST TIME THROUGH#
              REPCOUNT = 0; 
              FIRSTONE = FALSE; 
              LASTWORD = "          ";
              LASTWDAD = 0; 
              IF CURRWDAD EQ 0
              THEN
                  GOTO OPWEXIT; 
              END 
          IF LASTWDAD +1 NQ CURRWDAD
          THEN
              BEGIN   #THERE ARE SOME INTERVENING BLANK WORDS#
              IF LASTWORD EQ "          " 
              THEN
                  REPCOUNT = REPCOUNT + CURRWDAD - LASTWDAD - 1;
              ELSE
                  BEGIN 
                  IF REPCOUNT NQ 0
                  THEN
                      OUTPUTREPL (LASTWORD, REPCOUNT);
                  ELSE
                      OUTPUTDATA (LASTWORD);
                  REPCOUNT = CURRWDAD - LASTWDAD - 2; 
                  END 
              LASTWORD = "          ";
              LASTWDAD = CURRWDAD - 1;
              END 
          ITEMP = 0;
          IF CURRWORD EQ LASTWORD 
          AND NOT FLUSHFLAG 
          THEN
              # SEMICOLON AND COLON WILL BE = ON PREV TEST #
              ITEMP = CURRWORD LQV LASTWORD;
              IF B<0,1>ITEMP EQ 1 
                  THEN   # DUPLICATED WORDS - CAN BE REPLICATED # 
                      REPCOUNT = REPCOUNT + 1;
          ELSE   #WORDS DIFFER - FLUSH OUT ANY REPL AND LAST ONE# 
              BEGIN 
              IF REPCOUNT NQ 0
              THEN
                  BEGIN 
                  OUTPUTREPL (LASTWORD, REPCOUNT);
                  REPCOUNT = 0; 
                  END 
              ELSE
                  OUTPUTDATA (LASTWORD);
              END 
 OPWEXIT: 
          LASTWORD = CURRWORD;
          CURRWORD = "          ";
          CURRBCP = 0;
          LASTWDAD = CURRWDAD;
          CURRWDAD  = CURRWDAD  + 1;
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PERFTIMES; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *        NAME - PERFTIMES
 *
 *        DOES - CREATES SPACE FOR PERFORM TIMES COUNT WORDS
 *               SETS UP A DNAT FOR EACH ONE
 *               SETS CCTPERFTIMES TO ORDINAL OF FIRST SET UP DNAT
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM PERFTPTR;
          ITEM FIRSTDNAT; 
  
          IF CCTPERFTIMES EQ 0
          THEN
              RETURN;   #NO PERFORM TIMES IN PROGRAM# 
          FIRSTDNAT = CCTDNATLEN + 1;   #SAVE POINTER TO FIRST DNAT#
          SETGLOBAL ("PERFTIM", TRUE);    #DEFINE BLOCK AND OUTPUT USE# 
          OUTPUTBSS (CCTPERFTIMES);    #ALLOCATE SPACE# 
          FOR PERFTPTR = 0 STEP 1 UNTIL CCTPERFTIMES - 1 DO 
              BEGIN 
              CCTDNATLEN = CCTDNATLEN + 1;       #POINT TO NEW DNAT#
              DNATPTR = VIRTUAL (TABLETYPE "DNAT$", CCTDNATLEN);
              DN$TYPE [DNATPTR] = COMP1;        #ITEM IS COMP1# 
              DN$SUBMSEC [DNATPTR] = BLOCKNUMBER;  #SET BLOCK PTR#
              DN$NUMLEN [DNATPTR] = 10;         #SIZE 10# 
              DN$LEVEL [DNATPTR] = TEMPLEVL;    #LEVEL = TEMPORARY# 
              DN$WORDOFF [DNATPTR] = PERFTPTR;  #WORD OFFSET# 
              END 
          CCTPERFTIMES = FIRSTDNAT;    #SET CCT FIELD TO FIRST ONE# 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PNATPROC;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  PNATPROC                                              #
 #                                                                     #
 #        DOES-  FOR NON-SEGMENTED PROGRAMS -                          #
 #                                                                     #
 #               PROCESSES THE ENTIRE PNAT PLACING A LOCAL LABEL INTO  #
 #               ALL ENTRIES WHICH ARE THE END OF A PERFORM            #
 #                                                                     #
 #        FOR SEGMENTED PROGRAMS -                                     #
 #                                                                     #
 #               PROCESSES THE ENTIRE PNAT TO BUILD ALL NECESSARY      #
 #               ENTRY, EXIT, AND RESET INDECES                        #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
  
          ITEM   WORK1IDX I=1;     #INDEX INTO WORK1 TABLE# 
          ITEM   SEGPTRIX I=1;     #INDEX INTO SEGPTR TABLE#
          ITEM   VIRSEGPTRIX I;    #VIRTUAL INDEX INTO SEGPTR#
          ITEM   LAST I;
          ITEM   BOTTOM I=1;       # BOTTOM OF SEGPTR FOR SORTING      #
          ITEM   J I; 
          ITEM   TOP I;            # TOP OF SEGPTR FOR SORTING         #
          ITEM   SWFLG I=0;        # SWITCH FLAG FOR SORTING SEGPTR TBL#
          ITEM   DONE  I=0;        # DONE FLAG FOR SORTING SEGPTR TBL  #
          ITEM   PERFFLAG B=FALSE; # TRUE IF SEGMENTATION AND PERFORMS #
          XREF ITEM SGPTRDNATIX I;
          XREF ITEM LASTPNAT I; 
          XREF ITEM SGIXBLK I;
  
          IF NOT CCTSEGMENTS [0]
              OR  CCTSUBPROGR[0] AND NOT CCTALTINDSEG[0]
          THEN
              BEGIN 
              FOR PNATINDEX = 1 STEP 1 UNTIL CCTPNATLEN DO
                  BEGIN 
                  PNATPTR = VIRTUAL (TABLETYPE"PNAT$", PNATINDEX);
                  FIELDVAL = PN$PERFLAST [PNATPTR]; 
                  IF FIELDVAL NQ 0 THEN 
                      BEGIN  # IS END OF PERFORM - ADD LOCAL LABEL #
                      FIELDVAL = NEXTLABEL;  #ASSIGN LOCAL LABEL# 
                      AUXINDEX = PN$AUXREF [PNATPTR]; 
                      IF AUXINDEX NQ 0
                      THEN
                          ADDAUX(AUXINDEX);  # ADD NEW AUX TO CHAIN # 
                      ELSE
                          BEGIN 
                          ADDAUX(AUXINDEX);  # CREATE NEW AUX # 
                          PN$AUXREF [PNATPTR] = AUXINDEX; 
                          END 
                      AUXPTR = VIRTUAL(TABLETYPE"AUX$", AUXINDEX);
                      AX$TTYPE [AUXPTR] = AUXLOCAL; 
                      AX$LOCALNO [AUXPTR] = FIELDVAL; 
                      END 
                  END 
              RETURN; 
              END 
  
#      PROCESS PNAT FOR SEGMENTED PROGRAM                              #
  
#      THE FIRST THING WE DO IS PUT OUT A USE BLOCK                    #
  
          SETGLOBAL("INDXTBL",TRUE);
          SGIXBLK = BLOCKNUMBER;
  
#      NOW WE PUT OUT THE INDEX TABLE HEADER                           #
  
          OUTPUTDATA (CCTSEGLIMIT); 
  
#      ADD A NEW DNAT SO CGEN CAN REFERENCE INDEX TABLE                #
  
          CCTDNATLEN = CCTDNATLEN + 1;
          SGPTRDNATIX = CCTDNATLEN; 
          DN$SUBMSEC [VIRTUAL (TABLETYPE"DNAT$", CCTDNATLEN)] = 
              BLOCKNUMBER;
  
          FOR PNATINDEX = 1 STEP 1 UNTIL CCTPNATLEN  DO 
              BEGIN 
              RA$LINE = PNATINDEX;
              PNATPTR = VIRTUAL (TABLETYPE "PNAT$", PNATINDEX); 
  
#      FOR PARAGRAPH DEFS WE ALWAYS PUT OUT AN ENTRY INDEX             #
  
              IF PN$PROCKIND [PNATPTR] EQ 0 
              THEN
                  BEGIN 
                  ENTRYINDEX; 
                  IF PN$ALTERED[PNATPTR] NQ 0  THEN ALTERINDEX; 
                  END 
              ELSE
  
#      FOR SECTION HEADERS WE MUST BUILD THE SEGPTR TABLE FOR CGEN     #
#      WE BUILD AND SORT THE TABLE IN A WORK TABLE (TO INSURE IT WILL  #
#      REMAIN IN CORE)                                                 #
  
                  BEGIN 
                  IF  NOT CCTSUBPROGR 
                  THEN
                  BEGIN 
                  SEXTIXPTR = 0;
                  WORK1IDX = VIRTUAL (TABLETYPE"WORK1$", WORK1IDX); 
                  WORK1SEGNO [WORK1IDX] = PN$SEGMENTNO [PNATPTR]; 
                  AUXINDEX = PN$AUXREF [PNATPTR]; 
                  FINDAUX (AUXGTEXT); 
                  $BEGIN
                  IF AUXPTR EQ 0  THEN
                      BEGIN 
                      PRINTVAL (20,"PROCTAB",PNATINDEX);
                      XREF PROC ABORT;
                      ABORT;
                      END 
                  $END
                  WORK1GTEXT [WORK1IDX] = AX$GTEXTPTR [AUXPTR]; 
                  WORK1IDX = WORK1IDX + 1;
                  END 
  
#      FOR SECTION HEADERS WE ALSO ALWAYS PUT OUT AN ENTRY INDEX       #
  
                  ENTRYINDEX; 
                  END 
  
#      IF THIS PARAGRAPH/SECTION IS THE END OF A PERFORM RANGE,        #
#      THEN AN EXIT INDEX MUST BE GENERATED.                           #
  
              IF PN$PERFLAST [PNATPTR] NQ 0 THEN
                  BEGIN 
                  EXITINDEX;
                  PERFFLAG = TRUE;
                  END 
  
              END 
  
#      NOW WE PUT OUT THE INDEX TABLE TRAILER                          #
  
          I = 0;
          OUTPUTDATA (I); 
          IF  PERFFLAG
          THEN
              BEGIN 
              GENLDSET (LDSETVAL"USE", "C.PERF"); 
              END 
          IF  CCTSUBPROGR THEN RETURN;
  
#      NOW WE SORT THE SEGPTR TABLE BY SEGMENT NUMBER                  #
#      WE USE A DOUBLE BUBBLE METHOD- SORTING THE TABLE FROM BOTTOM TO #
#      TOP TO GET THE ENTRY WITH THE LARGEST SEGMENT NUMBER AT THE TOP #
#      THEN FROM TOP TO BOTTOM TO GET THE ENTRY WITH THE SMALLEST      #
#      SEGMENT AT THE BOTTOM.  THE TOP AND THE BOTTOM OF THE TABLE     #
#      CONVERGE AT THE RATE OF ONE WORD PER PASS.  THE SORT CONTINUES  #
#      UNTIL TOP = BOTTOM OR A PASS IS MADE WITH NO SWAPS              #
  
          WORK1IDX = WORK1IDX - 1;
          TOP = WORK1IDX; 
  
          FOR J = J WHILE DONE EQ 0 DO
              BEGIN 
              SWFLG = 0;
              FOR I = BOTTOM STEP 1 UNTIL TOP - 1 DO
                  IF WORK1WORD [I] GR WORK1WORD [I+1] 
                  THEN
                      BEGIN 
                      WORK1WORD [I] == WORK1WORD [I+1]; 
                      SWFLG = 1;
                      END 
  
#      ENTRY AT TOP IS NOW LARGEST (HAS LARGEST SEG NUM)               #
#      IF NO SWAPS WERE MADE WE ARE DONE                               #
  
              TOP = TOP - 1;
              IF BOTTOM EQ TOP OR SWFLG EQ 0 THEN 
                  BEGIN 
                  DONE = 1; 
                  TEST; 
                  END 
              SWFLG = 0;
  
#      NOW WE BUBBLE THROUGH THE TABLE FROM TOP TO BOTTOM              #
  
              FOR I = TOP STEP -1 UNTIL BOTTOM + 1 DO 
                  IF WORK1WORD [I] LS WORK1WORD [I-1] 
                  THEN
                      BEGIN 
                      WORK1WORD [I] == WORK1WORD [I-1]; 
                      SWFLG = 1;
                      END 
  
#      ENTRY AT BOTTOM IS NOW SMALLEST (HAS SMALLEST SEG NUM)          #
  
              BOTTOM = BOTTOM + 1;
              IF BOTTOM EQ TOP OR SWFLG EQ 0 THEN DONE = 1; 
              END 
  
#      NOW WE MUST COPY THE WORK TABLE TO THE SEGPTR TABLE             #
  
          FOR I = 1 STEP 1 UNTIL WORK1IDX  DO 
              SEGPTRWORD[VIRTUAL(TABLETYPE"SEGPTR$", I)] = WORK1WORD[I];
  
#      RELEASE THE WORK TABLE                                          #
  
          TMRTNTB (TABLETYPE"WORK1$");
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PRINTDIAG (DIAGNBR,DNATENTRY); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - PRINTDIAG
 *
 *        DOES - PRINTS A DIAGNOSTIC MESSAGE (THAT IS CALLS INTERCEPTOR 
*                TO DO SO)
 *
 *        INPUT - DIAG NUMBER 
                 DNATENTRY (INDEX TO THE DNAT TO BE DIAG) 
* 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM DIAGNBR I; 
          ITEM DNATENTRY I; 
  
          TEMP = DN$LINE [VIRTUAL(TABLETYPE"DNAT$",DNATENTRY)]; 
          INTERCEPTOR (0, TEMP, DIAGNBR, 1);
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PROCITEM;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  PROCITEM                                              #
 #                                                                     #
 #        DOES-  PROCESSES A DNAT ITEM SETTING                         #
 #               SUBMSEC TO BLOCK NUMBER                               #
 #               WORDOFF TO WORD OFFSET                                #
 #               DNATBYTEOFF TO CHAR OFFSET                            #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM BYTEOFF    I;
          ITEM NXTLINKNBR  I = 1;  #NEXT NUMBER FOR LINKAGE ITEM# 
          ITEM LINKAGENBR  I = 0;   #NUMBER OF ASSOC 01 IN LINKAGE SEC# 
          ITEM DNAME C(7);
          ITEM NDNATPTR I;
          ITEM NAMEPTR I; 
          ITEM IXDNT U; 
          MAJMSEC = DN$MAJMSEC [DNATPTR]; 
          IF MAJMSEC EQ UNLITMSEC 
          THEN
              RETURN;    #DO NOT PROCESS UNPOOLED LITERALS# 
          IF CURRMMSEC EQ LITMSEC 
          AND MAJMSEC NQ LITMSEC
          AND MAJMSEC NQ TEMPMSEC 
          AND MAJMSEC NQ SREGMSEC 
          THEN
              BEGIN 
 #     HERE WE HAVE AN UNPOOLED LITERAL OR SUBSCRIPT ITEM              #
              IF LEVELNUMBER EQ TEMPLEVL
              THEN
                  RETURN;    #IGNORE TEMP ITEMS WITH OTHER THAN TMPMSEC#
              DN$MAJMSEC [DNATPTR] = 0; 
              DN$SUBMSEC [DNATPTR] = 0; 
 #     THE MSEC FIELDS OF LITERALS NOT PROCESSED BY L-POOLER HAVE JUNK
       CONTAINED IN THEM - CLEAR OUTTHE JUNK #
              DN$BYTEOFFS [DNATPTR] = 0;
              IF CURRLATDNAT NQ DNATINDEX 
              THEN   #ERROR - NO LAT #
                  BEGIN 
                  $BEGIN
                  PRINTVAL (15, "PROCTAB", DNATINDEX);
                  $END
                  RETURN; 
                  END 
                  BEGIN 
                  IF L$IMMEDIATE [LATPTR]   EQ 0
                  AND PL$CODE [VIRTUAL(TABLETYPE"PLT$", PLTINDEX)]
                      EQ PLTFLTLIT
                  THEN
                      DN$TYPE [DNATPTR] = COMP2;   #COMP-2 IF FLOAT LT# 
                  ELSE
                      DN$TYPE [DNATPTR] = NUMERIC;   #NUMERIC (COMP) #
                  DN$WORDOFF [DNATPTR] = 0; 
                  RETURN; 
                  END 
              END 
          IF MAJMSEC EQ 0 
          THEN
              RETURN;   #IGNORE ITEMS WITH NO MAJ MSEC AND NOT LITS#
          IF CURRMMSEC NQ MAJMSEC 
          AND CURRMMSEC NQ RDMSEC 
          AND MAJMSEC NQ SREGMSEC 
          THEN
              BEGIN 
              IF MAJMSEC NQ TEMPMSEC
              THEN
                  BEGIN 
                  $BEGIN
                  PRINTVAL (2, "PROCTAB", DNATINDEX); 
                  $END
                  DN$SUBMSEC[DNATPTR] = SREGBLOCK;
                  RETURN; 
                  END 
              ELSE
                  IF LEVELNUMBER NQ TEMPLEVL
                  THEN
                      RETURN;   #NO PROCESS FOR THESE ITEMS#
                  ELSE
                      BEGIN   #NON-REGISTER TEMP - CHANGE LEVEL FOR GEN#
                      LEVELNUMBER = 77; 
                      DN$LEVEL [DNATPTR] = 77;
                      END 
              END 
          IF MAJMSEC EQ WSMSEC
          OR MAJMSEC EQ COMSMSEC
          OR MAJMSEC EQ SECSMSEC
          THEN
              BYTEOFF = DN$LONGOFF [DNATPTR]; 
          ELSE
              BYTEOFF = DN$BYTEOFFS [DNATPTR];
          IF MAJMSEC EQ WSMSEC AND (DN$LEVEL[DNATPTR] EQ 1 OR 
             DN$LEVEL[DNATPTR] EQ 77) THEN
             BEGIN
             IF DN$EXTERNAL[DNATPTR] EQ 1 
             AND DN$RDEF[DNATPTR] EQ 0
             THEN 
                 BEGIN
                 IF SBLOCK EQ 0     #PREVIOUS NOT EXTERNAL# 
                 THEN 
                     BEGIN
                     SBLOCK = BLOCKNUMBER;
                     SMAXBYTEOFF = MAXBYTEOFF;
                     SCURRBCP = CURRBCP;
                     SCURRWDAD = CURRWDAD;
                     END
                 ELSE    #PREVIOUS EXTERNAL#
                     BEGIN
                     CURRWDAD = (MAXBYTEOFF + 9)/10;
                     ELASTWORD = "          ";
                     EREPCOUNT = EREPCOUNT + CURRWDAD -1; 
                     IF EREPCOUNT NQ 0
                     THEN 
                         BEGIN
                         OUTPUTREPL(ELASTWORD,EREPCOUNT); 
                         EREPCOUNT = 0; 
                         END
                     ELSE 
                         OUTPUTDATA(ELASTWORD); 
                     END
                 IXDNT = VIRTUAL(TABLETYPE"DNT$",DNATINDEX);
                 NAMEPTR = DNTNAMETPTR[IXDNT];
                 DNAME = NAMET$CHARS[VIRTUAL
                         (TABLETYPE"NAMET$",NAMEPTR)];
                 BLOCKNAME = DNAME; 
                 COMMONFLAG = TRUE; 
                 OUTPUTUSE(TRUE); 
                 EXTNFLAG = TRUE; 
                 MAXBYTEOFF = 0;
                 CURRBCP = 0; 
                 CURRWDAD = 0;
                 END
             ELSE    #NOT EXTERNAL OR REDEFINITION# 
                 BEGIN
                 IF (SBLOCK NQ 0) AND (DN$RDEF[DNATPTR] EQ 0) 
                 THEN    #LAST WAS EXTERNAL#
                     BEGIN
                     OUTPUTEXT; 
                     END
                 END
             END
          IF MAJMSEC EQ FDMSEC
          THEN
 #     RECORD AREA ITEMS NEED TO BE BIASED TO POINT TO THE RECORD#
              BEGIN 
              IF DN$LEVEL [DNATPTR] EQ 1
              THEN
                  BEGIN      # SPECIAL PROCESS FOR FILE RECORD LEVEL 1# 
                  DN$SYNC [DNATPTR] = 0;   #NO LONGER SYNCHED#
                  AUXINDEX = DN$AUXREF [DNATPTR]; 
                  FINDAUX (FILENAME);   #FIND FILE AUX ENTRY# 
                  IF AUXINDEX NQ 0
                  THEN
                      BEGIN  #PROCESS FILE AUX# 
                      FNATPTR = VIRTUAL (TABLETYPE "FNAT$", AX$FNATPTR
                          [AUXPTR]);  #POINT TO FNAT# 
                      IF FN$FRECPTR [FNATPTR] EQ 0
                      THEN
                          BEGIN    #FIRST REC AREA FOR FILE#
                          FN$FRECPTR [FNATPTR] = DNATINDEX; 
                          DN$AUXREF [VIRTUAL (TABLETYPE "DNAT$",
                              FN$DNATPTR [FNATPTR])] = AUXINDEX;
                          DNATPTR = VIRTUAL (TABLETYPE "DNAT$", 
                              DNATINDEX);   #RESET TO CURRENT DNAT# 
                          END 
                      END 
                  END 
              ELSE
                  BEGIN 
                  IF (DN$SYNC [DNATPTR] NQ 0
                  OR DN$SYNCRGHT [DNATPTR] NQ 0)
                  AND FN$PRINTF [FNATPTR] EQ 1
                  THEN
                  BEGIN 
                  TEMP1 = DNATINDEX;
                  PRINTDIAG (D043,TEMP1); #ERROR - NO SYNC ALLOWED# 
                  END 
                  END 
              IF CRECOFFSET EQ 0  #EQUALS ZERO IF REPORT DESCR PROC#
              THEN
                  BEGIN 
                   TEMP = VIRTUAL(TABLETYPE"WORK2$",DN$SUBMSEC
                      [DNATPTR]);  #SET UP FOR RECORD OFFSET# 
                  BYTEOFF = BYTEOFF + (WORK2RECOFF [TEMP] * 10);
                  RECBLOCK = WORK2BLKNBR [TEMP];
                  END 
              ELSE
                  BYTEOFF = BYTEOFF + CRECOFFSET; 
              END 
 #     THIS CODE IS NEEDED TO SET LINKAGE SECTION ITEMS TO THE CORRECT
       BCP BECAUSE OF A FRONT END BUG - REMOVE WHEN THE FRONT END IS
       FIXED ***************  # 
          IF MAJMSEC EQ LINKMSEC
          AND LEVELNUMBER EQ 77 
          AND DN$SYNCRGHT [DNATPTR] EQ 1
          AND NOT (DN$TYPE [DNATPTR] EQ COMP2 
              OR DN$TYPE[DNATPTR] EQ INDXDATA 
              OR DN$TYPE [DNATPTR] EQ COMP1)
          THEN
              BEGIN 
              TEMP = DN$ITMLEN [DNATPTR]; 
              BYTEOFF = 10 - (TEMP - ((TEMP / 10) * 10)); 
              IF  BYTEOFF EQ 10  THEN BYTEOFF = 0;
              END 
          IF BYTEOFF LS 0 
          THEN
              WORDOFF = (BYTEOFF + 1) / 10 - 1;  #NEG SUBSCR OFFSET#
          ELSE
              WORDOFF = BYTEOFF / 10;    #REGULAR OFFSET# 
          CHARPOS = BYTEOFF - (WORDOFF * 10);  #GIVES CHARACTER POS#
          DN$CHARPOS [DNATPTR] = CHARPOS; 
          IF  DN$LEVEL[DNATPTR] EQ 1 #LEVEL 01# 
              AND  DN$RDEF[DNATPTR] EQ 0        #NOT REDEFINED# 
              AND  DN$SYNC[DNATPTR] EQ 0  #NOT ALREADY SYNCHRONIZED#
              AND MAJMSEC NQ FDMSEC 
          THEN
              BEGIN 
              IF  DNATINDEX LS CCTDNATLEN 
              THEN
                  BEGIN 
                  TEMP = DNATINDEX + 1; 
                  TEMP1 = VIRTUAL(TABLETYPE"DNAT$",TEMP); 
                  IF  DN$LEVEL[TEMP1] EQ 1      #LEVEL 01#
                      AND  DN$RDEF[TEMP1] EQ 0  #NOT REDEFINES# 
                  THEN
                      BEGIN            #RESOTRE POINTER AND SET SYNC# 
                      DNATPTR = VIRTUAL(TABLETYPE"DNAT$",DNATINDEX);
                      DN$SYNC[DNATPTR] = 1; 
                      END 
                  ELSE
                      DNATPTR = VIRTUAL(TABLETYPE"DNAT$",DNATINDEX);
                  END 
              END 
          IF DN$VALUE[DNATPTR] NQ 0 
          AND CURRMMSEC NQ LITMSEC
          THEN
              PROCVALUE;   #ITEM HAS A VALUE - PROCESS IT#
          BYTEOFF = BYTEOFF + DN$ITMLEN [DNATPTR];
          DN$WORDOFF [DNATPTR] = WORDOFF; 
          IF MAJMSEC EQ TEMPMSEC
          THEN
              BEGIN 
              DN$SUBMSEC [DNATPTR] = TEMPBLOCK; 
              IF BYTEOFF GR MAXTEMP 
              THEN
                  MAXTEMP = BYTEOFF;
              END 
          ELSE
              BEGIN 
              IF MAJMSEC NQ LINKMSEC
              THEN
 #     SET SUBMSEC TO POINT TO THE CORRECT BLOCK FOR THE ITEM          #
                  BEGIN 
                  IF MAJMSEC EQ FDMSEC
                  THEN
                      DN$SUBMSEC [DNATPTR] = RECBLOCK;
                  ELSE
                      IF MAJMSEC EQ SREGMSEC
                      THEN
                          DN$SUBMSEC [DNATPTR] = SREGBLOCK; 
                      ELSE
                          DN$SUBMSEC [DNATPTR] = BLOCKNUMBER; 
                  END 
              ELSE
 #     SPECIAL PROCESS FOR LINKAGE SECTION ITEMS                       #
 #     SUBMSEC MUST POINT TO ASSOCIATED 01 LEVEL ITEM                  #
                  BEGIN 
                  IF LEVELNUMBER EQ 1 
                  OR LEVELNUMBER EQ 77
                  THEN
                      BEGIN 
                      IF DN$RDEF [DNATPTR] NQ 1 
                      THEN
                          BEGIN 
                          LINKAGENBR = NXTLINKNBR;
                          NXTLINKNBR = NXTLINKNBR + 1;
                          END 
                      ELSE
                          BEGIN   #REDEFINED ITEM - FIND ORIG ITEM# 
                          AUXINDEX = DN$AUXREF [DNATPTR]; 
                          FINDAUX (RDEFNAME);  #FIND AUX TABLE ENTRY #
                          LINKAGENBR = DN$SUBMSEC [VIRTUAL (TABLETYPE 
                              "DNAT$", AX$RDEFNAM [AUXPTR])]; 
                          DNATPTR = VIRTUAL (TABLETYPE "DNAT$", 
                              DNATINDEX);   #RESET DNAT PROPERLY# 
                          END 
                      END 
                  DN$SUBMSEC [DNATPTR] = LINKAGENBR;
                  END 
              IF BYTEOFF GR MAXBYTEOFF
              AND DN$SUBMSEC [DNATPTR] EQ BLOCKNUMBER 
              THEN MAXBYTEOFF = BYTEOFF;
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PROCVALUE; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME-   PROCVALUE 
 *
 *        GIVEN 
 *                DNAT POINTER IN DNATPTR 
 *                CURRENT WORD OFFSET IN WORDOFF
 *                CURRENT BCP IN CHARPOS
 *                LAST WORD WITH VALUE IN IT IN CURRWORD
 *                ADDRESS OF LAST ONE IN CURRWDAD 
 *                MISC TABLES - LAT, DNAT, PLT, PLTSTR
 *
 *        DOES-   OUTPUTS DATA DIVISION VALUES
 *                CONVERTS NUMERIC ONES 
 *                GIVES APPROPRIATE DIAGNOSTICS WHEN NEEDED 
 *                UPDATES CURRWDAD, CURRWORD, CURRBCP 
 *                SETS UP LATINDEX AND LATPTR TO NEXT ONE 
 *
  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM ALLFLAG B; 
          ITEM ALLSIZE I; 
          ITEM  BOOLLEN;
          ITEM FIGCONCHAR C(10);
          ITEM FIGCONFLAG B;
          ITEM FIGCONWORD C(10);
          ITEM  J;
          ITEM LITBCP I;
          ITEM LITLEN I;
          ITEM LITINDEX I;
          ITEM LIT20CHAR C(20); 
          ITEM NBRCH  I;
          ITEM SIZE   I;
          ITEM SIGNCHARS C(10) = "!JKLMNOPQR";  #NEGATIVE SIGNED CHARS# 
          ITEM   ZEROS  C(10);
          DEF  D044  #44#;
  
          ARRAY  BITSTRING [0:4]; 
              ITEM  BITS U; 
          BASED ARRAY LITERALSTR [0:0] S(1);
              ITEM LITERALCH C(0,0,10); 
  
          SWITCH VALUETYPE
              , 
              ANVALUE,       #ALPHABETIC# 
              ANVALUE,       #ALPHABETIC EDITED#
              ANVALUE,       #AN# 
              ANVALUE,       #AN EDITED#
              ANVALUE,       #ERROR#
              ANVALUE,       #NUMERIC EDITED# 
              NUMVALUE,      #COMP# 
                      ,      #EXT FLOAT#
              NUMVALUE,      #COMP4#
              NUMVALUE,      #COMP2#
                      ,      #DP COMP2# 
              NUMVALUE,      #COMP1#
                      ,      #LINECTR#
                      ,      #INDEX DATA# 
                      ,      #INDEX NAME# 
              ANVALUE,       #GROUP#
              ANVALUE,       #VAR GROUP#
              ANVALUE,       #NON DATA# 
              BITVALUE,      #BOOLEAN BIT#
              BOOLVALUE;     #BOOLENA DISPLAY#
  
          IF  CURRMMSEC EQ COMSMSEC AND CCTSUBPROGR 
          THEN
              BEGIN 
              PRINTDIAG(D044,DNATINDEX);
              RETURN; 
              END 
          PLTINDEX = DN$PLTPTR[DNATPTR];
          SIZE = DN$ITMLEN [DNATPTR];   #SIZE OF ITEM#
          TYPE = DN$TYPE [DNATPTR];     #TYPE OF ITEM#
          PLTPTR = VIRTUAL (TABLETYPE"PLT$", PLTINDEX); 
          CODE = PL$CODE [PLTPTR];
          FIGCONFLAG = FALSE; 
          ALLFLAG = FALSE;
          LITBCP = 0; 
          LITINDEX = 0; 
          LITLEN = PL$LENGTH [PLTPTR];
          IF TYPE EQ INDXDATA 
          THEN
              TYPE = COMP1;   # USE COMP-1 FOR INDEX DATA ITEM #
          GOTO VALUETYPE[TYPE]; 
 NUMVALUE:  
 #     PROCESS NUMERIC VALUE LITERAL                                   #
              IF CODE EQ PLTFGCONZERO 
              THEN
                  BEGIN 
                  IF TYPE EQ NUMERIC
                  THEN
                      BEGIN 
                      LIT20CHAR = "00000000000000000000"; 
                      LIT2RNSIGN = 0; 
                      SIZE = DN$NUMLEN [DNATPTR]; 
                      END 
                  ELSE
                      BEGIN 
                  FIGCONFLAG = TRUE;
                      IF  TYPE EQ COMP4 
                      THEN
                          BEGIN 
                          SIZE = DN$ITMLEN[DNATPTR];
                          LITLEN = SIZE;
                          END 
                      ELSE
                          BEGIN 
                          SIZE = 10;
                          LITLEN = 10;
                          END 
                      LITBCP = 0; 
                      B<0, 60> FIGCONWORD = B<0, 60> LITBCP;  #ZERO OUT#
                      P<LITERALSTR> = LOC(FIGCONWORD);
                      END 
                  END 
              ELSE
                  BEGIN 
                  NUMLITCHECK;
                  IF  CODE EQ PLTQUOTEDLIT  THEN RETURN;   #ILLEGAL#
                  IF DN$SIGNGRP [DNATPTR] NQ 0
                  OR TYPE EQ COMP2
                  THEN
                      LIT2RNSIGN = 1; 
                  ELSE
                      LIT2RNSIGN = 0; 
                  IF TYPE EQ COMP2
                  THEN
                      LIT2RNSIZE = -1;   #USE AS FLAG FOR CONVERT RTN#
                  ELSE
                      BEGIN 
                      LIT2RNSIZE = DN$NUMLEN [DNATPTR];  #USE NUM SIZE# 
                      SIZE = LIT2RNSIZE;
                      LIT2RNPOINT = DN$POINT [DNATPTR]; 
                      END 
                  CONVLIT2RN;   #CONVERT TO REGISTER NUMERIC# 
                  IF TYPE NQ NUMERIC
                  THEN
                      BEGIN 
                      SIZE = 10;
                  LITBCP = 0; 
                      IF TYPE EQ COMP1
                      OR TYPE EQ COMP4
                      THEN
                          LIT2RNPOINT = 0;
                      IF LIT2RNWD1 EQ 0  THEN    # IF FLOATING PT. LIT #
                          LIT2RNPOINT = 0;       #  RESET FROM SCANLIT #
                      RN2BIN (LIT2RNWD1, LIT2RNWD2, LIT2RNPOINT,
                          LIT2RNWD1, LIT2RNWD2, FIGCONWORD);  #CONVERT# 
                      IF TYPE EQ COMP2
                      THEN
                          P<LITERALSTR> = LOC (LIT2RNWD1);
                      ELSE
                          P<LITERALSTR> = LOC (FIGCONWORD); 
             IF TYPE EQ COMP4 
             THEN 
                 BEGIN
                 SIZE = DN$ITMLEN [DNATPTR];
                 LITBCP = 10 - SIZE;
                 END
                      END 
                  ELSE
                      BEGIN 
                      IF C<0, 1> LIT2RNWD1 EQ "9" 
                      THEN
                              BEGIN 
                              LIT2RNWD1 = LNO LIT2RNWD1;   #COMP# 
                              LIT2RNWD2 = LNO LIT2RNWD2;
                              LIT2RNSIGN = -1;   #SET NEGATIVE SIGN#
                              END 
                      C<0, 10> LIT20CHAR = C<0, 10> LIT2RNWD1;
                      C<10, 10> LIT20CHAR = C<0, 10> LIT2RNWD2; 
                      END    # END DISPLAY CONVERSION PROCESS # 
                  END    # END CONVERSION PROCESS # 
              IF TYPE EQ NUMERIC
              THEN
                  BEGIN  # START DISPLAY SIGN PROCESS # 
                      P<LITERALSTR> = LOC (LIT20CHAR);
                      IF DN$SCHAR [DNATPTR] EQ 1
                      THEN
                              BEGIN  #SIGN IS SEPARATE# 
                              SIZE = SIZE + 1;   #INCLUDE SIGN# 
                              IF LIT2RNSIGN GQ 0
                              THEN
                                  FIGCONCHAR = "+";   #POSITIVE#
                              ELSE
                                  FIGCONCHAR = "-";   #NEGATIVE#
                              IF DN$LSIGN [DNATPTR] EQ 0
                              THEN
                                  BEGIN   #SHIFT TO MAKE ROOM FOR SIGN# 
                                  C<0, 19> LIT20CHAR =
                                      C<1, 19> LIT20CHAR; 
                                  C<19, 1> LIT20CHAR =
                                      C<0, 1> FIGCONCHAR; 
                                  END 
                              ELSE
                                  C<20 - SIZE, 1> LIT20CHAR = C<0, 1> 
                                      FIGCONCHAR; 
                              END 
                      ELSE
                          BEGIN  # START IMBEDDED SIGN PROCESS #
                          IF LIT2RNSIGN LS 0
                          THEN
                              BEGIN 
                              LITINDEX = 0; 
                              IF DN$LSIGN [DNATPTR] EQ 0
                              THEN
                                  BEGIN 
                                  C<9, 1> LITINDEX = C<9, 1> LIT2RNWD2; 
                                  LITINDEX = LITINDEX - O"33";
 #                             DONE THIS WAY BECAUSE FO SYMPL BUG#
                                  FIGCONCHAR = C<LITINDEX, 1> SIGNCHARS;
                                  C<19, 1> LIT20CHAR = C<0, 1>
                                      FIGCONCHAR; 
                                  END 
                              ELSE
                                  BEGIN 
                                  C<9, 1> LITINDEX = C<20- SIZE, 1> 
                                      LIT20CHAR;
                                  LITINDEX = LITINDEX - O"33";
                                  C<20 - SIZE> LIT20CHAR = C<LITINDEX,
                                      1> SIGNCHARS; 
                                  END 
                              END 
                          END    # END IMBEDDED SIGN PROCESS #
                  LITBCP = 20 - SIZE; 
                  END    # END DISPLAY SIGN PROCESS # 
              LITLEN = SIZE;
               GOTO PUTVALUE; 
 #     END OF NUMERIC LITERAL PROCESS                                  #
 ANVALUE: 
 #     PROCESS ALPHANUMERIC LITERAL                                    #
              IF PL$FIGSPACE [PLTPTR] EQ 1
              THEN
              RETURN;   #IGNORE AFTER DIAG# 
              IF NOT (CODE EQ PLTQUOTEDLIT
                  OR CODE EQ PLTFGCONZERO)
              THEN
                  BEGIN  #LITERAL MUST BE AN ALPHANUMERIC TYPE# 
                  PRINTDIAG(D039,DNATINDEX);
                  RETURN;   #IGNORE AFTER DIAG# 
                  END 
              IF PL$FIGCON [PLTPTR] NQ 0
              OR (PL$ALL [PLTPTR] EQ 1 AND LITLEN EQ 1) 
              THEN
                  BEGIN 
                  IF PL$FIGHIGHV [PLTPTR] EQ 1
                  THEN
                      FIGCONCHAR = CCTHIVALUE;  #HIGH VALUE#
                  ELSE
                      IF PL$FIGLOWV [PLTPTR] EQ 1 
                      THEN
                          FIGCONCHAR = CCTLOVALUE;   #LOW VALUE#
                      ELSE
                          FIGCONCHAR = PLT$CHAR [VIRTUAL (TABLETYPE 
                              "PLTSTR$", PL$STRINGPTR [PLTPTR])]; 
                  FIGCONFLAG = TRUE;
                  P<LITERALSTR> = LOC (FIGCONWORD); 
                  LITLEN = SIZE;
                  FOR LITBCP = 0 STEP 1 UNTIL 9 DO
                      C<LITBCP, 1> FIGCONWORD = C<0, 1> FIGCONCHAR; 
                      LITBCP = 0; 
                  END 
              ELSE
                  BEGIN 
                  IF PL$ALL [PLTPTR] EQ 1 
                  THEN
                      BEGIN 
                      ALLSIZE = LITLEN; 
                      ALLFLAG = TRUE; 
                      END 
                  GETPLST (PLTINDEX, LOC(PLTSTRDATA));  #GET LITERAL# 
                  P<LITERALSTR> = LOC (PLTSTRDATA); 
                  END 
          GOTO PUTVALUE;
 #     END OF ALPHANUMERIC LITERAL PROCESS                             #
 BOOLVALUE: 
          IF  CODE NQ PLTBOOLLIT
          THEN
              BEGIN 
              PRINTDIAG(D048,DNATINDEX);
              RETURN; 
              END 
          GETPLST(PLTINDEX, LOC(PLTSTRDATA)); 
          P<LITERALSTR> = LOC(PLTSTRDATA);
          IF PL$ALL [PLTPTR] EQ 1 
          THEN
              BEGIN 
              ALLSIZE = LITLEN; 
              ALLFLAG = TRUE; 
              BOOLLEN = SIZE;          #NO ZERO FILL REQUIRED#
              END 
          ELSE
              BOOLLEN = LITLEN; 
          GOTO  PUTVALUE; 
 BITVALUE:  
          IF  CODE NQ PLTBOOLLIT
          THEN
              BEGIN 
              PRINTDIAG(D048,DNATINDEX);
              RETURN; 
              END 
          IF LITLEN GR DN$BITLEN[DNATPTR] 
          THEN
              BEGIN 
              PRINTDIAG(D045,DNATINDEX);
              LITLEN = DN$BITLEN[DNATPTR];
              END 
          GETPLST(PLTINDEX, LOC(PLTSTRDATA)); 
          P<LITERALSTR> = LOC(BITSTRING); 
          IF PL$ALL [PLTPTR] EQ 1 
          THEN
              BEGIN 
              IF WORDOFF NQ CURRWDAD
              THEN
                  BEGIN 
                  OUTPUTWORD; 
                  CURRWDAD = WORDOFF; 
                  END 
              I = 0;
              BOOLLEN = DN$BITLEN[DNATPTR]; 
              TEMP2 = 6 * CHARPOS;
              FOR I = I WHILE BOOLLEN NQ 0 DO 
                  BEGIN 
                  IF TEMP2 + BOOLLEN GR 60
                  THEN TEMP = 59; 
                  ELSE TEMP = TEMP2 + BOOLLEN - 1;
                  FOR J = TEMP2 STEP 1 UNTIL TEMP DO
                      BEGIN 
                      IF I EQ LITLEN THEN I = 0;
                      LITINDEX = I / 10;
                      LITBCP = I - 10 * LITINDEX; 
                      IF C<LITBCP,1>PLTSTRDWORD[LITINDEX] EQ "0"
                      THEN  B<J,1>CURRWORD = 0; 
                      ELSE  B<J,1>CURRWORD = 1 ;
                    I = I + 1;
                      END 
                  IF TEMP EQ 59  THEN OUTPUTWORD; 
                  BOOLLEN = BOOLLEN - (TEMP - TEMP2 + 1); 
                  TEMP2 = 0;
                  END 
              J = CHARPOS + DN$ITMLEN[DNATPTR]; 
              CURRBCP = J -(J/10) * J;
              RETURN; 
              END 
          FOR I = 1 STEP 1 UNTIL LITLEN DO
              BEGIN 
              J = (I-1)/10;  #WORD NUMBER#
              TEMP =  I-1 - 10*J;  #CHARACTER NUMBER# 
              TEMP1 = (I-1)/60; 
              TEMP2 = I - 1 - 60*TEMP1; 
              IF  C<TEMP,1>PLTSTRDWORD[J] EQ "0"
              THEN  B<TEMP2,1>BITS[TEMP1] = 0;
              ELSE  B<TEMP2,1>BITS[TEMP1] = 1;
              END 
          IF  LITLEN - (LITLEN/6)*6 NQ 0   #ZERO FILL LAST BYTE#
          THEN
              BEGIN 
              I = 6 - (LITLEN - 6*(LITLEN/6));
              B<TEMP2+1,I>BITS[TEMP1] = 0;
              END 
          LITLEN = (LITLEN+5)/6;   #NUMBER OF BYTES IN LITERAL# 
          BOOLLEN = LITLEN; 
          GOTO PUTVALUE;
 PUTVALUE:  
 #     PUT OUT VALUE                                                   #
  
          LITINDEX = LITBCP / 10; 
          LITBCP = LITBCP - (10 * LITINDEX);
          IF WORDOFF NQ CURRWDAD
          THEN
              BEGIN 
              OUTPUTWORD;  #IS NEW WORD - FLUSH OLD ONE#
              CURRWDAD = WORDOFF; 
              END 
          IF SIZE LS LITLEN 
          THEN
              BEGIN 
 #     ERROR - LITERAL WILL BE TRUNCATED                               #
              PRINTDIAG(D045,DNATINDEX);
              LITLEN = SIZE;
              END 
          CURRBCP = CHARPOS;
          FOR I = I WHILE  LITLEN  GR 0 DO
              BEGIN 
              NBRCH = 10 - CURRBCP; 
              IF NBRCH GR LITLEN
              THEN
                  NBRCH = LITLEN; 
              IF LITBCP + NBRCH GR 10 
              THEN
                  BEGIN 
                  ITEM TEMPDIFF I;
                  TEMPDIFF = LITBCP + NBRCH - 10; 
                  C<CURRBCP, NBRCH - TEMPDIFF> CURRWORD 
                      = C<LITBCP, NBRCH-TEMPDIFF> LITERALCH [LITINDEX]; 
                  C<CURRBCP + NBRCH - TEMPDIFF, TEMPDIFF> CURRWORD
                      = C<0, TEMPDIFF> LITERALCH [LITINDEX + 1];
                  END 
              ELSE
                  IF LITBCP EQ 0
                  AND CURRBCP EQ 0
                  AND NBRCH EQ 10 
                  THEN
                      CURRWORD = LITERALCH [LITINDEX];
                  ELSE
                      C<CURRBCP,NBRCH>CURRWORD =
                        C<LITBCP,NBRCH>LITERALCH[LITINDEX]; 
              IF CURRBCP + NBRCH GR 9 
              THEN
                  OUTPUTWORD;   #WORD IS FILLED - FLUSH IT# 
              ELSE
                  CURRBCP = CURRBCP + NBRCH;
              IF FIGCONFLAG 
              THEN
                  LITBCP = 0; 
              ELSE
                  BEGIN 
                  LITBCP = LITBCP + NBRCH;
                  IF LITBCP GR 9
                  THEN
                          BEGIN 
                          LITBCP = LITBCP - 10; 
                          LITINDEX = LITINDEX + 1;
                          END 
                  END 
              LITLEN = LITLEN - NBRCH;
              IF ALLFLAG
              THEN
                  BEGIN 
                  SIZE = SIZE - NBRCH;
                  IF LITLEN EQ 0
                  THEN
                      BEGIN 
                      LITBCP = 0; 
                      LITINDEX = 0; 
                      IF SIZE NQ 0
                      THEN
                          BEGIN 
                          IF SIZE GR ALLSIZE
                          THEN
                              LITLEN = ALLSIZE; 
                          ELSE
                              LITLEN = SIZE;
                          END 
                      END 
                  END 
              END 
          IF (TYPE EQ BOOLBIT OR TYPE EQ BOOLDSP) AND BOOLLEN LS SIZE 
          THEN
              BEGIN          #ZERO FILL REMAINDER OF ITEM#
              TEMP = SIZE - BOOLLEN;
              IF  TYPE EQ BOOLBIT 
              THEN B<0,60>ZEROS = 0;
              ELSE  ZEROS = "0000000000"; 
              CURRBCP = (CHARPOS + BOOLLEN)-10*((CHARPOS + BOOLLEN)/10);
              FOR  I=0  WHILE TEMP GR 0 DO
                  BEGIN 
                  NBRCH = 10 - CURRBCP; 
                  IF  NBRCH GR TEMP  THEN NBRCH = TEMP; 
                  C<CURRBCP,NBRCH>CURRWORD = ZEROS; 
                  IF  CURRBCP + NBRCH GR 9  THEN OUTPUTWORD;
                  ELSE  CURRBCP = CURRBCP + NBRCH;
                  TEMP = TEMP - NBRCH;
                  END 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC RELOCLOWER (WORDTORELOC, LOCLABTOREL, TABLETOREF); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  RELOCLOWER                                            #
 #                                                                     #
 #        DOES-  RELOCATES THE LOWER PORTION OF WORDTORELOC BY         #
 #               CREATING A VFD                                        #
 #                                                                     #
 #        USES-  INPUT IS WORD IN WORDTORELOC                          #
 #               LOCAL LABEL NUMBER IS IN LOCLABTOREL                  #
 #               TABLE TO REFERENCE IN TABLETOREF                      #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ARRAY WORDTORELOC [0:0] S(1); 
              BEGIN 
              ITEM WDTORELF42   U(0,0,42);
              ITEM WDTORELL18   U(0,42,18); 
              END 
          ITEM LOCLABTOREL U; 
          ITEM TABLETOREF U;
  
          IF ARRAYINDEX - 1 EQ DATAHDR
          THEN
              ARRAYINDEX = ARRAYINDEX - 1;
          IF ARRAYINDEX + 5 GQ OTEXTLEN  #SEE IF VFD WILL FIT IN BUFFER#
          THEN
              BEGIN 
              OTEXTWRITE (ARRAYINDEX);   #IT WONT - DUMP IT#
              ARRAYINDEX = 0; 
              END 
          OTEXTOC [ARRAYINDEX] = S"VFD$"; 
          OTEXTCOUNT [ARRAYINDEX] = 4;
          ARRAYINDEX = ARRAYINDEX + 1;
          OTEXTNUM [ARRAYINDEX] = 42;    #UPPER 42 BITS#
          OTEXTTEXT [ARRAYINDEX + 1] = WDTORELF42 [0];
          OTEXTNUM [ARRAYINDEX + 2] = 18;  #LOWER 18 BITS#
          OTEXTTABLE [ARRAYINDEX + 2] = TABLETOREF; 
          OTEXTINDEX [ARRAYINDEX + 2] = LOCLABTOREL;
          OTEXTTEXT [ARRAYINDEX + 3] = WDTORELL18 [0];
          BUMPARINDX (4, 6);
          FORMDATAHD; 
          RETURN; 
              END 
          CONTROL EJECT;
          PROC RELOCUL (WORDTORELOC, ULOCLAB, UTABLE, LLOCLAB, LTABLE); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - RELOCUL
 *
 *        DOES - RELOCATES THE UPPER AND LOWER PARTS OF THE INPUT WORD
 *
 *        PARAMETERS
 *
 *            WORDTORELOC IS THE WORD TO RELOCATE AND OUTPUT
 *            ULOCLAB IS THE LOCAL LABEL NUMBER OR TABLE ENTRY
 *            UTABLE IS THE TABLE NUMBER (TABLETYPE "XXX$"...)
 *            LXXX ARE THE SAME FOR THE LOWER 
 *
 *            CHANGES THE OTEXT POINTERS - NO OTHER LOCATIONS 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ARRAY WORDTORELOC [0:0] S(1); 
              BEGIN 
              ITEM WDTORELF12 U(0, 00, 12); 
              ITEM WDTORELU18 U(0, 12, 18); 
              ITEM WDTORELL12 U(0, 30, 12); 
              ITEM WDTORELL18 U(0, 42, 18); 
              END 
          ITEM ULOCLAB I; 
          ITEM UTABLE I;
          ITEM LLOCLAB I; 
          ITEM LTABLE I;
  
  
          IF ARRAYINDEX - 1 EQ DATAHDR
          THEN
              ARRAYINDEX = ARRAYINDEX - 1; #POINT BACK - DEL HDR# 
          IF ARRAYINDEX + 9 GQ OTEXTLEN 
          THEN
              BEGIN  #WILL NOT FIT IN BUFFER - FLUSH# 
              OTEXTWRITE (ARRAYINDEX);
              ARRAYINDEX = 0; 
              END 
          OTEXTOC [ARRAYINDEX] = S"VFD$"; 
          OTEXTCOUNT [ARRAYINDEX] = 8;
          ARRAYINDEX = ARRAYINDEX + 1;
          OTEXTNUM [ARRAYINDEX] = 12; 
          OTEXTTEXT [ARRAYINDEX + 1] = WDTORELF12;
          OTEXTNUM [ARRAYINDEX + 2] = 18; 
          OTEXTTABLE [ARRAYINDEX + 2] = UTABLE; 
          OTEXTINDEX [ARRAYINDEX + 2] = ULOCLAB;
          OTEXTTEXT [ARRAYINDEX + 3] = WDTORELU18;
          OTEXTNUM [ARRAYINDEX + 4] = 12; 
          OTEXTTEXT [ARRAYINDEX + 5] = WDTORELL12;
          OTEXTNUM [ARRAYINDEX + 6] = 18; 
          OTEXTTABLE [ARRAYINDEX + 6] = LTABLE; 
          OTEXTINDEX [ARRAYINDEX + 6] = LLOCLAB;
          OTEXTTEXT [ARRAYINDEX + 7] = WDTORELL18;
          BUMPARINDX (8, 2);
          FORMDATAHD; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC RESETLEV;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #        NAME-  RESETLEV                                              #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          IF NOGENFLAG
          THEN
              BEGIN 
              CURRBCP = 0;
              CURRWDAD = 0; 
              FIRSTONE = TRUE;
              MAXBYTEOFF = 0; 
              RETURN; 
              END 
          NOGENFLAG = TRUE; 
          IF MAXBYTEOFF EQ 0
          THEN
              BEGIN 
              CURRBCP = 0;
              CURRWDAD = 0; 
              FIRSTONE = TRUE;
              RETURN;    #DO NOTHING IF NO CODE GENNED# 
              END 
          IF  CURRMMSEC EQ COMSMSEC AND CCTSUBPROGR 
          THEN
              BEGIN 
              OUTPUTBSS((MAXBYTEOFF+9)/10); 
              END 
          ELSE
              BEGIN 
              IF  CURRBCP NQ 0  THEN  OUTPUTWORD; 
              CURRWDAD = (MAXBYTEOFF + 9)/10; 
              FLUSHFLAG = TRUE; 
              OUTPUTWORD; 
              FLUSHFLAG = FALSE;
              END 
          MAXBYTEOFF = 0; 
          CURRBCP = 0;
          CURRWDAD = 0; 
          FIRSTONE = TRUE;
          RETURN; 
          END 
          CONTROL EJECT;
          PROC SETGLOBAL (ORIGBLKNM, USEHFLAG); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        SETGLOBAL - DEFINES A BLOCK FOR GLOBAL DATA (IN DEG PROGS)
 *               SHOULD BE CALLED FOR ANY BLOCK WHICH IS GLOBAL TO ALL
 *               SEGMENTS  IN A SEGMENTED PROGRAM 
 *               OUTPUTS A USE HEADER IF DESIRED
 *               PUTS BLOCK IN COMMON IF A SEGMENTED PROGRAM
 *               OTHERWISE USES THE DEFINED BLOCK NAME
 *
 *        INPUTS
 *               ORIGBLKNM (FIRST PARAM) = NAME OF BLOCK
 *               USEHFLAG (SECOND PARAM) = TRUE IF USE HEADER, FALSE
 *                   IF NONE TO BE GENERATED
 *
 *        OUTPUTS 
 *               BLOCKNAME HAS NAME OF BLOCK REQUESTED
 *               BLOCKNUMBER HAS NUMBER OF BLOCK ASSIGNED 
 *               COMMONFLAG REFLECTS SEGMENTATION 
 *               USE HEADER IS WRITTEN IF SECOND PARAM IS TRUE
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM ORIGBLKNM  C(10);
          ITEM USEHFLAG  B; 
  
          IF  CCTSEGMENTS AND NOT CCTSUBPROGR 
          THEN
              BEGIN  # SEGMENTATION USED - PUT BLOCK IN COMMON# 
              BLOCKNAME = "          ";  #ASSEM WILL FILL IN NAME#
              COMMONFLAG = TRUE;
              END 
          ELSE
              BEGIN 
              BLOCKNAME = ORIGBLKNM;   #NAME OF BLOCK#
              COMMONFLAG = FALSE; 
              END 
          IF USEHFLAG 
          THEN
              OUTPUTUSE (TRUE);   #OUTPUT USE HDR AND DEF BLOCK#
          ELSE
              BLOCKNUMBER = DEFBLOCK (BLOCKNAME, COMMONFLAG, FALSE);
          RETURN; 
          END 
          CONTROL EJECT;
 #        MAIN PROCEDURE                                               #
 #                                                                     #
# 
*      INITIALIZE 
# 
  
  
          #THE DECIMAL NUMBER 131071 TRANSLATES INTO 377777 OCTAL # 
          #WHICH REPRESENTS THE LARGEST NUMBER WHICH CAN BE USED  # 
          #AS AN ADDRESS OR IN 18 BIT ARITHMETIC. IF THE GTEXT IS # 
          #ALLOWED TO GROW LARGER THAT THIS NUMBER BY SPECIFYING  # 
          #DB=B ON THE COBOL COMMAND, THE COMPILATION MAY FAIL IN # 
          #AN UNPREDICTABLE FASHION OR IF COMPILATION SUCCEEDS THE# 
          #GENERATED CODE MAY BE BAD.                             # 
  
          IF CCTGTEXTLEN GR 131071
          THEN
             INTERCEPTOR(0,0,D026,4); 
  
          #THE FOLLOWING CODE OUTPUTS INFORMATION ABOUT THE NUMBER# 
          #OF ENTRIES IN TABLES WHICH MAY CAUSE FAILURE OF THE    # 
          #COMPILER IF THEY GROW TOO LARGE.  IT SHOULD BE KEPT IN # 
          #MIND THAT REACHING 377777 OCTAL ENTRIES DOES NOT MEAN  # 
          #THAT THE COMPILER WILL FAIL IF THE TABLE GROWS LARGER. # 
          #IT MEANS THAT, IF THE COMPILER NEEDS TO ADDRESS AN     # 
          #ENTRY LARGER THAT 377777 USING 18 BIT ARITHMETIC OR    # 
          #MUST USE AN 18 BIT FIELD TO STORE A POINTER TO THAT    # 
          #ENTRY, THE COMPILER WILL FAIL.                         # 
          #                                                       # 
          #THE INFORMATION IS LISTED ONLY IF THE CS PARAMETER IS  # 
          #SPECIFIED ON THE COBOL COMMAND.                        # 
  
          IF CCTCOMSTATS THEN 
            BEGIN  # ISSUE TABLE SIZE STATISTICS #
              CBLIST(DEFTITLE,"  ** COMPILER STATISTICS **",27);
              CBLIST(EJECTPAGE,"    ",5); 
              STATLINE = "                   "; 
              C<TABLENAME,99>STATLINE = "FAILURE OF THE COMPILER MAY OCC
UR IF THE NUMBER OF ENTRIES IN THE FOLLOWING TABLES EXCEEDS 377777B.";
              CBLIST(DBSP,STATLINE,130);
              STATLINE = "                   "; 
              C<TABLENAME,99>STATLINE = "FAILURE OCCURS IF THE COMPILER 
NEEDS TO USE A NUMBER GREATER THAN 377777 FOR ADDRESSING OR FOR 18  ";
              CBLIST(SSP,STATLINE,130); 
              STATLINE = "                   "; 
              C<TABLENAME,15>STATLINE = "BIT ARITHMETIC.";
              CBLIST(SSP,STATLINE,130); 
              STATLINE = "                   "; 
              C<TABLENAME,5>STATLINE = "TABLE"; 
              C<SIZEDECIMAL,15>STATLINE = "SIZE IN DECIMAL";
              C<SIZEOCTAL,13>STATLINE = "SIZE IN OCTAL";
              C<HOWGROWS,20>STATLINE = "HOW THIS TABLE GROWS";
              CBLIST(DBSP,STATLINE,130); # OUTPUT DNAT INFO # 
              STATLINE = "                   "; 
              C<TABLENAME,10>STATLINE = "DNAT"; 
              C<SIZEDECIMAL,20>STATLINE = DEC(CCTDNATLEN);
              C<SIZEOCTAL,20>STATLINE = OCT(CCTDNATLEN,0,20); 
              C<HOWGROWS,50>STATLINE = "ENVIRONMENT, DATA, AND REPORT WR
ITER ENTRIES.     ";
              CBLIST(DBSP,STATLINE,130); # OUTPUT DNAT INFO # 
              STATLINE = "                   "; 
              C<TABLENAME,10>STATLINE = "GTEXT";
              C<SIZEDECIMAL,20>STATLINE = DEC(CCTGTEXTLEN); 
              C<SIZEOCTAL,20>STATLINE = OCT(CCTGTEXTLEN,0,20);
              C<HOWGROWS,50>STATLINE = "PROCEDURE DIVISION AND REPORT WR
ITER ENTRIES.     ";
              CBLIST(SSP,STATLINE,130); # OUTPUT GTEXT INFO # 
              STATLINE = "                   "; 
              C<TABLENAME,10>STATLINE = "PNAT"; 
              C<SIZEDECIMAL,20>STATLINE = DEC(CCTPNATLEN);
              C<SIZEOCTAL,20>STATLINE = OCT(CCTPNATLEN,0,20); 
              C<HOWGROWS,50>STATLINE = "PROCEDURE DIVISION AND REPORT WR
ITER ENTRIES.     ";
              CBLIST(SSP,STATLINE,130); 
            END 
  
          CHARPOS = 0;
          CDCSIXFNFLAG = FALSE; 
          CDCSRELFLAG = FALSE;
          CCTCAPCOUNT = 0;
          CCTOVCOUNT = 0; 
          TMREOP(TABLETYPE"DNT$");
          TMREOP(TABLETYPE"NAMET$");
          IF  CCTSEGMENTS AND NOT CCTSUBONLY  THEN
             BEGIN
          #      WE SUPPRESS THE LOAD OF CMM.LDV SINCE WE NOW ARE 
                             USING CMM.LOV.  C.SEG REFS BOTH, WHICH 
                             ALLOWS OLD BINARIES TO WORK... # 
              GENLDSET (LDSETVAL"OMIT", "CMM.LDV"); 
             END
  
          LATPTR = VIRTUAL (TABLETYPE "LAT$", LATINDEX);
          CURRLATDNAT = L$DNAT [LATPTR];
          INITBLK;
          OTEXTOPEN;         #OPEN THE OBJECT TEXT FILE#
          ARRAYINDEX = 0; 
          IF  CCTFDL[0] AND CCTSUBPROGR[0]
          THEN
              BEGIN    #REPLACE PROGRAM-ID BY INTERNAL NAME#
              FOR  TEMP = 1 STEP 1 UNTIL CCTFDLTLEN  DO 
                  BEGIN 
                  I = VIRTUAL(TABLETYPE"FDLT$",TEMP); 
                  IF  C<0,10>FDLTPROGNAME[I] EQ CCTPROGRI0 AND
                      C<10,10>FDLTPROGNAME[I] EQ CCTPROGRI1 AND 
                      C<20,10>FDLTPROGNAME[I] EQ CCTPROGRI2 
                  THEN
                      BEGIN 
                      CCTPROGRAMID[0] = FDLTINTNAME[I]; 
                      IF  NOT CCTSUBONLY AND NOT FDLTSTATICF[I] 
                      THEN
                          BEGIN 
                          OTEXTOC[ARRAYINDEX] = S"OVCAP"; 
                          ARRAYINDEX = ARRAYINDEX + 1;
                          END 
                      END 
                  END 
              END 
          IF  NOT CCTSUBPROGR AND (CCTSEGMENTS OR CCTFDL) 
          THEN
              BEGIN  #SEGMENTED JOB - NEED 0,0 OVERLAY CARD#
              OTEXTOC [ARRAYINDEX] = S"OVLY"; 
              ARRAYINDEX = ARRAYINDEX + 1;
              #FORCE C$COMIO INTO 0,0 OVERLAY#
              GENLDSET(LDSETVAL"USE", "C.USE"); 
              END 
 #     GENERATE IDENT CARD   #
          OTEXTOC [ARRAYINDEX] = S"IDENT$"; 
          ARRAYINDEX = ARRAYINDEX + 1;
          OTEXTOC[ARRAYINDEX] = S"STARTSEQ";
          OTEXTCONST[ARRAYINDEX] = REGSEQ;
 #     CODE BLOCK MUST BE FIRST IN PROGRAM                             #
          CODEBLK = DEFBLOCK("CODE   ", FALSE, FALSE);
 #     ASSIGN COMMON BLOCK FOR COMMON STORAGE - MUST BE LOADED FIRST   #
          CSBLOCK = DEFBLOCK ("CCOMMON", TRUE, FALSE);
 #     ASSIGN BLOCKS FOR LITERALS AND TEMPS#
          ARRAYINDEX = ARRAYINDEX + 1;
          SETGLOBAL ("TEMPS", FALSE);   #DEFINE BLOCK FOR TEMPS#
          TEMPBLOCK = BLOCKNUMBER;
          SETGLOBAL ("LITERALS", FALSE);  #DEFINE BLOCK FOR POOLED LITS#
          LITBLK = BLOCKNUMBER; 
 #     IF TERMINAL DUMP SPECIFIED THEN BRACKET DATA DIVISION BY        #
 #        ZERO-LENGTH USE BLOCKS.                                      #
          IF  CCTTDF  THEN  DDBLK1 = DEFBLOCK("DD1    ", FALSE, FALSE); 
 #
       ASSIGN SPACE AND BLOCKS FOR FITS AND RECORD AREAS
 #
          RA$SUBPHASE = RA$SFFNATP; 
          FNATPROC; 
          FORMDATAHD; 
 #     SET UP FOR SPECIAL REGISTERS WHICH ARE FIRST IN THE DNAT        #
          NOGENFLAG= FALSE; 
          CURRMMSEC = SREGMSEC; 
          CURRSMSEC = 0;
 #     DEFINE COMMON BLOCK FOR HASHED VALUE - IS ALWAYS DNAT 1         #
          BLOCKNAME = "C.HASHV";
          COMMONFLAG = TRUE;
          OUTPUTUSE (TRUE); 
          DNATINDEX = 1;
          DNATPTR = VIRTUAL (TABLETYPE "DNAT$", DNATINDEX); 
          OUTPUTBSS(1); 
          DN$SUBMSEC[DNATPTR] = BLOCKNUMBER;
          DN$CHARPOS[DNATPTR] = 0;
          DN$WORDOFF[DNATPTR] = 0;
          NOGENFLAG = FALSE;   #SET TO GENERATE#
 #     DEFINE BLOCK FOR OTHER SPECIAL REGISTERS                        #
          SETGLOBAL ("SREG", TRUE); 
          SREGBLOCK = BLOCKNUMBER;
 #
       DNAT PROCESSING LOOP - PROCEEDS THROUGH ALL OF THE DNAT
 #
          RA$SUBPHASE = RA$SFDNATP; 
          FOR DNATINDEX = 2 STEP 1 UNTIL CCTDNATLEN DO
              BEGIN 
              RA$LINE = DNATINDEX;
              DNATPTR = VIRTUAL (TABLETYPE "DNAT$", DNATINDEX); 
              LEVELNUMBER = DN$LEVEL [DNATPTR]; 
              IF LEVELNUMBER EQ 0    #IGNORE LEVEL 0 - IS NOISE ENTRY  #
              OR LEVELNUMBER EQ 88   #IGNORE 88 LEVEL - NOT USED       #
              THEN
                  TEST; 
          IF LEVELNUMBER EQ REFMODLEVEL 
          THEN
              BEGIN 
              # DNAT CREATED BY REFERENCE MODIFICATION #
              # COPY ORIGINAL DNAT TO REFERENCE MODIFICATION DNAT # 
              COPYD4(DN$REFERENCE[DNATPTR],DNATINDEX);
              TEST; 
              END 
         IF LEVELNUMBER EQ CDDESCR
         THEN 
             BEGIN
             DN$LEVEL [DNATPTR] = 01; 
             LEVELNUMBER = 01;
             END
          IF CURRLATDNAT LS DNATINDEX 
          THEN
              BEGIN 
              FOR CURRLATDNAT = 0 WHILE CURRLATDNAT EQ 0 DO 
                  BEGIN 
                  IF LATINDEX GQ CCTLATLEN
                  THEN
                      BEGIN 
                      CURRLATDNAT = CCTDNATLEN + 1; 
                      TEST; 
                      END 
                  LATINDEX = LATINDEX + 1;
                  LATPTR = VIRTUAL (TABLETYPE "LAT$", LATINDEX);
                  CURRLATDNAT = L$DNAT [LATPTR];
                  IF CURRLATDNAT LS DNATINDEX 
                  THEN
                      BEGIN 
                      CURRLATDNAT = 0;
                      TEST; 
                      END 
                  PLTINDEX = L$PLT [LATPTR];
                  END 
              END 
              IF LEVELNUMBER LQ DATANAMEMAX 
                  OR LEVELNUMBER EQ 77
                  OR LEVELNUMBER EQ 66
                  OR LEVELNUMBER EQ TEMPLEVL
              THEN
                  BEGIN 
                  PROCITEM;     #PROCESS A DATA ENTRY#
                  END 
              ELSE
                  BEGIN 
                  IF LEVELNUMBER EQ INDXLEVL
                  THEN
                      BEGIN 
                      IF INDEXWORD EQ 0 
                      THEN
                          BEGIN 
                          ITEM SVBLK  I;
                          SVBLK = BLOCKNUMBER;   #SAVE CURRENT BLOCK NB#
                          SETGLOBAL ("INDEX", FALSE);  #DEF BLK FOR IND#
                          INDEXBLOCK = BLOCKNUMBER; 
                          BLOCKNUMBER = SVBLK;  #RESTORE CURRENT BLOCK# 
                          END 
                      DN$CHARPOS [DNATPTR] = 0; 
                      DN$WORDOFF [DNATPTR] = INDEXWORD; 
                      INDEXWORD = INDEXWORD + 1;
                      DN$SUBMSEC [DNATPTR] = INDEXBLOCK;
                      TEST; 
                      END 
          IF LEVELNUMBER EQ RDDESCR 
          THEN
              TEST;    # IGNORE RD DESCR HEADERS# 
                  LEVELTEST;    #CHECK FOR NEW LEVEL# 
                  END 
              END 
          IF CCTLSTWSDNAT EQ 0
          THEN
              BEGIN 
              CCTLSTWSDNAT = CCTDNTLEN; 
              END 
          IF SBLOCK NQ 0
          THEN    #LAST WAS EXTERNAL# 
              BEGIN 
              OUTPUTEXT;
              END 
          RESETLEV (0, 0, 0);   #CLEAR LAST ENTRY#
          IF INDEXWORD NQ 0 
          THEN
              BEGIN 
              BLOCKNUMBER = INDEXBLOCK; 
              OUTPUTUSE (FALSE);
              OUTPUTBSS (INDEXWORD);
              END 
          SETGLOBAL ("FITS",FALSE);  #DEFINE FIT BLOCK# 
          FITBLOCK = BLOCKNUMBER; 
          RA$SUBPHASE = RA$SFCRFIT; 
          FOR FNATINDEX  = 1 STEP 1 UNTIL CCTFNATLEN DO 
              BEGIN 
              RA$LINE = FNATINDEX;
              CRFIT;   #CREATE FIT# 
              END 
          BLOCKNUMBER = TEMPBLOCK;
          OUTPUTUSE (FALSE);
          OUTPUTBSS ((MAXTEMP + 9) / 10); 
 #     IF TERMINAL DUMP DEFINE LIMITING BLOCK                          #
          IF  CCTTDF  THEN  DDBLK2 = DEFBLOCK("DD2    ", FALSE, FALSE); 
          SETGLOBAL ("SUBTEMP", TRUE);   #DEFINE BLOCK FOR SUBS TEMPS#
          SBTMPBLK = BLOCKNUMBER; 
          OUTPUTBSS(CCTMAXMNEM);
 #
       DUMP POOLED LITERALS 
 #
          BLOCKNUMBER = LITBLK; 
          OUTPUTUSE (FALSE);
          FOR I     = 0 STEP 1 UNTIL (CCTLPOOLLEN + 9) / 10 - 1 DO
              BEGIN 
              CURRWORD = LPWORDC [VIRTUAL (TABLETYPE "LPOOL$", I)]; 
              OUTPUTWORD; 
              END 
          FLUSHFLAG = TRUE; 
          OUTPUTWORD;  #FLUSH LAST ONE# 
 #     PUT LOCAL LABELS INTO PERFORMED PNATS  # 
  
          RA$SUBPHASE = RA$SFPNATP; 
          PNATPROC; 
 #     BUILD FDL TABLE #
          IF CCTMAINSUB OR NOT CCTSUBPROGR
          THEN
              IF  CCTFDL
              THEN  FDLPROC;
              ELSE
                  IF  CCTTDF
                  THEN
                      BEGIN 
                      BLOCKNUMBER = DEFBLOCK("C.FDLCM",TRUE,FALSE); 
                      OUTPUTUSE(FALSE); 
                      OUTPUTDATA(0);
                      END 
 #
       PUT OUT AREA AND DNATS FOR PERFORM TIMES 
 #
          RA$SUBPHASE = RA$SFPERFT; 
          PERFTIMES;
          IF ARRAYINDEX - 1 EQ DATAHDR
          THEN
              ARRAYINDEX = DATAHDR; 
 #     IF  TERMINAL DUMP PUT OUT WORD CONTAINING DATA DIVISION LIMITS  #
          IF  CCTTDF
          THEN
              BEGIN 
              OTEXTOC[ARRAYINDEX] = S"USE$";
              OTEXTINDEX[ARRAYINDEX] = CODEBLK; 
              ARRAYINDEX = ARRAYINDEX + 1;
              REGCNT[VIRTUAL(TABLETYPE"ASMSEQ$",REGSEQ)] = 0; 
              REGSEQ = REGSEQ + 1;
              OTEXTOC[ARRAYINDEX] = S"STARTSEQ";
              OTEXTCONST[ARRAYINDEX] = REGSEQ;
              ARRAYINDEX = ARRAYINDEX + 1;
              RELOCUL(0, DDBLK1, TABLETYPE"USEORG$",
                         DDBLK2, TABLETYPE"USEORG$" );
              END 
          OTEXTWRITE(ARRAYINDEX);  #CLEAR OUT BUFFER# 
          TMRECL(TABLETYPE"DNT$");
          TMRECL(TABLETYPE"NAMET$");
          RETURN;   #GO BACK TO MAIN OVERLAY# 
          END #MAIN PROC# 
          TERM; 
