*DECK GENTEXT 
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TCEXEC
USETEXT   TSYMC5
      PROC GENTEXT; 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   G E N T E X T                                          #
#                                                                      #
#     GENERATE A SYMPL TEXT RECORD AND WRITE IT TO THE B=FILE          #
#     (UNLESS B=0).                                                    #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
*CALL COMEX 
*CALL TXTCOM
  
*CALL HASHCOM 
  
      DEF D023 #23#;               # DIAGNOSTIC 23                     #
  
      $BEGIN
      DEF STDUMP #35#;             # INTOPS BIT FOR SYMBOL TABLE DUMP  #
      $END
  
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC WITH SYMBOL      #
      XREF PROC DIAG0;             # ISSUE DIAGNOSTIC                  #
      XREF PROC PTLSTV;            # PRINT A LINE ON THE L=FILE        #
      XREF PROC SYMABT;            # ISSUE DIAGNOSTIC AND ABORT        #
      XREF  ITEM EXCODE    B;      # INDICATES PRESENCE OF EXECUTABLE  #
                                   # CODE ON IL.  FROM PHASE10         #
  
  
      $BEGIN
      XREF PROC BINOCT;            # BINARY TO OCTAL DISPLAY CODE CONV #
      $END
  
      ITEM DONE         B;         # BOOLEAN TEMP                      #
      ITEM H            I;         # TEMP                              #
      ITEM GLOBAL       C(10) = "(GLOBAL)";  # (GLOBAL) NAME           #
      ITEM I            I;         # TEMP                              #
      ITEM INDX         I;         # TEMP INDEX OF SYM TAB ENTRY       #
      ITEM J            I;         # TEMP                              #
      ITEM K            I;         # TEMP                              #
      ITEM SAVEPPTR     I = 0;     # SYM TAB INDX OF S"PROG" OR S"PROC"#
      ITEM SAVENPTR     I = 0;     # AND S"NAME" OF S"PROG" OR S"PROC" #
      ITEM TTLENGTH     I;         # TEXT TABLE LENGTH                 #
  
      ARRAY RECHEAD [0:0] S(3);    # SYMPL TEXT NAME HEADING           #
        BEGIN 
        ITEM RECHEAD1     C(00,00,20) = [" TEXT RECORD NAME = "];  #HDR#
        ITEM RECNAME      C(02,00,10);   # RECORD NAME                 #
        END 
  
      ARRAY [0:4] S(1); 
        BEGIN 
        ITEM SAVEP I(00,00,60);    # SAVE S"PROG" OR S"PROC" ENTRY     #
        END 
  
      ARRAY [0:2] S(1); 
        BEGIN 
        ITEM SAVEN I(00,00,60);    # SAVE S"NAME" OF S"PROG" OR S"PROC"#
        END 
  
      $BEGIN
      ITEM DBUG1 C(40) = " TTORIGIN=           TTLENGTH=";
                                   # DEBUG MESSAGE PRINTED IF *=9      #
      $END
      CONTROL EJECT;
  
      PROC EDTEXT;
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   E D T E X T                                            #
#                                                                      #
#     UNLESS B=0 OR MEL GQ FATAL, EDTEXT PLACES THE ASCM TABLE HEADER  #
#     AND THE TEXT TABLE ORIGIN AND LENGTH DESCRIPTOR INTO THE SYMPL   #
#     TEXT AND CALLS WTEXT TO WRITE THE TEXT RECORD ONTO THE B=FILE.   #
#     SYMBOL TABLE ENTRIES NOT INCLUDED IN THE TEXT RECORD BUT         #
#     REQUIRED BY MAP AND CROSS REFERENCE PROCESSING ARE RESTORED.     #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      XREF ITEM MEL S:QERLEV;      # MAXIMUM ERROR LEVEL               #
      XREF ITEM PRFX;              # PRFX TABLE (IN INIT14)            #
      XREF PROC PNAM;              # POST S"NAME" SYMBOL TABLE ENTRY   #
      XREF PROC WST;               # WRITE STEXT ROUTINE (IN INIT14)   #
  
      STATUS TAB TEXT,PRFX,TCTL;   # STEXT TABLE TYPES                 #
  
      ITEM ASCM I = O"50000102000000000000";  # ASCM TABLE HEADER      #
      ITEM GLOLOC I;                   # INDX OF (GLOBAL) S"NAME" ENTRY#
  
  
      TTLENGTH = NXTAV - TTORIGIN; # ESTABLISH THE TEXT TABLE          #
      TTLEN = TTLENGTH;            # ORIGIN AND LENGTH                 #
      TTORIG = TTORIGIN;           # DESCRIPTOR                        #
  
      IF B<59-"B">OPTION NQ 0      # IF B"0 AND NO FATAL ERRORS HAVE   #
        AND MEL LS S"FATAL"        # OCCURRED.                         #
      THEN
        BEGIN 
        I = SYM0[TTORIGIN];        # THE ASCM TABLE HEADER AND         #
        J = SYM0[TTORIGIN + 1];    # THE TTOL DESCRIPTOR TEMPORARILY   #
        SYM0[TTORIGIN] = ASCM;     # REPLACE TWO SYMBOL TABLE WORDS    #
        SYM0[TTORIGIN + 1] = TTOL; # AT INDEX TTORIGIN                 #
  
        WST (PRFX,L$PRFX,TAB"PRFX");   # WRITE PRFX TABLE TO B=FILE    #
        WST (ZSYM[TTORIGIN],TTLENGTH,TAB"TEXT");  # WRITE TEXT TABLE   #
        WST (TCT[0],L$TCT,TAB"TCTL");  # WRITE TEXT CONTROL TABLE      #
  
        SYM0[TTORIGIN] = I;        # RESTORE THE TWO SYMBOL TABLE      #
        SYM0[TTORIGIN + 1] = J;    # WORDS AT INDEX TTORIGIN           #
        END 
  
      IF SAVEPPTR NQ 0             # UNLESS S"PROG" OR S"PROC"         #
      THEN                         # WAS NOT SAVED                     #
        BEGIN 
        CONTROL FASTLOOP; 
        FOR I = 0 STEP 1           # RESTORE S"PROG" OR S"PROC" ENTRY  #
          UNTIL PROC$W - 1
        DO
          BEGIN 
          SYM0[SAVEPPTR + I] = SAVEP[I];
          END 
        CONTROL SLOWLOOP; 
          SCPN[0] = SAVEPPTR;      # RESET SCPN[0]                     #
        END 
  
      IF SAVENPTR GR 0             # IF SAVENPTR GR 0, RESTORE         #
      THEN                         # S"NAME" OF S"PROG" OR S"PROC"     #
        BEGIN 
        FOR I = 0 STEP 1
          WHILE SAVEN[I] NQ 0 
            AND I LS 3
        DO
          BEGIN 
          SYM0[SAVENPTR + I] = SAVEN[I];
          END 
        J = INAM[SAVENPTR];        # REENTER S"NAME" IN HLNK CHAIN     #
        H = STHASH( J );
        FOR I = H 
          WHILE HLNK[I] NQ 0
        DO
          BEGIN 
          I = HLNK[I];
          END 
        HLNK[I] = SAVENPTR; 
        HLNK[SAVENPTR] = 0; 
        NLNK[SAVEPPTR] = SAVENPTR;  # RESET NLNK OF S"PROG" OR S"PROC" #
        END 
  
      IF SAVENPTR LS 0             # IF NEGATIVE SAVENPTR, SET NLNK    #
      THEN                         # FOR S"PROG" OR S"PROC"            #
        BEGIN 
        NLNK[SAVEPPTR] = NLNK[-SAVENPTR]; 
        NLNK[-SAVENPTR] = SAVEPPTR; 
        END 
  
      PNAM (GLOBAL,8,GLOLOC);      # REPOST (GLOBAL) S"NAME" ENTRY AND #
      SCPN[1] = GLOLOC;            # RESET THE SCOPE NAME TABLE        #
                                   # GLOBAL LEVEL ENTRY                #
  
  
      END 
      CONTROL EJECT;
  
      PROC GENTCT;
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   G E N T C T                                            #
#                                                                      #
#     GENERATE THE TEXT CONTROL TABLE.                                 #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      TCT$L = L$TCT;               # FIRST WORD OF TCT = L$TCT         #
  
  
      CONTROL FASTLOOP; 
      FOR I = 0 STEP 1             # ESTABLISH TCT HLNK VALUES         #
        UNTIL L$HASH               # IN THE TCT HASH TABLE             #
      DO
        BEGIN 
        DONE = FALSE; 
  
        CONTROL SLOWLOOP; 
        FOR J = I                  # SET TCTHASH ENTRY TO FIRST        #
          WHILE HLNK[J] NQ 0       # SYMBOL TABLE HLNK GQ TTORIGIN     #
            AND NOT DONE           # UNLESS NO SUCH HLNK OCCURS.....   #
        DO
          BEGIN 
          IF HLNK[J] GQ TTORIGIN
          THEN
            BEGIN 
            TCTHASH[I] = HLNK[J]; 
            DONE = TRUE;
            END 
          ELSE
            BEGIN 
            J = HLNK[J];
            END 
          END 
  
        IF NOT DONE                # IN WHICH CASE SET IT TO ZERO      #
        THEN
          BEGIN 
          TCTHASH[I] = 0; 
          END 
        HLNK[I] = TCTHASH[I];      # TCTHASH REPLACES SYM TAB HASH     #
        END 
  
  
      FOR I = SPLC                 # SET TCTSPLC TO THE INDEX OF       #
        WHILE ASEQ[I] LS TTORIGIN  # THE FIRST SLC AT OR ABOVE         #
          AND ASEQ[I] NQ 0         # TTORIGIN, OR ZERO IF NO           #
      DO                           # SUCH SLC OCCURS                   #
        BEGIN 
        I = ASEQ[I];
        END 
      TCTSPLC[0] = ASEQ[I]; 
  
  
      IF XPLC GQ TTORIGIN          # SET TCTXPLC TO XPLC IF XPLC       #
      THEN                         # GQ TTORIGIN, ELSE ZERO            #
        BEGIN 
        TCTXPLC[0] = XPLC;
        END 
      ELSE
        BEGIN 
        TCTXPLC[0] = 0; 
        END 
  
  
      IF ESPLC GQ TTORIGIN         # SET TCTESPLC TO ESPLC IF ESPLC    #
      THEN                         # GQ TTORIGIN, ELSE ZERO            #
        BEGIN 
        TCTESPLC[0] = ESPLC;
        END 
      ELSE
        BEGIN 
        TCTESPLC[0] = 0;
        END 
  
  
      IF NONAM GQ TTORIGIN         # SET TCTNONAM TO NONAM IF NONAM    #
      THEN                         # GQ TTORIGIN, ELSE ZERO            #
        BEGIN 
        TCTNONAM[0] = NONAM;
        END 
      ELSE
        BEGIN 
        TCTNONAM[0] = 0;
        END 
  
  
      FOR I = BABY[DPLC]           # SET TCTBABY TO THE INDEX OF THE   #
        WHILE I LS TTORIGIN        # FIRST ENTRY ON THE DATA SLC BABY  #
          AND I NQ 0               # CHAIN WHOSE INDEX IS GQ TTORIGIN, #
      DO                           # OR ZERO IF NO SUCH ENTRY OCCURS   #
        BEGIN 
        I = ASEQ[I];
        END 
      TCTBABY[0] = I; 
  
  
      IF LENT[DPLC] GQ TTORIGIN    # SET TCTLENT TO LENT OF DATA SLC   #
      THEN                         # IF THAT IS GQ TTORIGIN, ELSE ZERO #
        BEGIN 
        TCTLENT[0] = LENT[DPLC];
        END 
      ELSE
        BEGIN 
        TCTLENT[0] = 0; 
        END 
  
  
      END 
      CONTROL EJECT;
  
      PROC GENTT; 
  
      BEGIN                        # GENTT                             #
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   G E N T T                                              #
#                                                                      #
#     GENERATE THE TEXT TABLE FROM THE SYMBOL TABLE.                   #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      DEF BPC #6#;                 # BITS PER CHARACTER                #
      DEF BPW #60#;                # BITS PER WORD                     #
      DEF CPW #10#;                # CHARACTERS PER WORD               #
      DEF L$SIN #42#;              # BITLENGTH OF SYSTEM INTERFACE NAME#
      DEF NULL #0#;                # USED TO NULLIFY SYM TAB ENTRIES   #
      DEF SCOPE$OK #2#;            # ACCEPTABLE SBEG FOR TEXT VARIABLES#
  
      DEF D002   #2#;              # DIAGNOSTIC   2                    #
      DEF D011  #11#;              # DIAGNOSTIC  11                    #
      DEF D023  #23#;              # DIAGNOSTIC  23                    #
      DEF D028  #28#;              # DIAGNOSTIC  28                    #
      DEF D045  #45#;              # DIAGNOSTIC  45                    #
      DEF D047  #47#;              # DIAGNOSTIC  47                    #
      DEF D058  #58#;              # DIAGNOSTIC  58                    #
      DEF D156 #156#;              # DIAGNOSTIC 156                    #
      DEF D167 #167#;              # DIAGNOSTIC 167                    #
      DEF J868 #868#;              # DIAGNOSTIC 868                    #
  
      XREF ITEM TXTNAME;           # TEXT NAME IN PRFX TABLE (INIT14)  #
      XREF FUNC GET;               # GET SPACE FOR NEW SYM TAB ENTRY   #
      XREF PROC FIND;              # FIND SYMBOL TABLE S"NAME"         #
  
      ITEM BLANK        C(1) = " ";  # ONE BLANK CHARACTER             #
      ITEM L            C(CPW);    # CHARACTER TEMP                    #
      ITEM NI           I;         # NEW INDEX OF S"NAME" ENTRY        #
      ITEM OI           I;         # OLD INDEX OF S"NAME" ENTRY        #
      ITEM TEMPNAME     C(CPW);    # TEMP FOR TEXT NAME                #
  
  
      SWITCH GENSCAN:QCLAS
        GEN10: NAME,
        GEN02: DATA,
        GEN02: TABL,
        GEN02: CONS,
        GEN02: TEMP,
        GEN03: LABL,
        GEN02: PROC,
        GEN02: FUNC,
        GEN04: SWCH,
        GEN10: EMPT,
        GEN07: DUMY,
        GEN10: PROG,
        GEN08: DEF ,
        GEN08: SLC ,
        GEN10: INSC,
        GEN11: BPAR,
        GEN02: TITM,
        GEN08: SCON,
        GEN08: COMM,
        GEN01: FPAR,
        GEN08: STSL,
        GEN10: ADCN,
        GEN10: SNAM,
        GEN10: DTXT;
      CONTROL EJECT;
  
      PROC DELNAME; 
  
      BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   D E L N A M E                                          #
#                                                                      #
#     DELETE S"NAME" ENTRY FROM SYMBOL TABLE.                          #
#                                                                      #
#     ASSUMES OI = INDEX OF S"NAME" ENTRY TO BE DELETED.               #
#     USES GENTEXT TEMPS H, I, AND J.                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      I = INAM[OI]; 
      H = STHASH( I );
      FOR J = H 
        WHILE HLNK[J] NQ OI        # REMOVE S"NAME"[OI] FROM HLNK CHAIN#
      DO
        BEGIN 
        J = HLNK[J];
        END 
      HLNK[J] = HLNK[HLNK[J]];
  
      CONTROL FASTLOOP; 
      FOR J = 0 STEP 1             # NULLIFY S"NAME" ENTRY             #
        UNTIL (NCHR[OI] - 1) / CPW + 1
      DO
        BEGIN 
        SYM0[OI + J] = NULL;
        CLAS[OI + J] = S"EMPT"; 
        END 
      CONTROL SLOWLOOP; 
  
  
      END 
      CONTROL EJECT;
      PROC ENSCONS; 
      BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   E N S C O N S                                          #
#                                                                      #
#     ENSURE THAT S"CONS" ENTRIES NEEDED BY SOME ENTRY IS ABOVE        #
#     TTORIGIN.  IF THE S"CONS" ENTRY IS NOT ABOVE TTORIGIN, MOVE IT   #
#     AND CALL ENSNAME TO BRING ALONG THE NAME.  IF THE POINTER IS 0,  #
#     OR THE S"CONS" IS ABOVE TTORIGIN, WE RETURN.  IF THE ENTRY       #
#     POINTED TO IS QCLAS"EMPT", THEN THE S"CONS" HAS ALREADY BEEN     #
#     MOVED AND THE NLNK POINTS TO THE NEW S"CONS".                    #
#                                                                      #
#     ASSUMES OI = OLD INDEX OF S"CONS" ENTRY                          #
#     SETS    NI = NEW INDEX                                           #
#     USES TEMPS H, I, J, K    CALLS ENSNAME                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      IF  OI EQ 0                  # FIELD DOESN'T POINT TO A CONS     #
        OR  OI GR TTORIGIN         # CONS GOES ALONG ANYWAY            #
      THEN
        BEGIN 
        NI = OI;
        END 
      ELSE
        BEGIN 
        IF  CLAS[OI] EQ S"EMPT" 
        THEN                       # ALREADY MOVED                     #
          BEGIN 
          NI = NLNK[OI];
          END 
        ELSE
          BEGIN 
          K = INDX;                # ENSURE NAME IS INCLUDED           #
          INDX = OI;               # ENSNAME WANTS INDX TO BE THE CONS #
          ENSNAME;
          OI = INDX;
          INDX = K; 
          K = NI;                  # SAVE PTR TO NAME                  #
          NI = GET( CONS$W );      # GET SPACE                         #
          FOR I = 0  STEP 1 
            UNTIL  CONS$W - 1 
          DO
            BEGIN 
            SYM0[ NI+I ] = SYM0[ OI+I ];
            SYM0[ OI+I ] = NULL;
            CLAS[ OI+I ] = S"EMPT"; 
            END 
          NLNK[OI] = NI;
          NLNK[K] = NI;            # LINK THE NAME TO THE NEW CONS     #
          END 
        END 
      END 
      CONTROL EJECT;
  
      PROC ENSNAME; 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   E N S N A M E                                          #
#                                                                      #
#     ENSURE THAT THE S"NAME" ENTRY FOR A GIVEN SYMBOL TABLE ATTRIBUTE #
#     ENTRY IS LOCATED ABOVE TTORIGIN.  IF THE S"NAME" ENTRY IS NOT    #
#     ABOVE TTORIGIN, MOVE IT TO THE END OF THE SYMBOL TABLE, AND      #
#     ADJUST NLNK AND HLNK POINTERS ACCORDINGLY.  IF IT IS ABOVE       #
#     TTORIGIN, JUST RETURN.                                           #
#                                                                      #
#     ASSUMES INDX = SYMBOL TABLE INDEX OF ATTRIBUTE ENTRY.            #
#     MAY SET OI = OLD INDEX OF S"NAME" ENTRY.                         #
#     MAY SET NI = NEW INDEX OF S"NAME" ENTRY.                         #
#     USES GENTEXT TEMPS H, I, AND J.                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      FOR I = NLNK[INDX]           # GET INDEX OF ENTRY                #
        WHILE I NQ INDX            # ON THE NLNK CHAIN                 #
      DO
        BEGIN 
        IF I LQ TTORIGIN           # AND VERIFY IT RELATIVE            #
          AND CLAS[I] EQ S"NAME"   # TO CLAS AND TTORIGIN              #
        THEN
  
  
          BEGIN 
          OI = I;                  # IT IS AN S"NAME" LQ TTORIGIN,     #
          J = (NCHR[OI] - 1) / CPW + 2;  # SO.....                     #
          NI = GET (J);            # NI = NEW INDEX FOR S"NAME"        #
  
          FOR J = INDX             # ADJUST NLNK CHAIN TO OSTRACIZE    #
            WHILE NLNK[J] GR TTORIGIN  # ANY ENTRIES THAT ARE AT OR    #
          DO                       # BELOW TTORIGIN                    #
            BEGIN 
            J = NLNK[J];
            END 
          NLNK[J] = NI; 
  
          J = INAM[OI]; 
          H = STHASH( J );
          FOR J = H 
            WHILE HLNK[J] NQ OI    # REPAIR THE HLNK CHAIN THAT        #
          DO                       # WAS BROKEN DURING THE MOVE        #
            BEGIN 
            J = HLNK[J];
            END 
          HLNK[J] = HLNK[HLNK[J]];
          FOR H = H 
            WHILE HLNK[J] NQ 0
          DO
            BEGIN 
            J = HLNK[J];
            END 
          HLNK[J] = NI; 
  
          CONTROL FASTLOOP; 
          FOR J = 0 STEP 1         # MOVE S"NAME" ENTRY TO NI          #
            UNTIL (NCHR[OI] - 1) / CPW + 1
          DO                       # AND NULLIFY THE OLD ONE AT OI     #
            BEGIN 
            SYM0[NI + J] = SYM0[OI + J];
            SYM0[OI + J] = NULL;
            CLAS[OI + J] = S"EMPT"; 
            END 
          CONTROL SLOWLOOP; 
  
          HLNK[NI] = 0; 
  
                                   # END OF PROCESS FOR                #
                                   # S"NAME" LS TTORIGIN               #
  
          I = INDX;                # TURN OFF FOR-LOOP TO              #
                                   # TRIGGER A RETURN                  #
          END 
  
  
        ELSE
  
  
          BEGIN 
          I = NLNK[I];             # GET INDEX OF NEXT ENTRY           #
          END 
  
        END 
                                   # AND LOOP BACK TO EXAMINE IT       #
  
      END 
      CONTROL EJECT;
  
#     G E N T T   E N T R Y                                            #
  
  
      INDX = BABY[CPLC];           # INDX = INDEX OF S"PROG" OR S"PROC"#
      FIND (INDX,OI);              # OI = S"NAME" OF S"PROG" OR S"PROC"#
      TEMPNAME = NAME[OI];         # TEMPNAME = NAME OF PRGM OR PROC   #
      TCTTNAME = TEMPNAME;         # TCTTNAME = NAME OF PRGM OR PROC   #
  
      RECNAME = TEMPNAME;          # ESTABLISH RECNAME FOR LISTING     #
      FOR I = L$SIN / BPC STEP 1
        UNTIL CPW - 1 
      DO
        BEGIN 
        C<I,1>RECNAME = BLANK;
        END 
      IF B<59 - "L">OPTION NQ 0    # IF LIST OPTION NQ ZERO            #
      THEN
        BEGIN 
        PRNTHDR;                   # PRINT TEXT GENERATION HEADER      #
                                   # AND TEXT RECORD NAME              #
        END 
  
      J = BPW - BPC;               # FORMAT TEXT NAME FOR PRFX TABLE   #
      DONE = FALSE; 
      FOR I = 1 STEP 1
        WHILE NOT DONE
      DO
        BEGIN 
        IF C<I,1>TEMPNAME EQ BLANK
          OR J EQ BPW - L$SIN 
        THEN
          BEGIN 
          B<I*BPC,J>TEMPNAME = 0; 
          DONE = TRUE;
          END 
        ELSE
          BEGIN 
          J = J - BPC;
          END 
        END 
      TXTNAME = TEMPNAME; 
  
      CONTROL FASTLOOP; 
      FOR J = 0 STEP 1             # CLEAR SAVEN                       #
        UNTIL 2 
      DO
        BEGIN 
        SAVEN[J] = 0; 
        END 
      CONTROL SLOWLOOP; 
  
  
      IF CLAS[INDX] NQ S"PROG"
        AND CLAS[INDX] NQ S"PROC" 
      THEN
  
        BEGIN 
        PRNTHDR;
        DIAG (D156,INDX);          # SYMPL TEXT IS NOT A PRGM OR PROC  #
        FOR I = INDX + PROC$W STEP 1  # TRUNCATE  ENTRY TO THE LENGTH  #
          UNTIL INDX + ENTRY$W[CLAS[INDX]] - 1  # OF AN S"PROC" AND    #
        DO                            # CONTINUE UNDAUNTED             #
          BEGIN 
          SYM0[I] = NULL; 
          CLAS[I] = S"EMPT";
          END 
        END 
                                   # TEMPORARILY REMOVE THE S"PROG"    #
                                   # OR S"PROC" AND, IF APPROPRIATE,   #
                                   # ITS S"NAME" ENTRY                 #
  
      ENSNAME;                     # ENSURE S"NAME" IS ABOVE TTORIGIN  #
  
      FIND (INDX,NI);              # NI = INDEX OF S"NAME"             #
  
      CONTROL FASTLOOP; 
      FOR J = 0 STEP 1             # SAVE S"NAME" ENTRY                #
        UNTIL (NCHR[NI] - 1) / CPW + 1
      DO
        BEGIN 
        SAVEN[J] = SYM0[NI + J];
        END 
      CONTROL SLOWLOOP; 
  
      IF NLNK[NI] EQ INDX          # IF S"NAME" IS UNIQUE TO           #
        AND NLNK[INDX] EQ NI       # S"PROG" OR S"PROC"                #
      THEN
        BEGIN 
        OI = NI ; 
        DELNAME;                   # DELETE S"NAME" FROM SYM TAB       #
        SAVENPTR = NI;             # SAVE SYM TAB INDEX OF S"NAME"     #
        END 
  
      ELSE                         # IF S"NAME" IS NOT UNIQUE TO       #
                                   # S"PROG" OR S"PROC"                #
        BEGIN 
        FOR I = NI                 # REMOVE S"PROG" OR S"PROC" FROM    #
          WHILE NLNK[I] NQ INDX    # ITS NLNK CHAIN                    #
        DO
          BEGIN 
          I = NLNK[I];
          END 
        NLNK[I] = NLNK[INDX]; 
  
        SAVENPTR = -NI;            # (EDTEXT WILL USE -SAVENPTR TO     #
                                   # RESET NLNK OF S"PROG" OR S"PROC") #
        END 
  
      NLNK[INDX] = LOC (SAVEN[0]);  # NLNK OF S"PROG" OR S"PROC"       #
                                    # POINTS TO COPY OF ITS S"NAME"    #
  
      CONTROL FASTLOOP; 
      FOR J = 0 STEP 1             # SAVE S"PROG" OR S"PROC" ENTRY     #
        UNTIL PROC$W - 1           # AND NULLIFY THE OLD ONE           #
      DO
        BEGIN 
        SAVEP[J] = SYM0[INDX + J];
        SYM0[INDX + J] = NULL;
        CLAS[INDX + J] = S"EMPT"; 
        END 
      CONTROL SLOWLOOP; 
  
      SCPN[0] = LOC (SAVEP[0]);    # SCPN[0] IS USED BY EJ1 IN PTLST TO#
                                   # FIND THE PROGRAM NAME             #
  
      SAVEPPTR = INDX;             # SAVE INDEX OF S"PROG" OR S"PROC"  #
  
                                   # THUS ENDS THE REMOVING OF         #
                                   # S"PROG" ET CETERA                 #
  
  
      C<8,1>GLOBAL = 0;            # APPEND ZERO CHAR TO (GLOBAL) NAME #
                                   # DELETE (GLOBAL) S"NAME" ENTRY     #
      L = GLOBAL; 
      H = STHASH( L );
      FOR I = I 
        WHILE HLNK[H] NQ 0         # (GLOBAL) S"NAME" IS THE LAST ENTRY#
      DO                           # ON ITS HLNK CHAIN                 #
        BEGIN 
        H = HLNK[H];
        END 
      OI = H;                      # OI = INDEX OF (GLOBAL) S"NAME"    #
      DELNAME;
  
  
      FOR K = SPLC                 # DELETE THE ADCON, CODE, AND       #
        WHILE K NQ 0               # DATA SLC S"NAME" ENTRIES AND      #
      DO                           # REPAIR THEIR HLNKS                #
        BEGIN 
        IF ESDC[K] EQ S"ADCN" 
          OR ESDC[K] EQ S"CODE" 
          OR ESDC[K] EQ S"DATA" 
        THEN
          BEGIN 
          OI = NLNK[K]; 
          DELNAME;
          END 
        K = ASEQ[K];
        END 
  
  
      IF XPLC NQ 0                 # MOVE XTRN S"SLC" TO ABOVE         #
        AND XPLC LS TTORIGIN       # TTORIGIN IF IT IS NOT THERE       #
        AND LENT[XPLC] GQ TTORIGIN  # ALREADY AND IS NEEDED            #
      THEN
        BEGIN 
  
        FOR I = BABY[XPLC]         # SET BABY OF XTRN S"SLC" TO INDEX  #
          WHILE I LS TTORIGIN      # OF FIRST ENTRY ON BABY/ASEQ       #
        DO                         # CHAIN ABOVE TTORIGIN              #
          BEGIN 
          I = ASEQ[I];
          END 
        BABY[XPLC] = I; 
  
        INDX = GET (SLC$W);        # INDX = NEW LOC FOR XTRN S"SLC"    #
  
        FOR I = SPLC               # REPAIR THE S"SLC" ASEQ CHAIN      #
          WHILE ASEQ[I] NQ XPLC 
        DO
          BEGIN 
          I = ASEQ[I];
          END 
        IF ASEQ[XPLC] EQ 0
        THEN
          BEGIN 
          ASEQ[I] = INDX; 
          END 
        ELSE
          BEGIN 
          ASEQ[I] = ASEQ[XPLC]; 
          END 
        ASEQ[ESPLC] = INDX; 
        ASEQ[XPLC] = 0; 
  
        CONTROL FASTLOOP; 
        FOR I = 0 STEP 1           # MOVE THE XTRN S"SLC"              #
          UNTIL SLC$W - 1          # TO ITS NEW LOCATION               #
        DO
          BEGIN 
          SYM0[INDX + I] = SYM0[XPLC + I];
          END 
        CONTROL SLOWLOOP; 
  
        FIND (XPLC,OI);            # LOCATE S"NAME" OF XTRN S"SLC"     #
        NLNK[INDX] = NLNK[OI];     # AND UPDATE THE NLNK CHAIN TO      #
        NLNK[OI] = INDX;           # INCLUDE THE NEW S"SLC" AT INDX    #
                                   # (ENSNAME MAY CHANGE THIS SHORTLY) #
  
        XPLC = INDX;               # RESET THE XPLC AND                #
        ESPLC = INDX;              # ESPLC POINTERS                    #
  
        END 
  
      IF XPLC GQ TTORIGIN          # IF NECESSARY, MOVE THE S"NAME"    #
      THEN                         # OF THE XTRN S"SLC" TO ABOVE       #
        BEGIN 
        INDX = XPLC;               # TTORIGIN (WHICH OSTRACIZES ANY    #
        ENSNAME;                   # OLD XTRN S"SLC" AND ALSO REPAIRS  #
        END 
                                   # NLNK AND HLNK CHAINS)             #
  
  
      FOR I = NONAM                # IF ANY PORTION OF THE             #
        WHILE NLNK[I] GQ TTORIGIN  # NONAM NLNK CHAIN EXTENDS          #
      DO                           # ABOVE TTORIGIN,                   #
        BEGIN 
        I = NLNK[I];
        END 
      IF I GQ TTORIGIN
      THEN
        BEGIN 
        NLNK[I] = NLNK[NONAM];     # PRESERVE THAT PORTION             #
        NONAM = I;                 # AND RESET SYM TABLE NONAM POINTER #
        END 
  
  
#     GENTT CONTINUES ON THE NEXT PAGE                                 #
      CONTROL EJECT;
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     THE NEXT PROCESS SECTION, WHICH IS CONTROLLED BY A STATUS SWITCH #
#     BASED ON QCLAS, SCANS THE SYMBOL TABLE ENTRY-BY-ENTRY, ISSUING   #
#     DIAGNOSTICS FOR ANY DECLARATIONS ENCOUNTERED THAT DO NOT QUALIFY #
#     FOR A SYMPL TEXT, AND ENSURING THAT EACH NAMED ATTRIBUTE ENTRY   #
#     HAS AN S"NAME" ENTRY ABOVE TTORIGIN.                             #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      FOR INDX = TTORIGIN 
        WHILE INDX LS NXTAV 
      DO
        BEGIN                      # SYMBOL TABLE SCAN                 #
  
        GOTO GENSCAN[CLAS[INDX]];  # SELECT PROCESS BASED ON CLAS      #
                                   # OF CURRENT SYMBOL TABLE ENTRY     #
          BEGIN 
  
GEN01:  
                                   # QCLAS FPAR                        #
          PRNTHDR;
          DIAG (D058,INDX);        # ISSUE DIAGNOSTIC 58               #
          GOTO GEN10; 
  
GEN02:  
                                   # QCLAS DATA, TABL, CONS, TEMP,     #
                                   # PROC,FUNC,TITM                    #
          IF XTRN[INDX] EQ S"ENT"  # IF XDEF.....                      #
          THEN
            BEGIN 
            PRNTHDR;
            DIAG (D011,INDX);      # ISSUE DIAGNOSTIC 11               #
            END 
          IF CLAS[INDX] EQ S"PROC"
            OR CLAS[INDX] EQ S"FUNC"
          THEN
            BEGIN 
            GOTO GEN05; 
            END 
          IF  (CLAS[INDX] EQ S"DATA"
              OR  CLAS[INDX] EQ S"TITM" ) 
            AND  SLLK[INDX] NQ 0
            AND  SLLK[INDX] LS TTORIGIN 
          THEN                     # INDX POINTS TO A STATUS ITEM      #
                                   # WHICH IS ASSOCIATED WITH A        #
                                   # LIST IN A USED TEXT               #
            BEGIN 
            OI = SLLK[INDX];
            IF  CLAS[OI] NQ S"STSL" 
            THEN                   # AN SNAM ENTRY EXISTS              #
              BEGIN 
              SLLK[INDX] = NLNK[OI];  # AND NLNK POINTS THERE          #
              END 
            ELSE                   # MAKE AN SNAM ENTRY                #
              BEGIN 
              FIND( OI, I );       # FIND THE NAME ENTRY               #
              J = (NCHR[I] - 1)/CPW + 2;
              NI = GET( J );       # GET SPACE FOR THE SNAM            #
              CLAS[NI] = S"SNAM"; 
              NCHR[NI] = NCHR[I]; 
              FOR  K = 1  STEP 1
                UNTIL  J - 1
              DO                   # COPY NAME TO SNAM                 #
                BEGIN 
                SYM0[NI + K] = SYM0[I + K]; 
                END 
  
              FOR  K = 0  STEP 1
                UNTIL  STSL$W - 1 
              DO                   # EMPTY THE STSL ENTRY              #
                BEGIN 
                SYM0[ OI + K ] = NULL;
                CLAS[ OI + K ] = S"EMPT"; 
                END 
              NLNK[OI] = NI;       # POINT TO THE SNAM                 #
              SLLK[INDX] = NI;     # POINT THE ITEM TO SNAM            #
              END 
            END 
  
          IF  CLAS[INDX] EQ S"TABL" 
          THEN                     # ENSURE CONSTANT                   #
            BEGIN 
            OI = MCNS[ INDX ];
            ENSCONS;
            MCNS[INDX] = NI;
            END 
  
          GOTO GEN06; 
  
GEN03:  
                                   # QCLAS LABL                        #
          PRNTHDR;
          DIAG( D028,INDX );
          GOTO GEN10; 
  
GEN04:  
                                   # QCLAS SWCH                        #
          PRNTHDR;
          DIAG( D045,INDX );
          GOTO GEN10; 
  
GEN05:  
                                   # QCLAS PROC, FUNC                  #
          IF XTRN[INDX] EQ S"LOC"  # IF NOT XREF PROC.....             #
            OR XTRN[INDX] EQ S"ENT"    # OR XREF FUNC.....             #
          THEN
            BEGIN 
            PRNTHDR;
            DIAG (D002,INDX);      # ISSUE DIAGNOSTIC 2                #
            END 
          GOTO GEN08; 
  
GEN06:  
                                   # QCLAS DATA,TABL,CONS,TEMP,TITM    #
          IF SBEG[INDX] GR SCOPE$OK  # IF INNERSCOPE VARIABLE.....     #
          THEN
            BEGIN 
            PRNTHDR;
            DIAG (D047,INDX);      # ISSUE DIAGNOSTIC 47               #
            END 
          GOTO GEN08; 
  
GEN07:  
                                   # QCLAS DUMY                        #
          PRNTHDR;
          DIAG (D167,INDX);        # ISSUE DIAGNOSTIC 167              #
          GOTO GEN10; 
  
GEN08:  
                                   # QCLAS DATA, TABL, CONS, TEMP      #
                                   # LABL, PROC, FUNC, SWCH, DEF,      #
                                   # SLC, TITM, SCON, COMM, STSL       #
          ENSNAME;                 # ENSURE S"NAME" FOR CURRENT        #
                                   # ENTRY IS AT OR ABOVE TTORIGIN     #
          IF CLAS[INDX] NQ S"DEF" 
          THEN                     # AND SUBSELECT NEXT PROCESS        #
            BEGIN 
            GOTO GEN10; 
            END 
          GOTO GEN09; 
  
GEN09:  
                                   # QCLAS DEF                         #
          IF SPTR[INDX] LS TTORIGIN  # ENSURE THAT S"DTXT" FOR THIS    #
            AND SPTR[INDX] GR 1 
          THEN                       # S"DEF" IS ABOVE TTORIGIN        #
            BEGIN 
            IF CLAS[SPTR[INDX]] EQ S"EMPT"  # IF IT IS NOT, AND THE    #
            THEN                            # OLD S"DTXT" IS NULL      #
              BEGIN 
              SPTR[ INDX ] = NLNK[ SPTR[ INDX ]]; 
  
              END 
            ELSE                   # IF THE OLD S"DTXT" IS NOT NULL    #
                                   # MOVE IT TO ABOVE TTORIGIN, NULLIFY#
                                   # THE OLD ONE, WITH NLNK POINTING   #
                                   # TO THE NEW ENTRY                  #
              BEGIN 
              OI = SPTR[INDX];     # OI = INDEX OF OLD S"DTXT"         #
              I = (NCHR[OI] - 1) / BYTNDEFWD + 2;  # WORDLENGTH OF DTXT#
              J = I;
              NI = GET (J);        # NI = INDEX OF NEW S"DTXT"         #
              SPTR[INDX] = NI;     # RESET SPTR OF S"DEF"              #
              J = INAM[OI]; 
              H = STHASH( J );
              FOR J = H            # ADJUST HLNK CHAIN TO              #
                WHILE HLNK[J] NQ OI  # EXCLUDE THE OLD S"DTXT"         #
              DO                   # AND INCLUDE THE NEW ONE           #
                BEGIN 
                J = HLNK[J];
                END 
              HLNK[J] = HLNK[HLNK[J]];
              FOR H = H 
                WHILE  HLNK[J] NQ 0 
              DO
                BEGIN 
                J = HLNK[J];
                END 
              HLNK[J] = NI; 
              CONTROL FASTLOOP; 
              FOR J = 0 STEP 1     # MOVE OLD S"DTXT" TO ITS           #
                UNTIL I - 1        # NEW LOCATION AND                  #
              DO                   # NULLIFY THE OLD ONE               #
                BEGIN 
                SYM0[NI + J] = SYM0[OI + J];
                SYM0[OI + J] = NULL;
                CLAS[OI + J] = S"EMPT"; 
                END 
              CONTROL SLOWLOOP; 
              HLNK[NI] = 0;            # SET HLNK OF NEW S"DTXT"       #
              NLNK[NI] = NI;           # SET NLNK OF NEW S"DTXT"       #
              NLNK[ OI ] = NI;     # SET NLNK OF OLD TO NEW            #
              END 
            END 
          GOTO GEN10; 
  
GEN11:  
                                   # QCLAS BPAR                        #
          OI = BCOR[INDX];
          ENSCONS;
          BCOR[INDX] = NI;
          OI = DMPY[INDX];
          ENSCONS;
          DMPY[INDX] = NI;
          GOTO GEN10; 
  
GEN10:  
                                   # QCLAS (ALL)                       #
          IF CLAS[INDX] EQ S"NAME"  # UPDATE INDX AND LOOP BACK        #
            OR  CLAS[INDX] EQ S"SNAM" 
          THEN                      # TO PROCESS ANOTHER ENTRY         #
            BEGIN 
            INDX = INDX + (NCHR[INDX] - 1) / CPW + 2; 
            END 
          ELSE
            BEGIN 
            IF CLAS[INDX] EQ S"DTXT"
            THEN
              BEGIN 
              INDX = INDX + (NCHR[INDX] - 1) / BYTNDEFWD + 2; 
              END 
            ELSE
              BEGIN 
              INDX = INDX + ENTRY$W[CLAS[INDX]];
              END 
            END 
  
          END 
  
        END                        # SYMBOL TABLE SCAN                 #
  
  
      END                          # GENTT                             #
      CONTROL EJECT;
  
      PROC PRNTHDR; 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   P R N T H D R                                          #
#                                                                      #
#     PRINT SYMPL TEXT GENERATION HEADER AND TEXT NAME ON L=FILE.      #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      ITEM FIRSTCALL B = TRUE;     # FIRST-TIME-ONLY CONTROL FLAG      #
  
  
      IF FIRSTCALL
      THEN
        BEGIN 
        FIRSTCALL = FALSE;         # TURN OFF PRNTHDR FOR              #
                                   # SUBSEQUENT CALLS                  #
        PTLSTV ("0SYMPL TEXT GENERATION",3);  # PRINT HEADER           #
        PTLSTV (RECHEAD,3);                   # PRINT TEXT NAME        #
        END 
  
      END 
      CONTROL EJECT;
  
  
#     G E N T E X T   E N T R Y                                        #
  
  
      GENTT;                       # GENERATE TEXT TABLE               #
  
      IF  EXCODE                   # IF EXECUTABLE CODE                #
      THEN
        BEGIN 
        PRNTHDR;
        DIAG0 (D023);              # ISSUE DIAGNOSTIC 23               #
        END 
  
      GENTCT;                      # GENERATE TEXT CONTROL TABLE       #
  
      EDTEXT;                      # EDIT TEXT AND WRITE TEXT RECORD   #
                                   # TO B=FILE (UNLESS B=0)            #
  
        $BEGIN
        IF B<STDUMP>INTOPS EQ 1    # SYMBOL TABLE DUMP                 #
        THEN                       # PLUS TTORIGIN AND TTLENGTH        #
          BEGIN 
          PRNTHDR;
          BINOCT (DBUG1,10,TTORIGIN,6); 
          BINOCT (DBUG1,30,TTLENGTH,6); 
          PTLSTV (DBUG1,4); 
          SDUMP (3);
          END 
        $END
  
  
      END 
      TERM
