*DECK TBLPROC 
USETEXT CCTTEXT 
PROC TBLPROCS;
  BEGIN 
  CONTROL PACK; 
  # THIS ROUTINE HAS ALL THE TABLE HANDLING ROUTINES FOR
    SUCH TABLES AS THE PNT,DNT,PLT,AWRT.  EACH ROUTINE HAS
    A UNIQUE ENTRY POINT. THE ONLY TABLES OR TEXTS WHICH
    ARE NOT BUILT OR USED HERE ARE THE CTEXT AND THE CCT
    (USED IN INTERPRETTER) AND THE ETEXT(BUILT BY THE 
    INTERCEPTOR ROUTINE). # 
  
  
      # DEFINE SOME USEFUL MACROS # 
      ITEM DUMMYQQZZ1;
      DEF ASLONGAS #FOR DUMMYQQZZ1=0 WHILE#;
      DEF DOFOREVER # FOR DUMMYQQZZ1=0 DO #;
      DEF TFL #TLEVEL[STACKPTR]#; 
      DEF SFL #SLEVEL[STACKPTR]#; 
  
  XREF ITEM QUOTE C(1); # REAL QUOTE MARK # 
  
    # DECLARE ITEMS WHICH CLASSIFIER SETS UP TO DESCRIBE
      THE TOKEN WHICH IT HAS ASSEMBLED
    # 
    XREF
      BEGIN 
        ITEM CLATYPE I, # TYPE OF TOKEN # 
             CLAVALUE I, # VALUE OF TOKEN RETURNED IF APPLIC.#
             CLACOLUMN I, # COLUMN NUMBER OF FIRST CHAR IN TOKEN# 
             CLALINE I;  #  LINE NUMBER OF FIRST CHAR IN TOKEN #
        ARRAY STRINGAREA [0:25]; # TO HOLD CHARACTER STRINGS #
          ITEM SAREA C (0,0,10); # 1ST CHAR. IS IN SAREA[0] # 
        ITEM SAREALENGTH I; # LENGTH OF STRING IN STRINGAREA #
        ITEM SIGNSW B; # SHOWS IF LITERAL IS SIGNED # 
      END 
  
  
    # DECLARATION OF ITEMS SET UP BY INTERPRETTER # 
    XREF
      BEGIN 
        ITEM FILLERSWITCH B, # INDICATES DEFN. WAS "FILLER" # 
             CURRENTDIV   U; # INDICATES CURRENT SOURCE DIVISION #
        ITEM LASTFD       U, # LAST FD SEEN # 
             LASTRD       U, # LAST RD SEEN # 
             FDLINAGE     U, # LAST FD WITH LINAGE CLAUSE # 
             FDLINAMBIG   B; # IF MORE THAN 1 FD WITH LINAGE #
        ITEM DCLSWITCH    B; # INDICATES IF IN DECLARATIVES # 
      END 
  
    # DEFINITION OF DIVISION ORDINALS # 
    DEF IDENTDIV         #1#; 
    DEF ENVIRDIV         #2#; 
    DEF DATADIV          #3#; 
    DEF REPORTSEC        #4#; 
    DEF PROCDIV          #5#; 
  
  # EXTERNAL ROUTINES CALLED BY THE MODULE #
  XREF
    BEGIN 
      PROC DISPLAY; 
      PROC INTERCEPTOR; #ISSUES DIAGNOSTICS#
      PROC OUTPUT;
      FUNC DEC C(10); 
      PROC TMFIXSZ; 
      PROC TMSETRO; 
      FUNC HASHNM U;
      FUNC HASH U;
      ITEM SSGRPID; 
      PROC SSDIAGS; 
              PROC SETPLST; 
              FUNC CMM$ALV; 
      FUNC VIRTUAL U; # ENSURES ENTRY IS IN MEMORY #
    END 
  XDEF
      BEGIN 
      PROC  ALTERLIT; 
      PROC  AWRTBUILD;
      PROC  AWRTRESOLVE;
      PROC  CORRESOLVE; 
      PROC  CRLITATOM;
      PROC  DECLPNT;
      PROC  DNTBUILD; 
      PROC  DNTEXTRA; 
      PROC  DNTSCP; 
      PROC  FINDPAIR; 
      PROC  INITFINDPAIR; 
      PROC  INITTBLPROCS; 
      PROC  PLTBUILD; 
      PROC  PNATBUILD;
      PROC  PNTBUILD; 
      PROC  PNTNAME;
      PROC  REDEFRESOLVE; 
      PROC  SPBTBUILD;
      PROC  STORALLPROCS; 
      PROC  STOREPRGID; 
      END 
  
  
  # DEFINITIONS OF DIAGNOSTICS ISSUED IN THIS PROCEDURE                #
  
    DEF D1021 #021#;
    DEF D1022 #022#;
    DEF D1036 #036#;
    DEF D1037 #037#;
    DEF D1038 #038#;
    DEF D1048 #048#;
    DEF D1050 #050#;
    DEF D1053 #053#;
    DEF D1059 #059#;
    DEF D1060 #060#;
    DEF D1061 #061#;
    DEF D1062 #062#;
    DEF D1063 #063#;
    DEF D1064 #064#;
    DEF D1065 #065#;
    DEF D1066 #066#;
    DEF D1067 #067#;
    DEF D1068 #068#;
    DEF D1069 #069#;
    DEF D1070 #070#;
    DEF D1071 #071#;
    DEF D1072 #072#;
    DEF D1073 #073#;
    DEF D1074 #074#;
    DEF D1093 #093#;
    DEF D1095 #095#;
    DEF D1401 #401#;
  
  # TABLE ACCESS CODES AND INDICIES # 
  
*CALL TABLETYP
  DEF VMPNAT #TABLETYPE"PNAT$"#;
  DEF VMPLAT #TABLETYPE"PLT$"#; 
  DEF VMPLST #TABLETYPE"PLTSTR$"#;
  DEF VMAWRT #TABLETYPE"AWRT$"#;
  DEF VMINT  #TABLETYPE"INT$"#; 
  DEF VMSPBT #TABLETYPE"SPBT$"#;
  DEF VMDNT  #TABLETYPE"DNT$"#; 
  DEF VMPNT  #TABLETYPE"PNT$"#; 
  DEF  VMNAMET #TABLETYPE"NAMET$"#; 
  
  ITEM REALPLT      U,
       REALAWRT     U,
       REALINT      U,
       REALSPBT     U,
       REALDNT      U,
       REALPNT      U;
#      PLT STRINGS POINTERS FOR FIGURATIVE CONSTANTS   #
          ITEM  PLTSTRHIVAL;
          ITEM  PLTSTRLOVAL;
          XDEF  ITEM  PLTSTRQUOTE;
          ITEM  PLTSTRSPACE;
          ITEM  PLTSTRZERO; 
  
  # INDEBUG IS USED TO ACTIVATE TRACE OUTPUT #
  $BEGIN
  XREF
    ITEM INDEBUG B; 
  $END
  
    XDEF
      BEGIN 
        ITEM LEVELNUMVALU U; # LEVEL NUMBER # 
        ITEM AWRTNEXT U = 1; # NEXT FREE AWRT ENTRY # 
        ITEM DNTNEXT U = 1;  # NEXT FREE DNT ENTRY #
        ITEM INTNEXT U = 0;  # NEXT FREE INT ENTRY #
        ITEM PNTNEXT U = 1;  # NEXT FREE PNT ENTRY #
        ITEM PLTNEXT U = 1;  # NEXT FREE PLT ENTRY #
        ITEM PLSTNEXT U=1;  # NEXT FREE PLTST ENTRY # 
        ITEM SPBTNEXT U = 1; # NEXT FREE SPBT ENTRY # 
        ITEM INTINDEX U = 0; # CURRENT INT INDEX #
        ITEM PICCOUNT U = 0; # CURRENT PAT POINTER #
        ITEM SEGNUMBER U; # SEGMENT NUMBER #
        ITEM SECTSWITCH B; # INDICATES IF SECT. OR PARA. DEFN # 
        ITEM USEFORDEBUG B; # INDIC. IF PROC-NAME IS IN "USE FOR
                              DEBUGGING" SECTION. # 
        ITEM CODEAWRT U; # AWRT ENTRY CODE #
        ITEM QUALAWRT U;
        ITEM IMMEAWRT U;
        ITEM SREGAWRT U;
      END 
  
*CALL RW
*CALL DNT 
*CALL PNT 
*CALL UNQSTATUS 
*CALL PNAT1 
*CALL INT1
*CALL SPBT1 
*CALL PLTVALS 
*CALL PLT1
*CALL AWRT
*CALL TABLEDF 
*CALL,ASSEMOP 
 CONTROL IFNQ CB5$CDCS,"NO";
*CALL,HASHTAB 
 CONTROL FI;
  
  #TABLE IDENTIFICATION DEFS# 
  DEF USEAWRT #0#;
  DEF USEPNT  #1#;
  DEF USEDNT  #2#;
  
  # TABLE INDEX INCREMENT AND DECREMENT DEFS #
  DEF GETAWRTENTRY #AWRTPTR = AWRTPTR + 1#; 
  DEF GETPREVAWRT  #AWRTPTR = AWRTPTR - 1#; 
  DEF REWINDAWRT1  #BEGIN GETPREVAWRT;
                    ASLONGAS AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 
                    DO GETPREVAWRT; END#; 
  DEF GETNEXTINT   #INTNEXT = INTNEXT + 1#; 
  DEF NEXTSTRENTRY #PLSTNEXT#;
  DEF GETNEXTSTR   #PLSTNEXT = PLSTNEXT + 1#; 
  DEF GETNEXTDNT   #DNTNEXT = DNTNEXT + 1#; 
  DEF GETNEXTPNT   #PNTNEXT = PNTNEXT + 1#; 
  DEF GETNEXTAWRT  #AWRTNEXT = AWRTNEXT + 1#; 
  DEF GETNEXTPLT   #PLTNEXT = PLTNEXT + 1#; 
  DEF GETNEXTSPBT  #SPBTNEXT = SPBTNEXT + 1#; 
  
CONTROL INERT;    # ALL ARRAYS AFTER THIS ARE INERT AND DISJOINT #
CONTROL DISJOINT; 
  XDEF
    BEGIN 
  
      ARRAY LISTINTNAMES [0:2]; 
        ITEM LISTNAME U(0,0,60);  # INTERNAL NAME TO BE PUT IN THE
                                    LISTING LINE #
      ITEM  INTLISTPTR  U=0;  #POINTS TO LAST ENTRY IN LIST            #
  
  # DNTLEVELS TRANSLATES FROM THE CTEXT LEVEL TO THE LEVEL USED 
    BY THE DNTBUILD ROUTINE TO DETERMINE WHEN GROUPS END #
  
    ARRAY    DNTLEVELS    [0:9]    S(2);
      BEGIN 
        ITEM DNTLEVEL1 U(0,0,60) =[1,66,77,88,51,52,53,54,56,55 ];
        ITEM DNTLEVEL2 U(1,0,60) =[1,52,50,51, 0, 0, 0, 0,53,54 ];
      END 
      # NOTE THAT THE 1ST ENTRY IN DNTLEVEL2 IS CHANGED TO A 0
       WHEN IN WORKING-STORAGE OR LINKAGE SECTIONS #
  
    END # OF XDEF # 
  
  ITEM BIGHASH U;  # HOLDS 30 BIT HASH #
  ITEM NBRWORDS U;  # HOLDS NBR OF WORDS IN NAME #
  ITEM NAMETPTR U;  # POINTER TO NAME TABLE # 
*CALL NAMET 
  ITEM HASHVALUE U; # HOLDS LAST CALCULATED HASH VALUE #
  ITEM CURRENTLEVEL U; # HOLDS LEVEL OF NEW DNT ENTRY # 
  ITEM CURINTNAME   U; # HOLDS DNT INDEX OF NEW DNT ENTRY # 
  ITEM SEARCHSTART  U; # HOLDS DNT INDEX OF START OF HASH CHAIN # 
  ITEM I,J,K,L;        # TEMPORARY VARIABLES #
  ITEM LASTGROUPIN  U; # HOLDS INT. NAME (DNT INDEX) OF LAST
                         OUTSTANDING GROUP .(TOP OF SCOPESTACK)#
  ITEM MATCH U; # HOLDS DNT PTR TO ENTRY WITH SAME NAME # 
  ITEM POINTTOMATCH U; # HOLDS ENTRY IN FRONT OF MATCH ON CHAIN#
  ITEM LASTSECTION U; # INT. NAME OF LAST SECTION SEEN #
  
 CONTROL IFEQ CB5$CDCS,"NO";
  ARRAY HASHDNTINDEX [0:127]; # HASHVALUE POINTS TO ENTRY IN HERE 
                                WHICH CONTAINS INT. NAMES # 
    BEGIN 
    ITEM DNTHASHPTR U(0,0,30);
    ITEM PNTHASHPTR U(0,30,30); 
    END 
 CONTROL FI;
  
  DEF SCOPEMAX # 50 #;
  ARRAY SCOPESTACK [0:SCOPEMAX] S(1);  # HOLDS INT. NAMES OF UNFINISHED 
                                   GROUP ITEMS AND THEIR LEVELS # 
    BEGIN 
      ITEM SCOPELEVEL I(0,0,30);
      ITEM SCOPEINTNAME I(0,42,18); 
    END 
  
  ITEM SCOPESP U;  # SCOPESTACK STACK POINTER # 
  
  # THE FOLLOWING DCL[S ARE FOR THE AWRTRESOLVE ROUTINE # 
  ITEM AWRTPTR U,    # INDEX INTO THE AWRT# 
       REFLINENUM U, # LINE NUM. OF START OF REF. IN AWRT#
       CODE U,       # CODE OF AWRT ENTRY # 
       HIT U,        # INT. NAME OF REFERENCE # 
       UNIQUEHIT B,  # INDICATES IF HIT IS UNIQUE # 
       RDAMBIG B,    # INDICATES IF MORE THAN 1 RD #
       PROCNAME B,   # INDICATES IF HIT IS A PROC NAME #
       IMPLNAME B,   # INDICATES IF HIT MIGHT BE AN IMPL-NAME # 
       LISTTOP U  ,  # POINTS TO TOP OF IDENT. IN LIST #
       LISTPTR U  ,  # INDEX INTO ARRAY LIST #
       MATCHCOUNT U, # NUMBER OF DEFINED NAMES IN IDENT.# 
       AWRTPDINDEX U;# INDEX OF FIRST PROC. DIV. AWRT ENTRY#
  
  DEF LIST #SCOPELEVEL#; # SCOPESTACK AND LIST ARE THE
                           SAME # 
  DEF LISTBOTTOM #SCOPEMAX#; # INDEX OF LAST ENTRY #
  
  # DEFINE ITEMS USED BY THE "CORRESPONDING" ROUTINES # 
  BASED ARRAY CORRSTACK [0:50]; 
    BEGIN 
      ITEM SSTACK I(0,0,18);
      ITEM SLEVEL U(0,18,12); 
      ITEM TLEVEL U(0,30,12); 
      ITEM TSTACK I(0,42,18); 
    END 
  
  ITEM SOURCE U, # HOLDS SENDING ITEM CURRENTLY BEING ROCESSED# 
       TARGET U, # HOLDS TARGET ITEM CURRENTLY BEING PROCESSED# 
        NOEMPTYSTACK B, # INDICATES IF STACK IS EMPTY#
       STACKPTR I; # INDICATES TOP OF CORRSTACK # 
  
  # ITEMS USED BY THE STOREALLPROCS AND CRLITATOM ROUTINES
    TO CONSTRUCT QUALIFIED VARIABLE NAME STRINGS #
  ITEM CHSTR   C(30); 
  ITEM CLENGTH I; 
  ITEM WORDFLAG         I;
  
  XDEF
    BEGIN 
      ITEM SPLINE U,  # THESE 4 DCL"S USED TO PASS INFO. TO THE 
                        SPBTBUILD ROUTINE FROM INTERPRETTER # 
           SPCOL U, 
           SPTYPE U,
           SPDNAT U;
    END 
  
  # DEFINE WORDS WHEREIN CHARACTER STRING NAMES ARE 
    STORED BY THE NAMEGET ROUTINE # 
CONTROL EJECT;
   PROC DNTDIAG ((DIAGNBR), (DNTVADR)); 
  
 #    OUTPUT A DIAGNOSTIC USING LINE AND COLUMN FROM DNT  # 
 #   INPUTS ARE DIAGNOSTIC NBR AND VIRTUALIZED DNT POINTER  # 
  
     BEGIN
     ITEM DIAGNBR;
     ITEM DNTVADR;
  
       INTERCEPTOR (DNTCOLUMN[DNTVADR], DNTLINE[DNTVADR], DIAGNBR, 0);
       RETURN;
     END
CONTROL EJECT;
   PROC PNTDIAG ((DIAGNBR), (PNTVADR)); 
  
 #   OUTPUT A DIAGNOSTIC USING LINE AND COLUMN FROM PNT # 
 #   INPUTS ARE DIAGNOSTIC NBR AND VIRTUALIZED PNT POINTER #
  
     BEGIN
     ITEM DIAGNBR;
     ITEM PNTVADR;
  
       INTERCEPTOR (PNTCOLUMN[PNTVADR], PNTLINE[PNTVADR], DIAGNBR, 0);
       RETURN;
     END
CONTROL EJECT;
   PROC RLDIAG ((DIAGNBR)); 
#    OUTPUTS A DIAGNOSTIC USING LINE OF REFLINENUM AND COL OF 0  #
  
     BEGIN
     ITEM DIAGNBR;
  
       INTERCEPTOR (0, REFLINENUM, DIAGNBR, 0); 
       RETURN;
     END
CONTROL EJECT;
  ARRAY NAMEARRAY [0:0] S(3); 
    BEGIN 
    ITEM W1  C(0,0,10); 
    ITEM W2  C(1,0,10); 
    ITEM W3  C(2,0,10); 
    END 
      CONTROL EJECT;
      FUNC COMPNAMES ((NAMETPTR), (LENGTH)) B;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *    COMPNAMES - FUNC WHICH COMPARES NAME IN W1, W2 AND W3 WITH NAME 
 *      IN NAME TABLE POINTED TO BY NAMETPTR. 
 *      ONLY COMPARES LENGTH WORDS. 
 *
 *    RETURNS TRUE IF EQUAL, FALSE IF NOT EQUAL 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
      BEGIN 
      ITEM NAMETPTR U;
      ITEM LENGTH   U;
  
      IF NAMET$CHARS[VIRTUAL(VMNAMET, NAMETPTR)] EQ W1
      THEN
        IF LENGTH GR 1
        THEN
          IF NAMET$CHARS[VIRTUAL(VMNAMET, NAMETPTR + 1)] EQ W2
          THEN
            IF LENGTH GR 2
            THEN
              IF NAMET$CHARS[VIRTUAL(VMNAMET, NAMETPTR + 2)] EQ W3
              THEN   # ALL EQUAL #
                COMPNAMES = TRUE;   # ALL EQUAL - RETURN TRUE # 
              ELSE
                COMPNAMES = FALSE;   # FIRST TWO EQUAL - LAST NOT # 
            ELSE
              COMPNAMES = TRUE;   # TWO WORDS AND BOTH EQUAL #
          ELSE
            COMPNAMES = FALSE;   # TWO WORDS AND SECOND NOT EQUAL # 
        ELSE
          COMPNAMES = TRUE;   # ONE WORD AND EQUAL #
      ELSE
        COMPNAMES = FALSE;  # ONE WORD AND NOT EQUAL #
      RETURN; 
      END 
CONTROL EJECT;
  
  PROC NAMEGET ((TABLE), (INDEX));
    #THIS ROUTINE GIVEN A TABLE AND AN INDEX RETURNS THE
     CHARACTER STRING OF AN ITEMS NAME IN W1,W2 AND W3.#
  
    ITEM TABLE U, #INDICATES AWRT,PNT OR DNT# 
         INDEX U; #INDEX INTO TABLE#
  
    BEGIN 
      #DECIDE TABLE AND ACCESS THE NAME#
      IF TABLE EQ USEAWRT THEN
        BEGIN 
        REALAWRT = VIRTUAL(VMAWRT,INDEX); 
        W1 = AWR1ST10CHAR[REALAWRT];
        W2 = AWR2ND10CHAR[REALAWRT];
        W3 = AWR3RD10CHAR[REALAWRT];
        RETURN; 
        END 
      ELSE IF TABLE EQ USEPNT THEN
        BEGIN 
        REALPNT = VIRTUAL(VMPNT,INDEX); 
        NBRWORDS = PNTNBRWORDS[REALPNT];  # NUMBER OF WORDS IN NAME # 
        NAMETPTR = PNTNAMETPTR[REALPNT];  # POINTER TO NAME IN NAME TAB#
        END 
      ELSE #USEDNT# 
        BEGIN 
        REALDNT = VIRTUAL(VMDNT,INDEX); 
        NBRWORDS = DNTNBRWORDS[REALDNT];
        NAMETPTR = DNTNAMETPTR[REALDNT];
        END 
      W1 = NAMET$CHARS [VIRTUAL(VMNAMET, NAMETPTR)];
      IF NBRWORDS GR 1
      THEN
        BEGIN 
        W2 = NAMET$CHARS[VIRTUAL(VMNAMET, NAMETPTR + 1)]; 
        IF NBRWORDS GR 2
        THEN
          W3 = NAMET$CHARS[VIRTUAL(VMNAMET, NAMETPTR + 2)]; 
        ELSE
          W3 = "          ";
        END 
      ELSE
        BEGIN 
        W2 = "          ";
        W3 = "          ";
        END 
      RETURN; 
    END # OF NAMEGET #
CONTROL EJECT;
  
  FUNC HASHER ((TABLE), (INDEX)) U; 
    # RETURNS A VALUE IN RANGE 0 TO 127 FOR NAME TABLE(INDEX) # 
  
    ITEM TABLE U, #INDICATES AWRT,PNT OR DNT# 
         INDEX U; #INDEX INTO TABLE#
             ITEM J       U;#TEMPORARY RESULT#
  
    BEGIN # START OF CODE # 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," HASHER CALLED.",0,15);
      $END
      #ACCESS CHARACTERS OF NAME IN W1,W2 AND W3# 
      NAMEGET(TABLE,INDEX); 
             #CALL COMPASS HASHING ROUTINE# 
      J = HASH(NAMEARRAY);
      HASHER = J; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," HASHER = ",DEC(J));
      $END
    END # OF HASHER # 
CONTROL EJECT;
  
  PROC DNREFSEARCH; 
    # RESOLVE THE QUALIFICATION OF TNE IDENTIFIER. IF THERE ARE N QUALIF
     IERS, THEN EACH ENTRY OF ARRAY LIST CONTAINS THE INTERNAL NAME OF
     THE MOST RECENT DEFINITION OF THE NAME. LIST[LISTBOTTOM] CONTAINS
     THE DATA-NAME THAT IS QUALIFIED. ENTRIES ABOVE THIS ENTRY IN LIST
     CONTAIN THE MOST RECENT DEFINITIONS OF THE NAMES OF THE QUALIFIERS 
     IN ORDER.  THIS ROUTINE WILL RETURN THE INTERNAL NAME OF THE 
     RESOLVED REFERENCE, OR 0 (IF CAN[T RESOLVE IT), IN THE VARIABLE
     HIT. IT WILL SET UNIQUEHIT TO 1 IF THE REFERENCE IS NOT AMBIGUOUS. 
     HIT = 0 MEANS THE REFERENCE IS UNDEFINED.   #
  
    ITEM I U, # USED TO HOLD THE LIST INDEX OF QUALIFIER OR DATA-NAME.# 
         J U, # USED TO HOLD INDEX OF QUALIFIER WHICH QUALIFIES LIST[I]#
         K U; # TEMPORARY # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," DNREFSEAR","CH CALLED.");
      $END
      HIT = 0; # INIT. HIT #
      # SEARCH THE LIST UNTIL EITHER: 
        1. A HIT IS MADE AND IT IS FOUND TO BE UNIQUE.
        2. A HIT IS MADE AND IT IS FOUND TO BE AMBIGUOUS. 
        3. A HIT IS NOT MADE. 
      # 
      DOFOREVER 
        BEGIN 
          J = LISTBOTTOM;  # START WITH DATA-NAME THAT IS QUALIFIED#
          ASLONGAS J-1 GR LISTTOP DO # PROCESS THE IDENTIFIER # 
          BEGIN 
              I = J; # QUALIFIEE #
              J = J - 1; # QUALIFIER #
              # FIRST DISCARD ALL LIST[J] DEFINED AFTER LIST[I] IN THE
                PROGRAM, SINCE LIST[I] MUST BE .LE. LIST[J] TO BE 
                SUBORDINATE TO LIST[J].  #
              ASLONGAS LIST[J] GR LIST[I] DO
                BEGIN 
                  REALDNT = VIRTUAL(VMDNT,LIST[J]); 
                  IF DNTNOTUNIQUE[REALDNT] EQ 1 THEN #GET NEXT NAME#
                    BEGIN 
                      LIST[J] = DNTLINK[REALDNT]; 
                    END 
                  ELSE # THIS LIST[J] WAS THE LAST OF THE SAME NAMES ON 
                         THE CHAIN #
                    BEGIN 
                      UNIQUEHIT = TRUE; # ONLY VALID IF THERE WAS A HIT#
                      RETURN; 
                    END 
                END 
              # IF GET TO HERE THEN LIST[J] IS DEFINED BEFORE LIST[I] # 
              # CHECK TO SEE IF THE SCOPE OF LIST[J] CONTAINS LIST[I].
                IF NOT , THEN LIST[I] LIES BELOW THE SCOPE OF LIST[J],
                AND SO DO LIST[I+1] TO LIST[LISTBOTTOM], SO ADVANCE TO
                THE NEXT ENTRY ON EACH CHAIN. IF THERE ARE NO MORE
                SAME NAMES ON THE CHAIN (DNTNOTUNIQUE INDICATES THIS),
                THEN THE SEARCH IS FINISHED.   #
              IF LIST[I]
              GR LIST[J]+DNTSCOPE[VIRTUAL(VMDNT,LIST[J])] THEN
                #NOT WITHIN THE SCOPE#
                BEGIN 
                  FOR K = J+1 STEP 1 UNTIL LISTBOTTOM DO
                    BEGIN 
                    REALDNT = VIRTUAL(VMDNT,LIST[K]); 
                    IF DNTNOTUNIQUE[REALDNT] EQ 0 THEN
                      BEGIN 
                        UNIQUEHIT = TRUE; 
                        RETURN; 
                      END 
                    ELSE
                      LIST[K] = DNTLINK[REALDNT]; 
                    END 
                  J = LISTBOTTOM; # START SEARCH OVER AGAIN # 
                END 
              # ELSE FOUND A LIST[I] IN SCOPE OF LIST[J]. NOW TRY TO
                FIND A LIST[I-1] IN SCOPE OF LIST[J-1] #
            END # OF J-1 GR LISTTOP LOOP #
  
          # TO GET TO HERE WE HAVE TO HAVE FOUND A HIT. IE A REFER. 
            HAS BEEN RESOLVED. #
          K = LIST[LISTBOTTOM]; # THIS IS THE INT. NAME OF THE REF.#
          # SEE IF WE HAVE TO DISREGARD HIT # 
          # DISREGARD IF 77 OR INDEX OR MNEMONIC #
          # 77 HAS CODE 50, INDEX HAS CODE 53, MNEM. CODE 54 #
          REALDNT = VIRTUAL(VMDNT,K); 
          IF DNTLEVEL[REALDNT] LS 53 AND
             DNTLEVEL[REALDNT] NQ 50 THEN #HIT OK#
            BEGIN 
              IF HIT NQ 0 THEN # HAVE HIT ALREADY - REF. IS AMBIG. #
                BEGIN 
                  UNIQUEHIT = FALSE;
                  RETURN; 
                END 
              ELSE
                HIT = K;
            END 
  
          IF DNTNOTUNIQUE[REALDNT] EQ 0 THEN #END OF CHAIN AND SEARCH#
            BEGIN 
              UNIQUEHIT = TRUE; 
              RETURN; 
            END 
          ELSE
            BEGIN # SEE IF HIT IS AMBIGUOUS BY FINDING ANOTHER HIT #
              LIST[LISTBOTTOM] = DNTLINK[REALDNT]; #GET NEW START#
            END 
  
        END # OF DOFOREVER #
    END # OF DNREFSEARCH #
CONTROL EJECT;
  
  PROC DNBUILDLIST; 
    # BUILD LIST OF THE START OF CHAINS THAT REPRESENT THE DATA-
      NAME AND THE QUALIFIERS. LIST IS BUILD FROM THE BOTTOM UP # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," DNBUILDLI","ST CALLED.");
      $END
      I = HASHER(USEAWRT,AWRTPTR);
      SEARCHSTART = DNTHASHPTR[I];
      #FIND A MATCH FOR NAME# 
      IF SEARCHSTART EQ 0 
      THEN
        MATCH = 0;   # NO ITEMS ON CHAIN #
      ELSE
        NOQDNTSEARCH(USEAWRT,AWRTPTR);
      IF MATCH NQ 0 THEN MATCHCOUNT = MATCHCOUNT + 1; 
      LIST[LISTPTR] = MATCH;
      IF LISTPTR NQ 0 THEN
        LISTPTR = LISTPTR - 1;
      ELSE
        RLDIAG(D1048);
    END # OF DNBUILDLIST #
CONTROL EJECT;
  
  PROC DNREFRESOLVE;
    # RESOLVE THE REFERENCE WHICH STARTS AT AWRT[AWRTPTR] # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," DNREFRESO","LVE CALLED");
      $END
      # EACH NAME IN THE IDENTIFIER IS HASHED AND LOOKED UP IN THE
        DNT. THE FIRST OCCURENCE OF THE NAME IS PUT INTO THE ARRAY
        LIST. REMEMBER ALL LIKE NAMES ARE TOGETHER ON THE CHAIN.
        AFTER THIS IS DONE, QUALIFICATION RESOLUTION IS DONE IF NEC.
        ON RETURNING, HIT = 0 IF REF. IS AMBIG., HIT = INT. NAME IF 
        ONE WAS FOUND. AND IF SO UNIQUEHIT INDICATES IF IT WAS A
        UNIQUE REFERENCE. 
      # 
      PROCNAME = FALSE;  # NOT A PROCEDURE NAME # 
      LISTPTR = LISTBOTTOM; # START AT BOTTOM OF ARRAY LIST # 
      MATCHCOUNT = 0; # NUMBER OF DEFINED NAMES IN IDENTIFIER # 
      DNBUILDLIST; # CREATE LIST ENTRY FOR THE DATA-NAME #
      GETAWRTENTRY; # GET NEXT AWRT # 
      ASLONGAS AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 DO
        #DO SAME FOR EACH QUALIFIER#
        BEGIN 
          DNBUILDLIST;
          GETAWRTENTRY; 
        END 
      LISTTOP = LISTPTR ; # LISTTOP DELIMITS THE IDENTIFIER IN LIST # 
      # NOW WE ARE READY TO RESOLVE THE QUALIF. IF NEC. # 
      IF LISTPTR EQ LISTBOTTOM - 1 THEN # HAVE NO QUALIFIERS #
        BEGIN 
          HIT = LIST[LISTBOTTOM]; 
          IF DNTNOTUNIQUE[VIRTUAL(VMDNT,HIT)] EQ 1 THEN #NOT UNIQUE#
            UNIQUEHIT = FALSE;
          ELSE
            UNIQUEHIT = TRUE; 
        END 
      ELSE # HAVE QUALIFIERS #
        BEGIN 
          IF MATCHCOUNT NQ LISTBOTTOM - LISTPTR THEN # SOME UNDEFINED 
                                                     NAMES IN THE REF.# 
            BEGIN 
              HIT = 0;
              RETURN; 
            END 
          ELSE # ALL NAME WERE DEFINED #
            BEGIN 
              DNREFSEARCH; # SETS HIT=0 IF UNDEFINED, HIT= INT. NAME AND
                             AND UNIQUEHIT SWITCH SET OTHERWISE # 
              RETURN; 
            END 
        END 
    END # DNREFRESOLVE #
CONTROL EJECT;
  
  PROC SETINTPRNAME;
    # SET PROCEDURE NAME BIT IN INT. USED FOR "USE FOR DEBUGGING"#
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," SETINTPRN","AME CALLED");
      $END
      IN$PROCNAME[VIRTUAL(VMINT,INTNEXT)] = 1;
    END # OF SETINTPRNAME # 
CONTROL EJECT;
  
  PROC INTBUILD;
    # BUILD THE INTENTRY FOR THE REF. DESCRIBED BY HIT AND UNIQUEHIT# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," INTBUILD "," CALLED.");
      $END
      REALINT = VIRTUAL(VMINT,INTNEXT); 
      IN$INFO[REALINT] = 0; 
      IN$NAME[REALINT] = HIT; 
      IF HIT EQ 0 THEN IN$CODE[REALINT] = 1 ; # UNDEFINED # 
      ELSE
      IF NOT UNIQUEHIT THEN IN$CODE[REALINT] = 2; # AMBIGUOUS # 
  
      IF PROCNAME THEN IN$PROCNAME[REALINT] = 1; # ITS A PROC.
                                                    NAME  # 
      ELSE
      IF IMPLNAME THEN IN$CODE[REALINT] = 1;  # HIT WAS PLT 
                       POINTER. IT MIGHT BE AN IMPL-NAME #
      GETNEXTINT; 
    END # INTBUILD #
CONTROL EJECT;
  
  PROC PLTBUILDIMP; 
    # BUILD A PLT ENTRY FOR A POSSIBLE IMPLEMENTOR NAME # 
  
    ITEM CH C(10); # TEMP TO HOLD LAST WORD OF CHAR. STRING.# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," PLTBUILDI","MP CALLED.");
      $END
      REALPLT = VIRTUAL(VMPLAT,PLTNEXT);
      PL$CODE[REALPLT] = PLTQUOTEDLIT;
      PL$LINE[REALPLT] = REFLINENUM;
      PL$COLUMN[REALPLT] = 0; 
      PL$STRINGPTR[REALPLT] = NEXTSTRENTRY; 
      # NOW CALCULATE THE LENGTH OF THE STRING #
      GETPREVAWRT ; # GET AWRTPTR -1. IT HOLDS STRING # 
      #ACCESS CHARACTER STRING OF NAME# 
      NAMEGET(USEAWRT,AWRTPTR); 
      CH = W1;
      I = 0;
      PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = CH;
      GETNEXTSTR; 
      IF W2 NQ "          " THEN
        BEGIN 
          I = 10; 
          CH = W2;
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = CH;
          GETNEXTSTR; 
          IF W3 NQ "          " THEN
            BEGIN 
              I = 20; 
              CH = W3;
              PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = CH;
              GETNEXTSTR; 
            END 
        END 
      #TOTAL LENGTH IS I PLUS NO. OF NONBLANKS IN LAST WORD#
      J = 0;
      ASLONGAS C<J,1>CH NQ " " DO # COUNT CHAR.S IN LAST WORD#
        BEGIN 
          IF J EQ 9 THEN BEGIN J = 10; GOTO PLTIMPESCAPE; END 
          J = J+1;
        END 
      PLTIMPESCAPE: 
      PL$LENGTH[VIRTUAL(VMPLAT,PLTNEXT)] = I + J; 
      GETAWRTENTRY; 
      GETNEXTPLT; 
    END # OF PLTBUILDIMP #
CONTROL EJECT;
  
  PROC SETSCOPE ((LEVEL));
    # SET THE SCOPE OF ALL THE GROUP ITEMS TERMINATED BY THE NEW
      DNT ENTRY BEING BUILT # 
  
    ITEM LEVEL U, #LEVEL OF CURRENT ENTRY#
         I     U; #TEMPORARY DNT INDEX# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," SETSCOPE CALLED.",0,17);
      $END
      IF SCOPESP EQ -1 THEN RETURN; # STACK EMPTY # 
      ASLONGAS SCOPELEVEL [SCOPESP] GQ LEVEL DO 
        #SET SCOPE OF ENTRY AND GROUP BIT#
        BEGIN 
          IF SCOPESP EQ -1 THEN RETURN; 
          I = SCOPEINTNAME[SCOPESP];
          REALDNT = VIRTUAL(VMDNT,I); 
          DNTSCOPE[REALDNT] = CURINTNAME - I - 1; 
          DNTGROUP[REALDNT] = 1;
          $BEGIN
            IF INDEBUG THEN OUTPUT(6," SCOPESP= ",DEC(SCOPESP), 
              " IN$NAME= ",DEC(I)," SCOPE = ",DEC(DNTSCOPE[I]));
          $END
          SCOPESP = SCOPESP - 1;
        END 
    END # OF SETSCOPE # 
CONTROL EJECT;
  
  PROC NOQDNTSEARCH ((TABLE), (NEWENTRY));
    # LOOK UP UNQUALIFIED NAME TABLE[NEWENTRY] IN DNT # 
    # ON ENTRY, SEARCHSTART MUST CONTAIN STARTING INDEX  #
    # ON RETURN, POINTTOMATCH WILL BE SET TO PTR TO ENTRY THAT POINTS 
       TO MATCH AND MATCH WILL HAVE 0 IF NO MATCH, MATCH PTR IF ONE  #
  
    ITEM TABLE    U, #INDICATES AWRT,PNT OR DNT#
         NEWENTRY U, #INDEX INTO TABLE# 
        I        U; #LOOP CONTROL TEMPORARY#
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," NOQDNTSEARCH CALLED",0,20); 
        IF INDEBUG THEN OUTPUT(6, " START = ", DEC(SEARCHSTART),
            " ENTRY = ", DEC(NEWENTRY), " TABLE = ", DEC(TABLE)); 
      $END
      #ACCESS CHARACTER STRING FROM APPROPRIATE TABLE#
      NAMEGET(TABLE,NEWENTRY);
      POINTTOMATCH = 0; 
      IF TABLE EQ USEAWRT 
      THEN
        BIGHASH = HASHNM(NAMEARRAY);
      ELSE
        IF TABLE EQ USEDNT
        THEN
          BIGHASH = DNTBIGHASH[REALDNT];  # REALDNT SET BY NAMEGET #
        ELSE
          BIGHASH = PNTBIGHASH[REALPNT];
      MATCH = 0;
      IF NOT TTABALLINCOR[VMDNT]
      THEN   # DNT NOT ALL IN CORE #
        BEGIN 
        FOR I = SEARCHSTART WHILE I NQ 0 DO   # LINK OF 0 IS END CHAIN# 
          BEGIN 
          REALDNT = VIRTUAL(VMDNT,I); 
          IF BIGHASH EQ DNTBIGHASH[REALDNT] 
          AND COMPNAMES(DNTNAMETPTR[REALDNT], DNTNBRWORDS[REALDNT]) 
          THEN
            BEGIN 
            MATCH = I;
            GOTO NOQDNTSEXIT; 
            END 
          POINTTOMATCH = I; 
          I=DNTLINK[REALDNT]; 
          END 
        END 
      ELSE
        BEGIN   # DNT IN CORE # 
        FOR I = SEARCHSTART WHILE I NQ 0 DO  # LINK OF 0 IS END CHAIN#
          BEGIN 
          IF BIGHASH EQ DNTBIGHASH[I] 
          AND COMPNAMES(DNTNAMETPTR[I], DNTNBRWORDS[I]) 
          THEN
            BEGIN 
            MATCH = I;
            GOTO NOQDNTSEXIT; 
            END 
          POINTTOMATCH = I; 
          I=DNTLINK[I]; 
          END 
        END 
      MATCH = 0;  # NO MATCH #
 NOQDNTSEXIT: 
      $BEGIN
        IF INDEBUG
        THEN
          IF MATCH EQ 0 
          THEN
            OUTPUT (1, " MATCH = 0"); 
          ELSE
            OUTPUT (4, " MATCH =", DEC(MATCH), " POINT = ", 
              DEC(POINTTOMATCH)); 
      $END
      RETURN; 
    END # OF NOQDNTSEARCH # 
CONTROL EJECT;
  
  PROC NOQPNTSEARCH ((TABLE), (NEWENTRY), (START), (FINISH), MATCH);
    # SEARCH PNT FOR NON-QUALIFIED NAME TABLE[NEWENTRY] . # 
  
    ITEM TABLE    U, # INDICATES AWRT OR PNT# 
         NEWENTRY U, # INDEX IN TABLE OF ITEM TO BE SEARCHED# 
         START    U, # START OF CHAIN TO BE SEARCHED #
         FINISH   U, # SEARCH STOPS IF LINK OF AN ENTRY ON CHAIN IS LESS
                       OR EQUAL TO FINISH. MATCH IS SET TO THE LINK # 
         MATCH    U; # SEARCH STOPS IF A MATCH IS FOUND. MATCH IS THE 
                       INTERNAL NAME OF THE HIT # 
    ITEM I        U; #LOOP CONTROL TEMPORARY# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"NOQPNTSEAR","CH CALLED.");
      $END
      #ACCESS CHARACTER STRING FROM APPROPRIATE TABLE#
      #THIS ROUTINE DOESN"T USE THE DNT#
      NAMEGET(TABLE,NEWENTRY);
      IF TABLE EQ USEAWRT 
      THEN
        BIGHASH = HASHNM(NAMEARRAY);
      ELSE
        IF TABLE EQ USEDNT
        THEN
          BIGHASH = DNTBIGHASH[REALDNT];  # REALDNT SET BY NAMEGET #
        ELSE
          BIGHASH = PNTBIGHASH[REALPNT];
      MATCH = 0;
      IF NOT TTABALLINCOR[VMPNT]
      THEN   # PNT NOT ALL IN CORE #
        BEGIN 
        FOR I = START WHILE I GR FINISH DO   #LINK OF 0 IS END OF CHAIN#
          BEGIN 
          REALPNT = VIRTUAL(VMPNT,I); 
          IF BIGHASH EQ PNTBIGHASH[REALPNT] 
          AND COMPNAMES(PNTNAMETPTR[REALPNT], PNTNBRWORDS[REALPNT]) 
          THEN
            BEGIN 
            MATCH = I;
            GOTO NOQPNTSEXIT; 
            END 
          I=PNTLINK[REALPNT]; 
          END 
        END 
      ELSE
        BEGIN   # PNT IN CORE # 
        FOR I = START WHILE I GR FINISH DO  #LINK OF 0 IS END OF CHAIN# 
          BEGIN 
          IF BIGHASH EQ PNTBIGHASH[I] 
          AND COMPNAMES(PNTNAMETPTR[I], PNTNBRWORDS[I]) 
          THEN
            BEGIN 
            MATCH = I;
            GOTO NOQPNTSEXIT; 
            END 
          I=PNTLINK[I]; 
          END 
        END 
      MATCH = 0;  # NO MATCH #
 NOQPNTSEXIT: 
      $BEGIN
        IF INDEBUG
        THEN
          IF MATCH EQ 0 
          THEN
            OUTPUT (1, " MATCH = 0"); 
          ELSE
            OUTPUT (4, " MATCH =", DEC(MATCH)); 
      $END
  
    END # OF NOQPNTSEARCH # 
CONTROL EJECT;
  
  FUNC SON ((FATHER)) U;
    # THIS ROUTINE RETURNS THE INT. NAME OF THE SON OF FATHER OR
      0 IF THERE IS NO SON ( IE. FATHER IS A GROUP NAME) #
  
    ITEM FATHER U, #DNT INDEX OF CURRENT NAME#
         I      I, #LOOP END TEMPORARY# 
         J      I; #LOOP CONTROL TEMPORARY# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," SON CALLE","D.");
      $END
      # LOOK FOR SON BUT IGNORE 66 88 AND INDEX-NAMES # 
      I = DNTSCOPE[VIRTUAL(VMDNT,FATHER)] + FATHER; 
      #GET LAST SUBORDINATE OF FATHER#
      FOR J = FATHER+1 STEP 1 UNTIL I DO
        BEGIN 
          # LOOP THRU LOOKING FOR SON # 
          IF DNTLEVEL[VIRTUAL(VMDNT,J)] LS 50 THEN #HAVE A GOOD SON#
            BEGIN 
              SON = J;
              RETURN; 
            END 
        END 
      # NO GOOD SON IF GET TO HERE #
      SON = 0;
    END # SON#
CONTROL EJECT;
  
  FUNC BROTHER ((THISITEM), (FATHERLEVEL)) U; 
    # THIS FUNCTION RETURNS THE BROTHER OF THISITEM IF IT HAS ONE.
      IF NOT, IT RETURNS 0# 
  
    ITEM THISITEM U, #DNT INDEX OF ITEM#
         I        I; #TEMPORARY#
    ITEM FATHERLEVEL U; #LEVEL NUMBER OF FATHER OF THISITEM#
    ITEM NEXTLEVEL U; 
    ITEM THISLEVEL U; 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"BROTHER CA","LLED."); 
      $END
      # GET 1ST ITEM PAST THE SCOPE OF THISITEM#
      I = THISITEM + DNTSCOPE[VIRTUAL(VMDNT,THISITEM)] + 1; 
      NEXTLEVEL = DNTLEVEL[VIRTUAL(VMDNT,I)]; 
      THISLEVEL = DNTLEVEL[VIRTUAL(VMDNT,THISITEM)];
      IF NEXTLEVEL LQ THISLEVEL AND NEXTLEVEL GR FATHERLEVEL
      THEN BROTHER = I; 
      ELSE BROTHER = 0; 
    END # OF BROTHER #
CONTROL EJECT;
  
  PROC GETNEWSOURCE;
    # UNSTACK PAIRS OF GROUP ITEMS UNTIL GET NEW SOURCE TO CONTINUE#
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"GETNEWSOUR","CE CALLED.");
      $END
      ASLONGAS BROTHER(SOURCE,SFL) EQ 0 DO
        BEGIN 
          # NO BROTHER SO FINISHED WITH THIS LEVEL. # 
          TARGET = TSTACK[STACKPTR];
          SOURCE = SSTACK[STACKPTR];
          STACKPTR = STACKPTR - 1;
          IF STACKPTR EQ -1 THEN RETURN; # NO MORE "CORR" PAIRS # 
        END 
      # HAVE BROTHER TO GET TO HERE # 
      SOURCE = BROTHER(SOURCE,SFL); #NEW SOURCE TO LOOK FOR PAIRS#
      TARGET = SON( TSTACK[STACKPTR]); # NEW TARGET # 
    END # OF GETNEWSOURCE # 
CONTROL EJECT;
  
  PROC FOUNDPAIR; 
    #CALLED WHEN WE HAVE FOUND A "CORRESPONDING" PAIR. SET UP THE 
     AWRT ENTRIES FOR THE PAIR. THIS IS BECAUSE THE INT IS BUILD
     FROM THE AWRT AS IS THE CROSS-REFERENCE# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"FOUNDPAIR ","CALLED."); 
      $END
      # THE INTERNAL NAMES OF THE PAIR ARE IN SOURCE AND TARGET # 
      #GET CHARACTERS OF SOURCE NAME# 
      NAMEGET(USEDNT,SOURCE); 
      #BUILD AWRT ENTRY FOR SOURCE# 
      REALAWRT = VIRTUAL(VMAWRT,AWRTNEXT);
      AWRTINFO[REALAWRT] = 0; 
      AWR1ST10CHAR[REALAWRT] = W1;
      AWR2ND10CHAR[REALAWRT] = W2;
      AWR3RD10CHAR[REALAWRT] = W3;
      AWRTQUALIF[REALAWRT] = 0; #NOT A QUALIFIER# 
      AWRTCODE[REALAWRT] = AWRTCORRITEM;
      AWRTLINE[REALAWRT] = CLALINE; 
      AWRTIMMED[REALAWRT] = SOURCE; #INTERNAL NAME PUT IN INT LATER#
      GETNEXTAWRT;
      #GET TARGET NAME CHARACTER STRING#
      NAMEGET(USEDNT,TARGET); 
      #BUILD AWRT ENTRY FOR TARGET# 
      REALAWRT = VIRTUAL(VMAWRT,AWRTNEXT);
      AWRTINFO[REALAWRT] = 0; 
      AWR1ST10CHAR[REALAWRT] = W1;
      AWR2ND10CHAR[REALAWRT] = W2;
      AWR3RD10CHAR[REALAWRT] = W3;
      AWRTQUALIF[REALAWRT] = 0; 
      AWRTCODE[REALAWRT] = AWRTCORRITEM;
      AWRTLINE[REALAWRT] = CLALINE; 
      AWRTIMMED[REALAWRT] = TARGET; 
      GETNEXTAWRT;
    END # OF FOUNDPAIR #
      CONTROL EJECT;
      PROC BUILDENT ((TABLE), NMARRAY); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *    BUILDENT - BUILD PNT OR DNT ENTRY AND PUT NAME IN NAME TABLE
 *
 *    PARAMETERS ARE TABLE FOR USEDNT OR USEPNT 
 *        AND NMARRAY - ARRAY CONTAINING NAME 
*       TABLE POINTER IS IN DNTNEXT OR PNTNEXT
 *
 *
 *    CREATES NAME DATA FOR A DNT OR PNT TABLE ENTRY. 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
      BEGIN 
      ITEM TABLE I; 
      ARRAY NMARRAY [0:3] S(1); 
        ITEM NAMECHARS C(0,0,10); 
      ITEM HASHV I; 
      ITEM WORDSINNM I; 
      ITEM NAMETPTR  U; 
  
      WORDSINNM = 0;
      HASHV = HASHNM(NMARRAY);  # GET 30 BIT HASH OF NAME # 
      NAMETPTR = CCTNAMETLEN; 
      FOR I = 0 STEP 1 WHILE NAMECHARS [I] NQ "          "
          AND I LS 3 DO 
        BEGIN 
        NAMET$CHARS[VIRTUAL(VMNAMET,CCTNAMETLEN)] = NAMECHARS[I]; 
        WORDSINNM = WORDSINNM + 1;
        CCTNAMETLEN = CCTNAMETLEN + 1;
        END 
      IF TABLE EQ USEDNT
      THEN
        BEGIN 
        REALDNT = VIRTUAL(VMDNT, DNTNEXT);
        DNTBIGHASH[REALDNT] = HASHV;
        DNTNBRWORDS[REALDNT] = WORDSINNM; 
        DNTNAMETPTR[REALDNT] = NAMETPTR;
        END 
      ELSE
        BEGIN 
        REALPNT = VIRTUAL(VMPNT, PNTNEXT);
        PNTBIGHASH[REALPNT] = HASHV;
        PNTNBRWORDS[REALPNT] = WORDSINNM; 
        PNTNAMETPTR[REALPNT] = NAMETPTR;
        END 
      RETURN; 
      END 
CONTROL EJECT;
  
        PROC MOVESTRING ((WORD), INDEX);
          # THIS PROCEDURE MOVES THE CHARACTER STRING STORED IN # 
          # WORD INTO CHSTR.                                    # 
          # INDEX POINTS TO THE FIRST CHARACTER THAT MUST BE MOVED #
  
          ITEM WORD           C(10);
          ITEM INDEX          I;
  
          BEGIN 
            ASLONGAS INDEX LQ 9 DO
              BEGIN 
              IF C<INDEX,1>WORD EQ " "
              THEN BEGIN
                   INDEX = 0; 
                   WORDFLAG = 4;
                   RETURN;
                   END
              IF CLENGTH GR 30
              THEN BEGIN
                   WORDFLAG = 4;
                   RETURN;
                   END
              C<CLENGTH-1,1>CHSTR = C<INDEX,1>WORD; 
              CLENGTH = CLENGTH + 1;
              INDEX = INDEX + 1;
              END 
  
            INDEX = 0;
            RETURN; 
            END   #MOVESTRING#
  CONTROL EJECT;
  
          PROC STORESTR ((TABLE), (INDEX)); 
            # THIS PROCEDURE STORES INTO THE CHARACTER STRING CHSTR  #
            # THE CHARACTERS CONTAINED IN THE ENTRY POINTED TO BY    #
            # INDEX OF THE TABLE INDICATED BY TABLE.                 #
            # CLENGTH: POINTER TO THE FIRST EMPTY CHARACTER IN CHSTR #
  
            ITEM TABLE U; #INDICATES AWRT OR PNT# 
            ITEM INDEX U; #INDEX INTO TABLE#
  
            ITEM  INDX            I;
            SWITCH PFLAG      #WORD0#, WORD1, WORD2, WORD3; 
  
            BEGIN 
              #ACCESS THE CHARACTER STRING NAME FROM THE TABLE# 
              #INTO THE VARIABLES W1,W2 AND W3# 
              NAMEGET(TABLE,INDEX); 
  
          INDX = 0; 
          WORDFLAG = 1; 
          ASLONGAS  WORDFLAG LS 4 DO
            BEGIN 
            GOTO PFLAG[WORDFLAG]; 
    WORD1:  
            WORDFLAG = 2; 
            MOVESTRING(W1,INDX);
            GOTO REPEAT;
    WORD2:  
            WORDFLAG = 3; 
            MOVESTRING(W2,INDX);
            GOTO REPEAT;
    WORD3:  
            WORDFLAG = 4; 
            MOVESTRING(W3,INDX);
    REPEAT: 
            END 
            RETURN; 
            END # OF STORESTR # 
  CONTROL EJECT;
  
     PROC STOREPLTCHAR(CHLENGTH); 
  
          # THIS PROCEDURE STORES THE CHARACTER STRING IN CHSTR # 
          # OF LENGTH CHLENGTH INTO THE PLT.                   #
  
          BEGIN 
            ITEM CHLENGTH          I; 
  
            PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)]=C<0,10>CHSTR;
            GETNEXTSTR; 
            IF CHLENGTH GR 11 
            THEN BEGIN
                 PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)]=C<10,10>CHSTR;
                 GETNEXTSTR;
                 IF CHLENGTH GR 21
                 THEN BEGIN 
                      PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)]= 
                                         C<20,10>CHSTR; 
                      GETNEXTSTR; 
                      END 
                 END
  
          END  #STOREPLTCHAR# 
  
  # START OF MAIN BODY OF TBLPROCS #
CONTROL EJECT;
  
PROC  INITTBLPROCS; 
    # INITIALIZE VARIABLES #
  
    BEGIN 
      DEF LASTDNTSREG #14#;   # LAST DNT SPECIAL REGISTER # 
  
      ARRAY SREGVALS [1:LASTDNTSREG]; 
        BEGIN 
        ITEM SREGVAL S:DNTSREGVALS  (0,0,4) = [ 
          S"HASHED$VALUE",   #1#
          S"DBG$ITEM",       #2#
          S"DBG$LINE",       #3#
          O"17",             #4 - NOT USED #
          S"DBG$NAME",       #5#
          O"17",             #6#
          S"DBG$SUB$1",      #7#
          O"17",             #8#
          S"DBG$SUB$2",      #9#
          O"17",             #10# 
          S"DBG$SUB$3",      #11# 
          O"17",             #12# 
          S"DBG$CONT",       #13# 
          S"DBG$NUM$CONT",   #14# 
          ];
          END 
      DEF PLTSTOINIT #8#;  # NUMBER OF PLTS TO INITIALIZE # 
      ARRAY INITPLT [1:PLTSTOINIT] S(2);
        BEGIN 
        ITEM INITPLTSTR  C(0,0,19) = [
          "NO-NAME            ",
          "START PROGRAM      ",
          "FALL THROUGH       ",
          "USE PROCEDURE      ",
          "PERFORM LOOP       ",
          "SORT INPUT         ",
          "SORT OUTPUT        ",
          "MERGE OUTPUT       ",
          ];
        ITEM INITPLTLEN   U(1,54,6) = [ 
          10, 
          13, 
          12, 
          13, 
          12, 
          10, 
          11, 
          12, 
          ];
        END 
      SCOPESP = -1; 
      # INITIALIZE THE HASH TABLES #
      FOR I = 0 STEP 1 UNTIL 127 DO 
        BEGIN 
          DNTHASHPTR[I] = 0;
          PNTHASHPTR[I] = 0;
        END 
      #INITIALIZE TABLE INDICIES AND FLAGS# 
      LASTSECTION = 0;
      LASTRD = 0; 
      RDAMBIG = FALSE;
      CCTNAMETLEN = 1;
      # INITIALIZE THE FIRST ENTRIES OF THE DNT, WHICH ARE
        SPECIAL REGISTERS. #
  
      FOR DNTNEXT = 1 STEP 1 UNTIL LASTDNTSREG DO 
        BEGIN 
        REALDNT = VIRTUAL (VMDNT, DNTNEXT); 
        IF SREGVAL[DNTNEXT] NQ O"17"
        THEN   # PROCESS ONLY VALID ENTRIES - OTHERS IGNORED #
          BEGIN 
          DNTSREG[REALDNT] = TRUE;   # SET AS SPECIAL REGISTER #
          DNTSREGVAL[REALDNT] = SREGVAL [DNTNEXT];  # NBR OF SREG#
          END 
        END 
      # INITIALIZE THE FIXED PORTION OF THE PLT WITH THE DEFAULT
        PROGRAM-ID AND THE STRINGS REQUIRED BY THE DEBUG FACILITY. #
      FOR I = 1 STEP 1 UNTIL PLTSTOINIT DO
        BEGIN 
          REALPLT = VIRTUAL(VMPLAT,PLTNEXT);
          PL$CODE[REALPLT] = PLTQUOTEDLIT;
          PL$LINE[REALPLT] = 0; 
          PL$COLUMN[REALPLT] = 0; 
          PL$LENGTH [REALPLT] = INITPLTLEN [I]; 
          SETPLST (PLTNEXT, LOC(INITPLTSTR[I]));  # PUT VALUE IN PLTSTR#
        GETNEXTPLT; 
        END 
      PLSTNEXT = CCTPLSTLEN  + 1;  # RESET FROM SETPLST # 
#      ADD FIGURATIVE CONSTANTS TO PLT STRING   # 
          PLTSTRZERO = NEXTSTRENTRY ; 
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = "0"; 
          GETNEXTSTR; 
          PLTSTRSPACE = NEXTSTRENTRY; 
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = " "; 
          GETNEXTSTR; 
          PLTSTRQUOTE = NEXTSTRENTRY; 
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = QUOTE; 
          GETNEXTSTR; 
          PLTSTRLOVAL = NEXTSTRENTRY; 
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = 0; 
          GETNEXTSTR; 
          PLTSTRHIVAL = NEXTSTRENTRY; 
          PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = 63;
           GETNEXTSTR;
      RETURN; 
    END # OF INITTBLPROCS # 
CONTROL EJECT;
  
   PROC  AWRTBUILD; 
    # BUILD AN AWRT ENTRY # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," AWRTBUILD CALLED.",0,18); 
      $END
      REALAWRT = VIRTUAL(VMAWRT,AWRTNEXT);
      AWRTINFO[REALAWRT] = 0; 
      AWR1ST10CHAR[REALAWRT] = SAREA[0];
      AWR2ND10CHAR[REALAWRT] = SAREA[1];
      AWR3RD10CHAR[REALAWRT] = SAREA[2];
      AWRTQUALIF[REALAWRT] = QUALAWRT;
      AWRTCODE[REALAWRT] = CODEAWRT;
      AWRTLINE[REALAWRT] = CLALINE; 
      IF CODEAWRT EQ AWRTPNREF
      OR CODEAWRT EQ AWRTPNORDN  #OR MAY BE PARA NAME # 
      THEN
        AWRTIMMED[REALAWRT] = LASTSECTION;
      ELSE
        IF CODEAWRT EQ AWRTSPECREG THEN 
          BEGIN # SPECIAL REGISTER REFERENCE #
            AWRTIMMED[REALAWRT] = IMMEAWRT; 
            AWRTSREG[REALAWRT] = SREGAWRT;
          END 
      GETNEXTAWRT;
      RETURN; 
    END # OF AWRTBUILD #
CONTROL EJECT;
  
   PROC  DNTSCP;
    # THIS ROUTINE IS CALLED WHEN "PROCEDURE DIVISION" IS 
      PARSED. IT FINISHES UP THE SCOPE PROCESSING FOR THE DNT 
      AND PERFORMS OTHER TABLE RELATED INITIALIZATION. #
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," DNTSCOPE CALLED.",0,17);
      $END
      CURINTNAME = DNTNEXT; # SO SCOPE GETS SET CORRECTLY # 
      SETSCOPE(0);
      PNTINFO[VIRTUAL(VMPNT,0)] = 0; #0TH ENTRY USED BY AWRTRESOLVE#
      USEFORDEBUG = FALSE;
      AWRTPDINDEX = INTINDEX + 1; # INDEX OF FIRST REF. IN PROC.
                                    DIVISION #
      RETURN; 
    END # OF DNTSCOPE # 
CONTROL EJECT;
  
   PROC  PLTBUILD;
    # BUILD NEW PLT ENTRY # 
          ITEM  I;
          ITEM  J;
          ITEM  K;
  
    BEGIN 
      ITEM CH1 C(1); #FIG CONSTANT STRING VALUE#
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," PLTBUILD CALLED.",0,17);
      $END
      #CALCULATE VIRTUAL INDEX OF ENTRY#
      REALPLT = VIRTUAL(VMPLAT,PLTNEXT);
      # BUILD A PLT ENTRY FOR THE CURRENT CLASSIFIER TOKEN. 
        THE TOKEN MUST BE A LITERAL FOR THIS ROUTINE TO BE CALLED#
      # USE THE TYPE OF TOKEN TO PROCESS IT # 
      SWITCH PLTSWITCH ,PLTILIT,PLTNLIT,PLTFLIT,PLTQLIT,,,,,,,PLTPIC, 
                             ,,,PLTFIG,,,PLTBLIT; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," PLTSW = ",DEC(CLATYPE)); 
      $END
      #CONSTRUCT LINE AND COLUMN PART OF ENTRY# 
      PL$LINE[REALPLT] = CLALINE; 
      PL$COLUMN[REALPLT] = CLACOLUMN; 
      #SELECT APPROPRIATE CODE BASED ON CLASSIFIER TYPE#
      GOTO PLTSWITCH[CLATYPE];
CONTROL EJECT;
    PLTFIG: 
      BEGIN # FIGURATIVE CONSTANTS HANDLED HERE # 
        IF CLAVALUE EQ RWZERO THEN
          BEGIN 
            PL$CODE[REALPLT] = PLTFGCONZERO;
            PL$FIGZERO[REALPLT] = 1;
          PL$STRINGPTR[REALPLT] = PLTSTRZERO; 
          END 
        ELSE
        BEGIN 
          PL$CODE[REALPLT] = PLTQUOTEDLIT;
          IF CLAVALUE EQ RWSPACE THEN 
            BEGIN 
              PL$FIGSPACE[REALPLT] = 1; # FIG CON SPACES #
          PL$STRINGPTR[REALPLT] = PLTSTRSPACE;
            END 
          ELSE
          IF CLAVALUE EQ RWQUOTE THEN 
            BEGIN 
              PL$FIGQUOTE[REALPLT] = 1; # FIG CON QUOTE # 
            PL$STRINGPTR[REALPLT] = PLTSTRQUOTE;
            END 
          ELSE
          IF CLAVALUE EQ RWLOWVALUE THEN
            BEGIN 
              PL$FIGLOWV[REALPLT] = 1; # CODE FOR LOW-VALUES #
            PL$STRINGPTR[REALPLT] = PLTSTRLOVAL;
            END 
          ELSE
          IF CLAVALUE EQ RWHIGHVALUE THEN 
            BEGIN 
              PL$FIGHIGHV[REALPLT] = 1; # HIGH-VALUES # 
            PL$STRINGPTR[REALPLT] = PLTSTRHIVAL;
            END 
        END 
        # NOW FILL IN REST OF ENTRY # 
        PL$LENGTH[REALPLT] = 1; 
        #BUILD STRING ENTRY WITH APPROPRIATE CHARACTER# 
        GETNEXTPLT; 
        RETURN; 
      END 
CONTROL EJECT;
    PLTILIT: PLTNLIT: PLTFLIT:  
      BEGIN # HANDLE NUMERIC TYPE LITERALS #
        PL$CODE[REALPLT] = CLATYPE + 1; 
        PL$SIGNFLAG[REALPLT] = 1;   # POSITIVE #
        IF SIGNSW THEN
          BEGIN 
            PL$SIGNEDFLG[REALPLT] = 1; # LITERAL IS SIGNED #
            IF C<0,1> SAREA[0] EQ "-" THEN
              PL$SIGNFLAG[REALPLT] = 0; # MINUS SIGN #
            # NOW MOVE STRING IN SAREA 1 TO LEFT TO GET 
              RID OF THE SIGN # 
            ITEM SSTRTEMP  C(30); 
            C<0,10>SSTRTEMP = SAREA[0]; 
            C<10,10>SSTRTEMP = SAREA[1];
            C<20,10>SSTRTEMP = SAREA[2];   #ASSUMES 30 CHARS OR LESS# 
  
            SAREA[0] = C<1,10>SSTRTEMP; 
            SAREA[1] = C<11,10>SSTRTEMP;
            SAREA[2] = C<21,9>SSTRTEMP; 
  
            SAREALENGTH = SAREALENGTH - 1; # LENGTH IS 1 LESS NOW#
          END 
        ELSE
          PL$SIGNEDFLG[REALPLT] = 0;
        GOTO CASEEND1;
      END 
CONTROL EJECT;
    PLTQLIT:  
      BEGIN 
        PL$CODE[REALPLT] = PLTQUOTEDLIT;
        IF SAREALENGTH EQ 0 THEN # NOT LEGAL - USE 1 BLANK INSTEAD# 
          BEGIN 
            SAREALENGTH = 1;
            SAREA[0] = " "; 
            SSDIAGS (D1050);
          END 
        GOTO CASEEND1;
      END 
 PLTBLIT: 
          PL$CODE[REALPLT] = PLTBOOLLIT;
          IF SAREALENGTH EQ 0 
          THEN
              BEGIN 
              SAREALENGTH = 1;
              SAREA[0] = "0"; 
              SSDIAGS (D1050);
              END 
          FOR I = 0 STEP 1 UNTIL SAREALENGTH-1 DO 
              BEGIN 
              J = I/10; 
              K = I - 10*J; 
              CH1 = C<K,1>SAREA[J]; 
              IF  CH1 NQ "0" AND CH1 NQ "1" 
              THEN
                  BEGIN 
                  SSDIAGS (D1093);
                  GOTO CASEEND1;
                  END 
               END
          GOTO  CASEEND1; 
  
    PLTPIC: 
      BEGIN 
        PL$CODE[REALPLT] = PLTPICTURE;
        GOTO CASEEND1;
      END 
  
    CASEEND1: 
      BEGIN  # COMPLETE PLTATTRIBUTE AND PLTSTRING #
        PL$LENGTH[REALPLT] = SAREALENGTH; 
        PL$STRINGPTR[REALPLT] = NEXTSTRENTRY; 
        J = (SAREALENGTH - 1)/10; # NUM. WORDS TO HOLD STRING - 1#
        FOR I = 0 STEP 1 UNTIL J DO # PUT STRING IN PLTSTRING#
          BEGIN 
            PLT$CHAR[VIRTUAL(VMPLST,NEXTSTRENTRY)] = SAREA[I];
            GETNEXTSTR; 
          END 
        # CLASSIFIER ONLY BLANK FILLS IF LESS THAN 30 CHAR.S. 
          THEREFORE IF GR 30 MUST DO THAT HERE #
        IF SAREALENGTH GR 30 THEN 
          BEGIN 
            K = NEXTSTRENTRY - 1; 
            I = 10*(J+1) - SAREALENGTH; # NUMBER OF BLANKS NEEDED#
            IF I NQ 0 
            THEN
                C<10-I,I>PLT$CHAR[VIRTUAL(VMPLST,K)] = "          ";
          END 
        GETNEXTPLT; 
      END 
      RETURN; 
    END # OF PLTBUILD # 
CONTROL EJECT;
  
   PROC  PNTNAME; 
    # START BUILDING NEW PNT ENTRY. 
      THE REST OF THE BUILDING IS DONE BY PNTBUILD AFTER WE 
      ARE SURE THAT THIS ENTRY IS NOT GOING TO BE DELETED 
      BECAUSE OF " USE FOR DEBUGGING ". # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," PNTNAME CALLED.",0,14); 
      $END
      CURINTNAME = PNTNEXT; 
      REALPNT = VIRTUAL(VMPNT,PNTNEXT); 
      # PARTIALLY BUILD THE PNT ENTRY. IF THIS ENTRY IS NOT TO BE 
        DELETED, THEN PNTBUILD WILL FINISH THE JOB. # 
      PNTINFO[REALPNT] = 0; 
      W1 = SAREA[0];   # SAVE NAME #
      W2 = SAREA[1];
      W3 = SAREA[2];
      PNTLINE[REALPNT] = CLALINE; 
      PNTCOLUMN[REALPNT] = CLACOLUMN; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"CURINAME= ",DEC(CURINTNAME)); 
      $END
      RETURN; 
    END # OF PNTNAME #
CONTROL EJECT;
  
   PROC PNTBUILD; 
    # BUILD NEW PNT ENTRY # 
  
    BEGIN 
    ITEM REALMATCH U; #VIRTUAL INDEX OF THE MATCHED ENTRY#
      $BEGIN
        IF INDEBUG THEN DISPLAY(2, " PNTBUILD CALLED.",0,17); 
      $END
      #CALCULATE THE VIRTUAL TABLE INDEX# 
      REALPNT = VIRTUAL(VMPNT,PNTNEXT); 
      # ADD INTERNAL NAMES TO ARRAY TO PUT IN LISTING LINE #
      IF INTLISTPTR LS 2 THEN # UP TO 3 NAMES PER LINE #
        BEGIN 
          INTLISTPTR = INTLISTPTR + 1;
          LISTNAME[INTLISTPTR] = CURINTNAME;
        END 
  
      IF SECTSWITCH THEN # HAVE SECTION # 
        BEGIN 
          PNTSECTION[REALPNT] = 1;
          PNTSEGORSECT[REALPNT] = SEGNUMBER;
          LASTSECTION = CURINTNAME; # HAVE NEW LAST SECTION NOW # 
        END 
      ELSE
        PNTSEGORSECT[REALPNT] = LASTSECTION; #SHOW SECTION ITS IN#
      IF USEFORDEBUG THEN PNTDEBUG[REALPNT] = 1; #IN USE FOR DEBUGGING# 
      IF DCLSWITCH THEN PNTDECLARATV[REALPNT] = 1; #IN DECLARATIVES#
  
      BUILDENT(USEPNT,NAMEARRAY);  # BUILD NAME ENTRY # 
      # HASH NAME AND LINK IT TO PROPER CHAIN # 
  
      HASHVALUE = HASHER(USEPNT,CURINTNAME);
      SEARCHSTART = PNTHASHPTR[HASHVALUE];
      PNTHASHPTR[HASHVALUE] = CURINTNAME; # ADD TO FRONT OF CHAIN # 
      #FIX LINK IN NEW ENTRY# 
      PNTLINK[VIRTUAL(VMPNT,CURINTNAME)] = SEARCHSTART; 
  
      IF SEARCHSTART EQ 0 
      THEN
        MATCH = 0;   # NO OTHER ENTRIES ON CHAIN #
      ELSE
        NOQPNTSEARCH(USEPNT,CURINTNAME,SEARCHSTART,0,MATCH);
      # RETURNS MATCH = 0 IF NO MATCH # 
      IF MATCH GR 0 THEN # NEW ENTRY NOT UNIQUE # 
        BEGIN 
          REALMATCH = VIRTUAL(VMPNT,MATCH); 
          IF CCTIDBUG[0] THEN 
              BEGIN 
              IF PNTIDUNQ[REALMATCH] EQ UNQ"UNIQUE" THEN
                  PNTIDUNQ[REALMATCH] = UNQ"FIRST"; 
              ELSE
                  IF PNTIDUNQ[REALMATCH] EQ UNQ"LAST" THEN
                      PNTIDUNQ[REALMATCH] = UNQ"INBETWEEN"; 
              END 
          IF PNTSECTION[REALMATCH] EQ 1 AND 
             PNTAMBIGUOUS[REALMATCH] EQ 0 THEN
            # HIT IS A SECTION  WHICH HASN[T BEEN DIAGNOSED YET # 
            BEGIN 
              PNTAMBIGUOUS[REALMATCH] = 1;
              PNTDIAG (D1036, REALMATCH); 
            END 
          REALPNT = VIRTUAL(VMPNT,CURINTNAME);
          PNTNOTUNIQUE[REALPNT] = 1;
          IF CCTIDBUG[0] THEN PNTIDUNQ[REALPNT] = UNQ"LAST";
          IF PNTSECTION[REALPNT] EQ 1 THEN #NEW IS SECTION# 
            BEGIN 
              PNTAMBIGUOUS[REALPNT] = 1;
              PNTDIAG (D1036, REALPNT); 
            END 
          IF PNTSECTION[VIRTUAL(VMPNT,CURINTNAME)] EQ 0  AND
             PNTSECTION[VIRTUAL(VMPNT,MATCH)]      EQ 0  AND
             PNTSEGORSECT[VIRTUAL(VMPNT,CURINTNAME)]
          EQ PNTSEGORSECT[VIRTUAL(VMPNT,MATCH)] THEN
           # NEW AND HIT ARE PARA[S IN THE SAME SECTION # 
            BEGIN 
              REALPNT = VIRTUAL(VMPNT,CURINTNAME);
              PNTAMBIGUOUS[REALPNT] = 1;
              PNTDIAG (D1037, REALPNT); 
              REALMATCH = VIRTUAL(VMPNT,MATCH); 
              IF PNTAMBIGUOUS[REALMATCH] EQ 0 THEN
                BEGIN 
                  PNTAMBIGUOUS[REALMATCH] = 1;
                  PNTDIAG (D1037, REALMATCH); 
                END 
            END 
        END # OF MATCH GR 0 # 
      ELSE
          IF CCTIDBUG[0] THEN 
              PNTIDUNQ[VIRTUAL(VMPNT,CURINTNAME)] = UNQ"UNIQUE";
  
      # NOW CHECK FOR DNT-PNT CLASHES # 
  
      SEARCHSTART = DNTHASHPTR[HASHVALUE]; # GET START OF CHAIN # 
      IF SEARCHSTART EQ 0 
      THEN
        MATCH = 0;   # NO OTHER ENTRIES ON CHAIN #
      ELSE
        NOQDNTSEARCH(USEPNT,CURINTNAME);
      IF MATCH NQ 0 THEN # PNT ENTRY MATCH DNT ENTRY #
        BEGIN 
          #IS IT FIRST OCCURRENCE#
          IF PNTNOTUNIQUE[VIRTUAL(VMPNT,CURINTNAME)] EQ 0 THEN
            BEGIN 
              I = MATCH;
              REALMATCH = VIRTUAL(VMDNT,I); 
              ASLONGAS DNTNOTUNIQUE[REALMATCH] EQ 1 DO
                BEGIN 
                  DNTDIAG (D1053, REALMATCH); 
                  I = DNTLINK[REALMATCH]; 
                  REALMATCH = VIRTUAL(VMDNT,I); 
                END 
                DNTDIAG (D1053, REALMATCH); 
                #LAST OF DUPLICATES HAS NOTUNIQUE = 0#
            END 
          REALPNT = VIRTUAL(VMPNT,CURINTNAME);
          PNTDIAG (D1038, REALPNT); 
        END 
  
      GETNEXTPNT ; # GET NEXT FREE PNT ENTRY #
      RETURN; 
    END # OF PNTBUILD # 
CONTROL EJECT;
  
   PROC DNTEXTRA; 
    # ALLOCATE AN EMPTY DNT ENTRY # 
  
  ITEM EXTRADNT U;
    BEGIN 
      # CALLED WHEN SECTION HEADER IS SEEN IN DATA DIVISION.
        FINISH UP THE SCOPE PROCESSING FOR THE PREV. SECTION.#
      CURINTNAME = DNTNEXT; 
      SETSCOPE(0);
      # INITIALIZE ENTRY #
      #  THE NEW DNT ENTRY WILL BE ZERO (VIRTUAL DOES THIS) # 
    EXTRADNT = VIRTUAL (VMDNT, DNTNEXT);
      GETNEXTDNT; 
      RETURN; 
    END # OF DNTEXTRA # 
CONTROL EJECT;
  
   PROC  DECLPNT; 
          # THIS PROCEDURE BUILDS THE PNT-ENTRIES FOR THE SECTION  #
          # NAME AND THE PARAGRAPH NAME THAT THE SCANNER GENERATES #
          # AFTER THE END-DECLARATIVES ATOM.                       #
  
          BEGIN 
           REALPNT = VIRTUAL(VMPNT,PNTNEXT);
           PNTINFO[REALPNT] = 0;
          PNTNAMEINFO[REALPNT] = 0; 
           PNTLINE[REALPNT] = 0;
           PNTCOLUMN[REALPNT] = 0;
           PNTSECTION[REALPNT] = 1; 
          PNTDEBUG[REALPNT] = 1;
           LASTSECTION = PNTNEXT; 
           GETNEXTPNT;  # GET NEXT FREE PNT ENTRY # 
          REALPNT = VIRTUAL(VMPNT,PNTNEXT); 
          PNTINFO[REALPNT] = 0; 
          PNTNAMEINFO[REALPNT] = 0; 
          PNTLINE[REALPNT] = 0; 
          PNTCOLUMN[REALPNT] = 0; 
          PNTSEGORSECT[REALPNT] = LASTSECTION;
          PNTDEBUG[REALPNT] = 1;
          GETNEXTPNT;  #GET NEXT FREE PNT ENTRY # 
          RETURN; 
          END   # DECLPNT # 
CONTROL EJECT;
  
   PROC  DNTBUILD;
    # BUILD NEW DNT ENTRY # 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," DNTBUILD CALLED.",0,17);
      $END
      # THE FOLLOWING THINGS ARE DONE :   
        1. LEVEL IN LEVELNUMVALU IS TRANSLATED INTO NEW LEVEL.
           01 BECOMES 1 EXCEPT IN W-S SEC OR LINK SEC WHERE IT IS 0 
           02 TO 49 STAY THE SAME 
           LEVEL INDICATORS ( RD FD ETC.) ARE 0 
           77 BECOMES 50
           88 BECOMES 51
           66 BECOMES 52
           INDEXES BECOME 53
           MNEMONICS BECOME 54
        2. IF NAME IS NULL OR FILLER, NO HASH, LINK , SEARCH OR SCOPE 
            IS SET. 
        3. HASH THE NAME
        4. LINK NEW ENTRY TO END OF CHAIN- CHAIN RUNS BACKWARDS 
        5. SET SCOPE OF PROCEEDING GROUP ENTRIES
        6. SEARCH TO SEE IF NEW ENTRY IS UNIQUE 
        7. FILL IN THE FIELDS OF THE NEW DNT ENTRY AS MUCH AS POS.
      # 
      CURINTNAME = DNTNEXT; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"CURINAME= ",DEC(CURINTNAME)); 
      $END
  
      # NOW TRANSLATE TO GET NEW LEVEL #
  
      FOR I = 0 STEP 1 UNTIL 9 DO 
        BEGIN 
          IF DNTLEVEL1[I] EQ LEVELNUMVALU THEN
            BEGIN 
              CURRENTLEVEL = DNTLEVEL2[I];
              GOTO LEVELEND;
            END 
        END 
      CURRENTLEVEL = LEVELNUMVALU; # WAS 02 TO 49 # 
    LEVELEND: 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"CURLEVEL= ",DEC(CURRENTLEVEL)); 
      $END
  
      # NOW FILL IN SCOPES OF EACH ENTRY WHOSE RANGE IS ENDED 
        BY THE NEW ENTRY. FOR THE PURPOSES OF THIS OPERATION
        , IF THE NEW ENTRY IS LEVEL 52 (66) WE TREAT IS AS 2, 
        IF 53 (INDEX) WE TREAT IT AS 50 SO IT WILL TERMINATE
        77[S BUT NOTHING ELSE, IF 51 OR 54 SETSCOPE IS NOT
         CALLED SINCE 88[S AND MNEMONICS CAN[T END GROUPS.
      # 
  
      LASTGROUPIN = SCOPEINTNAME[SCOPESP]; # MIGHT NEED IT LATER# 
      I = CURRENTLEVEL; 
      IF CURRENTLEVEL EQ 52 THEN I=2; 
      ELSE IF CURRENTLEVEL EQ 53 THEN I=50; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2," SLEVEL= ",DEC(I)); 
      $END
  
      IF CURRENTLEVEL NQ 51 AND CURRENTLEVEL NQ 54 THEN 
        SETSCOPE(I); # SET SCOPES OF ALL GROUPS ENDED BY NEW DNT #
      IF CURRENTLEVEL LQ 50 THEN # PUT OF SCOPESTACK SO THAT
                                   SCOPE WILL BE SET LATER #
        BEGIN 
          SCOPESP = SCOPESP + 1;
          IF SCOPESP EQ SCOPEMAX THEN # STACK OVERFLOW #
            BEGIN 
              $BEGIN
              DISPLAY(2," SCOPE STACK OVERFLOW.",0,22); 
              $END
              RETURN; 
            END 
          SCOPELEVEL[SCOPESP] = CURRENTLEVEL; 
          SCOPEINTNAME[SCOPESP] = CURINTNAME; 
          $BEGIN
            IF INDEBUG THEN OUTPUT(6,"SCOPESP = ",DEC(SCOPESP), 
              "SCLEVEL = ",DEC(CURRENTLEVEL),"SCINTNAME=",
                                             DEC(CURINTNAME));
          $END
        END 
  
      # NOW MOVE NAME INTO DNT IF THERE IS ONE #
      REALDNT = VIRTUAL(VMDNT,CURINTNAME); #CALC VIRTUAL INDEX# 
      IF FILLERSWITCH THEN  # NO NAME TO LOOK UP #
        BEGIN 
        DNTFILLER[REALDNT] = TRUE;   # SET AS FILLER #
          # NO OTHER INFO IS NEEDED IF NO NAME SINCE ENTRY IS ZERO #
        END 
  
      ELSE # THERE IS A NAME #
        BEGIN 
          $BEGIN
            IF INDEBUG THEN OUTPUT(2," ADD NAME ","TO DNT");
          $END
          BUILDENT(USEDNT,STRINGAREA); # BUILD NAME ENTRY # 
  
          IF CCTFIPSLEVEL LS 3 AND
             C<0,1> SAREA[0] GQ "0" AND 
             C<0,1> SAREA [0] LQ "9"
          THEN BEGIN
               #FIPS = 3 SUPPORTS DATA NAMES BEGINNING# 
               # WITH A NUMERIC DIGIT#
               SSDIAGS (D1401); 
               END
          # ADD INTERNAL NAMES TO ARRAY TO PUT IN LISTING LINE #
  
          IF INTLISTPTR LS 2 THEN # UP TO 3 NAMES PER  LINE # 
            BEGIN 
              INTLISTPTR = INTLISTPTR + 1;
              LISTNAME[INTLISTPTR] = CURINTNAME;
            END 
  
          # NOW LOOK NAME UP TO SEE IF UNIQUE # 
  
          HASHVALUE = HASHER(USEDNT,CURINTNAME); #HASH STRING#
          SEARCHSTART = DNTHASHPTR[HASHVALUE];
          DNTHASHPTR[HASHVALUE] = CURINTNAME; # ADD NEW ENTRY TO
                         CHAIN. NEW ENTRY LINK FIXED LATER #
  
          # NOQDNTSEARCH RETURNS MATCH =0 IF NO MATCH. IF MATCH 
            NOT = 0 THEN POINTTOMATCH IS ENTRY AHEAD OF MATCH 
            IN THE CHAIN. # 
  
          IF SEARCHSTART EQ 0 
          THEN
            MATCH = 0;   # NO ENTRIES ON CHAIN #
          ELSE
            NOQDNTSEARCH(USEDNT,CURINTNAME);
  
          IF MATCH NQ 0 THEN  # FOUND MATCH - CHECK FOR ERRORS #
            BEGIN 
  
              # IF INTERACTIVE DEBUGGING SET UP DNTIDUNQ FIELD         #
              IF CCTIDBUG[0] THEN 
                  BEGIN 
                  I = VIRTUAL(VMDNT,MATCH); 
                  IF DNTIDUNQ[I] EQ UNQ"UNIQUE" THEN
                      DNTIDUNQ[I] = UNQ"FIRST"; 
                  ELSE
                      IF DNTIDUNQ[I] EQ UNQ"LAST" THEN
                          DNTIDUNQ[I] = UNQ"INBETWEEN"; 
              END 
  
              # REMOVE ENTRY FROM BEGINNING OF CHAIN AND INSERT 
                JUST AHEAD OF MATCH OF CHAIN. THIS KEEPS LIKE 
                ENTRIES TOGETHER. # 
  
              IF POINTTOMATCH NQ 0 THEN 
                BEGIN 
                  DNTHASHPTR[HASHVALUE] = SEARCHSTART; # RESTORE
                                    OLD START OF CHAIN #
                  DNTLINK[VIRTUAL(VMDNT,POINTTOMATCH)] = CURINTNAME;
                  #PUT NEW ENTRY IN FRONT OF MATCH# 
                  SEARCHSTART = MATCH; # SEARCHSTART IS PUT IN
                                 LINK FIELD OF NEW LATER #
                  $BEGIN
                    IF INDEBUG THEN OUTPUT(1," RELINK "); 
                    IF INDEBUG THEN OUTPUT(4," HIT = ", 
                      DEC(DNTHASHPTR[HASHVALUE])," LINK = ",
                      DEC(CURINTNAME)); 
                  $END
                END 
  
              #ELSE NEW ENTRY IS ALREADY IN CORRECT POSITION #
  
              # NOW CHECK NOTUNIQUE SWITCH FOR MATCH. IF 1 THEN 
                IT IS NOT 1ST OCCURRENCE OF NAME AND ALL PREV.
                ENTRIES HAVE ALREADY BEEN DIAGNOSED # 
  
              REALDNT = VIRTUAL(VMDNT,MATCH); 
              IF DNTNOTUNIQUE[REALDNT] EQ 0 THEN #DIAG. INDEP. ITEMS# 
                BEGIN 
                  I = DNTLEVEL[REALDNT];
                  IF I EQ 50 OR I EQ 0 OR I GR 52 THEN
                    BEGIN 
                    DNTDIAG (D1021, REALDNT); 
                    END 
                END 
              DNTNOTUNIQUE[VIRTUAL(VMDNT,CURINTNAME)] = 1;
              IF CCTIDBUG[0] THEN 
                  DNTIDUNQ[VIRTUAL(VMDNT,CURINTNAME)] = UNQ"LAST";
              #SET NEW ENTRY SWITCH#
  
              # IF NEW ENTRY IS INDEP. ITEM OR HIGHEST LEVEL ITEM 
                THEN DIAGNOS IT # 
  
              IF CURRENTLEVEL EQ 50 OR CURRENTLEVEL EQ 0 OR 
                 CURRENTLEVEL GR 52 THEN
                BEGIN 
                  SSDIAGS (D1021);
                END 
              ELSE # NEW IS 1 TO 49 OR 51 OR 52 . IF DNT GROUP BIT IN 
                     ANY ENTRY WITH SAME NAME IS 0 THEN HAVE ERROR #
                BEGIN 
                  I = MATCH;
                  IF CURRENTLEVEL LS 50 
                  THEN
                    K=SCOPEINTNAME[SCOPESP-1];   # INT OF FIRST QUAL #
                  ELSE
                    K=SCOPEINTNAME[SCOPESP];     # INT OF FIRST QUAL #
                  DOFOREVER 
                    BEGIN 
                      REALDNT = VIRTUAL(VMDNT,I); 
                      IF DNTGROUP[REALDNT] EQ 0 THEN #ITS A QUALIFIER#
                        BEGIN 
                          SSDIAGS (D1022);
                          GOTO ENDLOOP1;
                        END 
                      ELSE
                        BEGIN 
                        IF I GR K 
                        AND CURRENTLEVEL EQ DNTLEVEL[REALDNT] 
                        THEN
                          BEGIN  # ANOTHER NAME IN SAME HIERARCHY SAME #
                          SSDIAGS (D1095);
                          K=9999999;  #ONLY DIAGNOSE ONE #
                          END 
                        IF DNTNOTUNIQUE[REALDNT] EQ 0 THEN
                          GOTO ENDLOOP1; #NO PREVIOUS OCCURRENCES#
                        ELSE
                          I = DNTLINK[REALDNT];  #LINK TO NEXT ENTRY# 
                        END 
                    END # OF DOFOREVER #
                ENDLOOP1: 
                  END 
              END # OF MATCH NQ 0 STUFF # 
              ELSE
                  IF CCTIDBUG[0] THEN 
                      DNTIDUNQ[VIRTUAL(VMDNT,CURINTNAME)] = UNQ"UNIQUE";
          END # OF STUFF WITH A NAME #
  
          # THIS CORRESP. TO ITS_UNIQUE_L IN OLD SSCANNER # 
  
          # FINISH FILLING IN FIELDS IN NEW DNT ENTRY # 
  
          REALDNT = VIRTUAL(VMDNT,CURINTNAME);
          DNTLINK[REALDNT] = SEARCHSTART; 
          DNTCOLUMN[REALDNT] = CLACOLUMN; 
          DNTLINE[REALDNT] = CLALINE; 
          DNTLEVEL[REALDNT] = CURRENTLEVEL; 
          # DNTNOTUNIQUE IS SET TO 1 IF NECESSARY ALREADY#
          GETNEXTDNT ; # READY FOR NEXT DNT DEFINITION #
          IF CURRENTLEVEL GR 50 THEN DNTGROUP[REALDNT] = 1; 
                                      # SET GROUP BIT IF LEVEL GR 50# 
                                # REMEMBER ENTRY IS NOT PUT IS SCOPE
                                  STACK IF LEVEL GR 50, SO SCOPE=0 #
          IF CURRENTDIV EQ REPORTSEC AND CURRENTLEVEL EQ 0 THEN 
            #SAVE 2 ENTRIES FOR LINE AND PAGE COUNTER#
            BEGIN 
              IF LASTRD NQ 0 THEN RDAMBIG = TRUE; 
              LASTRD = CURINTNAME;
              REALDNT = VIRTUAL(VMDNT, DNTNEXT);
              DNTSREG[REALDNT] = TRUE;
              DNTSREGVAL[REALDNT] = S"PAGE$CTR";  # SET PAGE-COUNTER #
              GETNEXTDNT; 
              REALDNT = VIRTUAL(VMDNT, DNTNEXT);
              DNTSREG[REALDNT] = TRUE;
              DNTSREGVAL[REALDNT] = S"LINE$CTR";  # SET LINE-COUNTER #
              GETNEXTDNT; 
            END 
          ELSE
          IF LEVELNUMVALU EQ 51 THEN # HAVE FD SAVE ENTRY FOR 
                                       LINAGE-COUNTER # 
            BEGIN 
              LASTFD = CURINTNAME; # SAVE FD NAME#
              REALDNT = VIRTUAL(VMDNT, DNTNEXT);
              DNTSREG[REALDNT] = TRUE;
              DNTSREGVAL[REALDNT] = S"LINAGE$CTR";  #SET LINAGE-COUNTER#
              GETNEXTDNT; 
            END 
  
      RETURN; 
    END # OF DNTBUILD # 
CONTROL EJECT;
  
   PROC  AWRTRESOLVE; 
    # RESOLVE THE AWRT ENTRIES AND BUILD THE INT. WE GO 
      FORWARDS THRU THE AWRT #
  
    BEGIN 
      ITEM QUALIFIER U; #HOLDS INT. NAME OF QUALIFIER#
      $BEGIN
        IF INDEBUG THEN DISPLAY(2," AWRTRESOLVE CALLED.",0,20); 
      $END
      #THE CODE FIELD IN THE AWRT INDICATES IF IT IS A DNREF, A PNREF,
       ONE OF THESE TWO, OR A SPECIAL REGISTER (EG LINE-COUNTER)# 
      INTNEXT = 1;
      AWRTQUALIF[VIRTUAL(VMAWRT,AWRTNEXT)] = 0; #STOPPER FOR LAST REF#
      AWRTPTR = 1; # START AT FIRST AWRT ENTRY #
      TMFIXSZ(VMAWRT);   # FIX IN SIZE - AWRT IS AS LOGN AS IT WILL BE #
      TMSETRO(VMAWRT);   # SET READ ONLY - NOTHING MORE PUT IN AWRT # 
      TMSETRO(VMDNT);  # WILL NO LONGER CHANGE #
      TMSETRO(VMPNT);  # SET READ ONLY - WILL BE CLEARED IN PNATBUILD # 
      TMFIXSZ(VMDNT);   # WILL NOT GROW ANY MORE #
      ASLONGAS AWRTPTR LS AWRTNEXT DO #PROCESS REFERENCES IN AWRT#
        BEGIN 
          SWITCH AWRTSWITCH , PNREF,DNREF,SPECREG,PNORDN,CORRITEM;
          REALAWRT = VIRTUAL(VMAWRT,AWRTPTR); 
          REFLINENUM = AWRTLINE[REALAWRT];
          CODE = AWRTCODE[REALAWRT];
          $BEGIN
            IF INDEBUG THEN OUTPUT(2," AWRTCODE=",DEC(CODE)); 
          $END
          GOTO AWRTSWITCH[CODE];
  
        PNREF:  
          BEGIN # RESOLVE A PROCEDURE-NAME REFERENCE #
  
            # REMEMBER CHAINS IN THE PNT RUN STRICTLY BACKWARDS,
              SO WE GO FROM LAST DEFINED TO FIRST DEFINED. WE 
              WILL SET UP HIT AND UNIQUEHIT FOR INTBUILD .
              HIT = 0 IF REF. IS UNDEFINED, OTHERWISE 
              HIT = INT. NAME OF REF. AND UNIQUEHIT INDICATES IF
              IT IS AMBIGUOUS. #
  
            UNIQUEHIT = TRUE; 
            # GET FIRST ENTRY ON CHAIN WITH SAME NAME AS AWRT ENTRY#
            SEARCHSTART = PNTHASHPTR[HASHER(USEAWRT,AWRTPTR)];
            IF SEARCHSTART EQ 0 
            THEN
              HIT = 0;   # NO ENTRIES ON CHAIN #
            ELSE
              NOQPNTSEARCH(USEAWRT,AWRTPTR,SEARCHSTART,0,HIT);
            # HIT = 0 IF NO MATCH FOUND, ELSE HIT= INT. NAME #
            QUALIFIER = AWRTIMMED[VIRTUAL(VMAWRT,AWRTPTR)]; 
            #ONLY USED FOR PARAGRAPH NAME WITH NO QUALIFIER#
            GETAWRTENTRY; # SEE IF HAVE A QUALIFIER # 
  
            IF AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 THEN
              BEGIN 
                # FIND THE INT. NAME OF THE QUALIFIER # 
                SEARCHSTART = PNTHASHPTR[HASHER(USEAWRT,AWRTPTR)];
                IF SEARCHSTART EQ 0 
                THEN
                  QUALIFIER = 0;   # NO ENTRIES ON CHAIN #
                ELSE
                  NOQPNTSEARCH(USEAWRT,AWRTPTR,SEARCHSTART,0, 
                      QUALIFIER); 
                # QUALIFIER = 0 IF NO MATCH FOUND # 
  
                # ONLY SECTION NAMES CAN QUALIFY. KEEP SEARCHING
                  IF WE DON[T HAVE A SECTION NAME # 
                ASLONGAS PNTSECTION[VIRTUAL(VMPNT,QUALIFIER)] EQ 0 AND
                         QUALIFIER GR 0 DO
                  BEGIN 
                    SEARCHSTART = PNTLINK[VIRTUAL(VMPNT,QUALIFIER)];
                    IF SEARCHSTART EQ 0 
                    THEN
                      QUALIFIER = 0;   # NO ENTRY ON CHAIN #
                    ELSE
                      NOQPNTSEARCH(USEAWRT,AWRTPTR, 
                                 SEARCHSTART,0,QUALIFIER);
                  END 
                IF QUALIFIER EQ 0 THEN HIT = 0; # UNDEF. REF.#
                GETAWRTENTRY; 
                # CHECK FOR TOO MANY QUALIFIERS # 
  
                IF AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 THEN
                  BEGIN 
                    # SKIP EXTRA QUALIFIERS # 
                    GETAWRTENTRY; 
                    ASLONGAS AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 
                      DO GETAWRTENTRY;
                    RLDIAG(D1048);
                    HIT = 0;
                  END 
  
                # NOW WE HAVE THE INT. NAME OF THE QUALIFIER
                  IN QUALIFIER AND THE QUALIFIEE IN HIT # 
                # RUN DOWN CHAIN STARTING AT HIT TO FIND A
                  PARA. NAME WHICH IS DEFINED IN THE SECTION
                  INDICATED BY THE QUALIFIER #
  
                ASLONGAS HIT GR QUALIFIER DO
                  BEGIN 
                    REALPNT = VIRTUAL(VMPNT,HIT); 
                    IF PNTSECTION[REALPNT] EQ 0 AND 
                       PNTSEGORSECT[REALPNT] EQ QUALIFIER THEN #FOUND#
                      GOTO PNESCAPE1; 
                    # ELSE CONTINUE DOWN THE CHAIN #
                    SEARCHSTART = PNTLINK[REALPNT]; 
                    IF SEARCHSTART EQ 0 
                    THEN
                      HIT = 0;   # NO ENTRY ON CHAIN #
                    ELSE
                      NOQPNTSEARCH(USEPNT,HIT,SEARCHSTART,QUALIFIER,
                          HIT); 
                  END 
  
                HIT = 0; # UNDEFINED QUAL. IF GET TO HERE # 
              PNESCAPE1:  
              END # OF AWRTQUALIF EQ 1 #
  
            ELSE # NOT QUALIFIED #
              BEGIN 
                IF PNTSECTION[VIRTUAL(VMPNT,HIT)] EQ 0 THEN #PARA NAME# 
                  BEGIN 
                    # FIND A MATCHING PARA. NAME IN CORRECT SEC.# 
  
                   ITEM PNDEFCOUNT, FIRSTHIT ;
                   PNDEFCOUNT = 0;
                   FIRSTHIT = HIT;  # SAVE ORIGINAL HIT # 
  
                    ASLONGAS HIT GR     0     DO # SEARCH # 
                      BEGIN 
                        PNDEFCOUNT = PNDEFCOUNT + 1;
                        IF PNTSEGORSECT[VIRTUAL(VMPNT,HIT)] 
                        EQ QUALIFIER THEN 
                          GOTO PNESCAPE2; # FOUND IT #
                        # ELSE TRY FURTHER DOWN CHAIN # 
                        SEARCHSTART = PNTLINK[VIRTUAL(VMPNT,HIT)];
                          IF SEARCHSTART EQ 0 
                          THEN
                            HIT = 0;  # NO ENTRY ON CHAIN # 
                          ELSE
                            NOQPNTSEARCH(USEPNT,HIT,SEARCHSTART,0,HIT); 
                      END 
  
                     # THE REF WASN"T IN THE SAME SECTION AS THE
                       DEF IF GOT TO HERE. TO BE UNIQUE THEN, THERE 
                       CAN"T BE MORE THAN ONE PARA-NAME WITH THE
                       SAME CHARACTER STRING IN THE PROGRAM # 
  
                     IF PNDEFCOUNT GR 1 THEN
                       UNIQUEHIT = FALSE; 
                     ELSE 
                       HIT = FIRSTHIT;
                       QUALIFIER = 0; 
                   PNESCAPE2: 
                   END
               END # OF NOT QUALIFIED # 
  
            # NOW CHECK FOR AMBIGUITY AND CALL INT TABLE BUILDER# 
  
            IF PNTAMBIGUOUS[VIRTUAL(VMPNT,HIT)] EQ 1
            OR PNTAMBIGUOUS[VIRTUAL(VMPNT,QUALIFIER)] EQ 1 THEN 
              UNIQUEHIT = FALSE;
            PROCNAME = TRUE; # INT. ENTRY IS FOR A PROC. NAME # 
            INTBUILD; 
            GOTO CASEEND; 
          END 
CONTROL EJECT;
        DNREF:  
          BEGIN # RESOLVE A DATA-NAME REFERENCE # 
            # PNRESOLVE RETURNS 2 THINGS : HIT AND UNIQUEHIT .
              1. HIT = 0 IF UNDEFINED ELSE HIT = INT. NAME OF REF.
              2. HIT NQ 0 THEN REF IS AMBIGUOUS IF NOTUNIQUE = FALSE# 
  
              HIT = 0; UNIQUEHIT = TRUE; # INITIALIZATION # 
              DNREFRESOLVE; 
              IF HIT EQ 0 THEN # UNDEFINED REFERENCE #
                BEGIN 
                  IF LISTPTR EQ LISTBOTTOM-1 THEN #UNQUALIFIED# 
                    BEGIN 
                      #UNDEFINED REFS ARE TREATED AS IF THEY ARE
                       IMPLEMENTOR NAMES IF UNQUALIFIED. THIS WILL
                       HAPPEN FOR LANGUAGE AND ROUTINE NAMES. # 
                      HIT = PLTNEXT;
                      PLTBUILDIMP; # BUILD PLT ENTRY FOR IMPL. NAME # 
                      IMPLNAME = TRUE; # COULD BE IMPL. NAME #
                      INTBUILD; 
                      IMPLNAME = FALSE; 
                    END 
                  ELSE
                    INTBUILD; 
                END 
              ELSE
              INTBUILD; # BUILD INT ENTRY FOR THIS REF #
              GOTO CASEEND; 
            END 
CONTROL EJECT;
          SPECREG:  
            BEGIN # RESOLVE A SPECIAL REGISTER REFERENCE #
  
              # THE AWRTSREG FIELD GIVES THE SPECIAL REGISTER AS
                FOLLOWS:  
                0  LINE-COUNTER    5  DEBUG-NAME
                1  LINAGE-COUNTER  6  DEBUG-SUB-1 
                2  PAGE-COUNTER    7  DEBUG-SUB-2 
                3  DEBUG-ITEM      8  DEBUG-SUB-3 
                4  DEBUG-LINE      9  DEBUG-CONTENTS
                10 DEBUG-NUMERIC-CONTENTS 
                11 HASHED-VALUE 
                THESE ARE ALSO ALL DEFINED IN THE STATUS LIST DNTSREGVAL
              # 
              # AWRTIMMED FIELD IS 0 IF THE SPECIAL REG. IS NOT IN AN 
                RD, ELSE IT IS THE INT. NAME OF THE LAST RD. THIS IS
                USED FOR IMPLICIT QUALIFICATION OF LINE- AND PAGE-
                COUNTER IN RD[S.
                LASTRD AND FDLINAGE CONTAIN 0 IF NO RD OR FD WITH LINAGE
                CLAUSE, ELSE THE INTERNAL NAME OF THE LAST SUCH ITEM. 
                FDAMBIG AND RDAMBIG ARE TRUE IF THERE ARE MORE THAN 1 OF
                THE RESPECTIVE ABOVE ITEMS. THIS IS USED TO RECOGNIZE 
                AMBIGUOUS REFERENCES .
              # 
  
              ITEM REG U; # HOLDS TYPE OF SPEC. REG. WE ARE HANDLING #
              # THIS ARRAY USES THE SPECIAL REGISTER CODE AS INDEX
                TO GIVE THE DNT ENTRY # 
              ARRAY SREGTODNT [0:11]; 
                ITEM SREGDNTINDEX U(0,0,60) = [0,0,0,2,3,5,7,9, 
                                               11,13,14,1]  ; 
  
              REG = AWRTSREG[VIRTUAL(VMAWRT,AWRTPTR)];
              GETAWRTENTRY;  # SEE IF HAVE QUALIFIER #
              IF AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 THEN
                BEGIN 
                  SWITCH SREGSWITCH1 SRLINE,SRLINAGE,SRPAGE,SRDITEM,
                                     SRDLINE,SRDNAME,SRDSUB1,SRDSUB2, 
                        SRDSUB3,SRDCONTENTS,SRDNC,SRHASH; 
                  $BEGIN
                    IF INDEBUG THEN OUTPUT(2," SRSW1 = ",DEC(REG)); 
                  $END
                  GOTO SREGSWITCH1[REG];
  
                SRLINE: SRLINAGE: SRPAGE: 
                  BEGIN 
                    # LOOK UP QUALIFIER # 
                    I = HASHER(USEAWRT,AWRTPTR);
                    SEARCHSTART = DNTHASHPTR[I];
                      IF SEARCHSTART EQ 0 
                      THEN
                        HIT = 0;
                      ELSE
                        BEGIN 
                        NOQDNTSEARCH(USEAWRT,AWRTPTR);
                        HIT = MATCH;
                        END 
                    # HIT CONTAINS INT. NAME OF QUALIFIER OR 0 #
                    IF HIT NQ 0 THEN # NOT UNDEFINED #
                      IF DNTNOTUNIQUE[VIRTUAL(VMDNT,HIT)] EQ 1 THEN 
                        #ITS NOT UNIQUE#
                        UNIQUEHIT = FALSE;
                      ELSE
                        BEGIN 
                          UNIQUEHIT = TRUE; 
                          #FIND REFERENCE AND CHECK QUALIFICATION#
                          IF REG EQ 0 THEN #LINE-COUNTER# 
                            BEGIN 
                              HIT = HIT + 2; #INT. NAME 2 BELOW HIT#
                              REALDNT = VIRTUAL(VMDNT,HIT); 
                              IF NOT DNTSREG[REALDNT] 
                              OR DNTSREGVAL[REALDNT] NQ REG 
                                THEN
                                BEGIN 
                                HIT = 0;
                                RLDIAG(D1059);
                                IF LASTRD EQ 0 THEN 
                                   RLDIAG(D1072); 
                                END 
                            END 
                         ELSE 
                           BEGIN  # LINE-COUNTER OR PAGE-COUNTER #
                           HIT = HIT + 1;  # INT. NAME 1 BELOW HIT# 
                           REALDNT = VIRTUAL(VMDNT,HIT);
                           IF NOT DNTSREG[REALDNT]
                           OR DNTSREGVAL[REALDNT] NQ REG
                           THEN 
                             BEGIN
                             HIT = 0; 
                             IF REG EQ 1
                             THEN 
                               BEGIN
                                RLDIAG(D1061);
                                IF FDLINAGE EQ 0 THEN 
                                   RLDIAG(D1074); 
                                END 
                             ELSE 
                               BEGIN  # IS PAGE-COUNTER # 
                                RLDIAG(D1060);
                                IF LASTRD EQ 0 THEN 
                                   RLDIAG(D1073); 
                                END 
                             END
                            END 
                        END 
  
                    GOTO SRCASEEND1;
                  END # FOR LINE PAGE AND LINAGE #
  
                SRDITEM:          SRHASH: 
                  BEGIN # THESE 2 CANNOT BE LEGALLY QUALIFIED # 
                    HIT = 0; # UNDEFINED #
                    IF REG EQ 3 THEN
                       RLDIAG(D1067); 
                    IF REG EQ 11 THEN 
                       RLDIAG(D1068); 
                    GOTO SRCASEEND1;
                  END 
  
                SRDLINE: SRDNAME: SRDSUB1:SRDSUB2:SRDSUB3:SRDCONTENTS:  
                      SRDNC:  
                  BEGIN # THESE CAN ONLY BE QUALIFIED BY DEBUG-ITEM # 
                    IF AWRTSREG[VIRTUAL(VMAWRT,AWRTPTR)] NQ 3 THEN
                      #NOT DEBUG-ITEM#
                      BEGIN 
                      HIT = 0;
                      RLDIAG(D1062);
                      END 
                    ELSE
                      HIT = SREGDNTINDEX[REG]; # GET DNT INDEX #
                    GOTO SRCASEEND1;
                  END 
  
                SRCASEEND1: 
                  # NOW CHECK FOR MORE QUALIFIERS ( NOT LEGAL) #
                  GETAWRTENTRY; 
                  IF AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 THEN
                    BEGIN  # SKIP AND DIAGNOS EXTRA QUALIFIERS #
                      GETAWRTENTRY; 
                      ASLONGAS AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 
                        DO #FIND END OF QUALIFIERS# 
                        GETAWRTENTRY; 
                      HIT = 0;
                      IF REG EQ 0 THEN
                         RLDIAG(D1063); 
                      IF REG EQ 1 THEN
                         RLDIAG(D1065); 
                      IF REG EQ 2 THEN
                         RLDIAG(D1064); 
                      IF REG GR 3 AND REG LS 11 THEN
                         RLDIAG(D1066); 
  
                    END 
  
                END # OF QUALIFIED CASE # 
  
              ELSE # HAVE NO QUALIFIERS. BEWARE IMPLICIT ONES]# 
                BEGIN 
              #BACKUP PTR TO CORRECT ENTRY# 
              GETPREVAWRT;
                  SWITCH SREGSWITCH2 SRLINE2,SRLINAGE2,SRPAGE2,SRDITEM2,
                                    SRDLINE2,SRDNAME2,SRDSUB12,SRDSUB22,
                     SRDSUB32,SRDCONTENTS2,SRDNC2,
                                        SRHASH2;
                  $BEGIN
                     IF INDEBUG THEN OUTPUT(2," SRSW2 = ",DEC(REG));
                  $END
                  GOTO SREGSWITCH2[REG];
  
                SRLINE2:  
  
                  BEGIN # LINE COUNTER #
                    REALAWRT = VIRTUAL(VMAWRT,AWRTPTR); 
                    IF AWRTIMMED[REALAWRT] EQ 0 THEN #NOT IN RD#
                      BEGIN 
                     # CHECK THAT AN RD EXISTS #
                      IF LASTRD EQ 0 THEN 
                         BEGIN
                         HIT = 0; 
                         RLDIAG(D1072); 
                         END
                      ELSE
                         BEGIN
                         HIT = LASTRD + 2;
                         IF RDAMBIG THEN
                            RLDIAG(D1070);
                         END
                      UNIQUEHIT = NOT RDAMBIG;
                      END 
                    ELSE
                      BEGIN 
                        UNIQUEHIT = TRUE; 
                        HIT = AWRTIMMED[REALAWRT] + 2;
                      END 
                    GOTO SRCASEEND2;
                  END 
  
                SRPAGE2:  
                  BEGIN 
                    REALAWRT = VIRTUAL(VMAWRT,AWRTPTR); 
                    IF AWRTIMMED[REALAWRT] EQ 0 THEN
                      BEGIN 
                        # CHECK THAT AN RD EXISTS FIRST # 
                        IF LASTRD EQ 0 THEN        #UNDEFINED REF#
                           BEGIN
                           HIT = 0; 
                           RLDIAG(D1073); 
                           END
                        ELSE
                           BEGIN
                           HIT = LASTRD + 1;
                           IF RDAMBIG THEN
                              RLDIAG(D1071);
                           END
                        UNIQUEHIT = NOT RDAMBIG;
                      END 
                    ELSE
                      BEGIN 
                        UNIQUEHIT = TRUE; 
                        HIT = AWRTIMMED[REALAWRT] + 1;
                      END 
                    GOTO SRCASEEND2;
                  END 
  
                SRLINAGE2:  
                  BEGIN 
                    IF FDLINAGE EQ 0 THEN         #UNDEFINED REF# 
                       BEGIN
                       HIT = 0; 
                       RLDIAG(D1074); 
                       END
                    ELSE
                       BEGIN
                       HIT = FDLINAGE + 1;
                       IF FDLINAMBIG THEN 
                          RLDIAG(D1069);
                       END
                    UNIQUEHIT = NOT FDLINAMBIG; 
                    GOTO SRCASEEND2;
                  END 
  
                SRDITEM2:SRDLINE2:SRDNAME2:SRDSUB12:SRDSUB22:SRDSUB32:  
                SRDCONTENTS2:          SRHASH2: 
                 SRDNC2:  
                BEGIN # FIRST FEW DNT ENTRIES USED FOR THESE #
                  UNIQUEHIT = TRUE; 
                  HIT = SREGDNTINDEX[REG];
                  GOTO SRCASEEND2;
                END 
  
                SRCASEEND2: 
              #ADVANCE TO NEXT ENTRY# 
              GETAWRTENTRY; 
                END # OF UNQUALIFIED CASE # 
  
              INTBUILD; # BUILD INT ENTRY FOR THIS REFERENCE #
              GOTO CASEEND; 
            END 
CONTROL EJECT;
          PNORDN: 
            BEGIN # TRY TO RESOLVE. TRY IT AS A DNREF FIRST, THEN AS
                    A PNREF # 
              HIT = 0; UNIQUEHIT = TRUE; # INITIALIZATION # 
              DNREFRESOLVE; # SEE IF IT AS A DNREF #
              IF HIT EQ 0 THEN # NOT A DNREF #
                BEGIN 
                  REWINDAWRT1 # POSITION IN AWRT TO START OF REF# 
                  SETINTPRNAME; # SET BIT IN INT TO INDICATE A
                                  PROCEDURE NAME #
                  GOTO PNREF;   # TRY AS A PNREF #
                END 
              ELSE
                INTBUILD; 
              GOTO CASEEND; 
            END 
  
          CORRITEM: 
            BEGIN # REF. IS ALREADY RESOLVED. INT. NAME IS IN THE 
                    IMMEDIATE FIELD OF THE AWRT ENTRY # 
              UNIQUEHIT = TRUE; 
              HIT = AWRTIMMED[VIRTUAL(VMAWRT,AWRTPTR)]; 
              INTBUILD; 
              GETAWRTENTRY; # GET NEXT ENTRY #
              GOTO CASEEND; 
            END 
  
          CASEEND:  
          END # OF PROCESSING LOOP #
  
      RETURN; 
    END # OF AWRTRESOLVE #
CONTROL EJECT;
  
  PROC CORRESOLVE ((PARAM1), PARAM2); 
          ITEM  PARAM1; 
          ITEM  PARAM2; 
  # RESOLVE THE REFERENCE JUST PUT IN THE AWRT AND RETURN THE 
    INTERNAL NAME OF THE REF. IS OK. SAVE THE INT. NAME IN
    SOURCE OR TARGET DEPENDING ON THE 1ST PARAM., WHICH IS 1 IF 
    IT IS A SENDING ITEM AND 2 IF IT IS A RECEIVING ITEM #
  # THE INTERNAL NAME OR 0 IS RETURNED IN PARAM2 #
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"CORRESOLVE"," CALLED.");
      $END
      #SET STOPPER ENTRY FOR THE RESOLVING ROUTINE AND
       BACK UP THE AWRT ONE REFERENCE#
      AWRTPTR = AWRTNEXT; #AWRTPTR IS USED BY THE RESOLVING ROUTINE#
      AWRTQUALIF[VIRTUAL(VMAWRT,AWRTNEXT)] = 0; #INDICATES END OF REF#
        REWINDAWRT1  # REWIND AWRT ONE REFERENCE #
        HIT = 0; UNIQUEHIT = TRUE; # INITIALIZATION # 
        DNREFRESOLVE; # RESOLVE THE REFERENCE. INT. NAME IN HIT # 
        IF HIT NQ 0 AND UNIQUEHIT THEN # RESOLVED OK #
          PARAM2 = HIT; 
        ELSE
          PARAM2 = 0; 
        IF PARAM1 EQ 1 THEN # SENDING FIELD # 
          SOURCE = HIT; 
        ELSE
          TARGET = HIT; 
      RETURN; 
    END # OF CORRESOLVE # 
CONTROL EJECT;
  
   PROC  INITFINDPAIR(PARAM1);
      ITEM CORRSTKASGD B = FALSE; 
          ITEM  PARAM1; 
    # THIS ROUTINE INITIALIZED FINDPAIR. IT GETS THE STARTING 
      POINTS FOR THE "CORRESPONDING" PAIRS SEARCH. IF NO PAIRS
      ARE POSSIBLE ( IE. NO SUBORDINATE ENTRIES TO SOURCE AND 
      TARGET) , THEN 0 IS RETURNED ELSE 1 IS RETURNED.# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"INITFINDPA","IR CALLED.");
      $END
      NOEMPTYSTACK = TRUE;
      STACKPTR = 0; 
      IF NOT CORRSTKASGD
      THEN
        BEGIN 
          P<CORRSTACK> = CMM$ALV (50, 1, 3, SSGRPID, P<CORRSTACK>, 0);
          CORRSTKASGD = TRUE; 
        END 
      # STACK THE ORIGINAL GROUP ITEMS AND GET SONS # 
      SSTACK[STACKPTR] = SOURCE;
      TSTACK[STACKPTR] = TARGET;
      SLEVEL[STACKPTR] = DNTLEVEL[VIRTUAL(VMDNT,SOURCE)]; 
      TLEVEL[STACKPTR] = DNTLEVEL[VIRTUAL(VMDNT,TARGET)]; 
      SOURCE = SON(SOURCE); 
      TARGET = SON(TARGET); 
      IF SOURCE EQ 0 OR TARGET EQ 0 THEN # NO SONS #
        PARAM1 = 0; 
      ELSE
        PARAM1 = 1; 
      RETURN; 
    END # OF INITFINDPAIR # 
CONTROL EJECT;
  
   PROC  FINDPAIR(PARAM1);
          ITEM  PARAM1; 
    # THIS ROUTINE FINDS THE CORRESPONDING PAIRS OF ITEMS AND 
      RETURNS 1    IF IT FINDS A PAIR. IF NO PAIR IS FOUND THEN 
      IT RETURNS 0    , WHICH MEANS ALL PAIRS HAVE BEEN FOUND. THIS 
      ROUTINE IS CALLED ONCE FOR EVERY PAIR IN THE "CORRESPONDING"
      OPERATION.# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"FINDPAIR C","ALLED.");
      $END
      # SOURCE AND TARGET CONTAIN THE NEXT POTENTIAL PAIRS. ONE 
        MUST BE ELEMENTARY AND NOT FILLER TO HAVE A LEGAL PAIR. # 
  
      ASLONGAS NOEMPTYSTACK DO
         # DO UNTIL A PAIR IS FOUND OR THE END IS SEEN.#
        BEGIN 
        #GET SOURCE NAME AND COMPARE AGAINST TARGET NAME# 
        NAMEGET(USEDNT,SOURCE);    # GET NAME OF ITEM # 
        BIGHASH = DNTBIGHASH[VIRTUAL(VMDNT,SOURCE)];
        REALDNT = VIRTUAL(VMDNT,TARGET);
        IF BIGHASH EQ DNTBIGHASH[REALDNT] 
        AND COMPNAMES(DNTNAMETPTR[REALDNT], DNTNBRWORDS[REALDNT]) 
        THEN
          BEGIN 
            # IF EQTHER SOURCE OR TARGET IS ELEMENTARY, THEY CORR-
              ESPOND ( EXCEPT FILLER). IF BOTH SOURCE AND TARGET
              ARE GROUPS, THEY ARE BOTH ADDED TO THE STACKS AND 
              THEIR SONS REPLACE THEM AS POSSIBLE PAIRS.# 
  
            IF SON(SOURCE) EQ 0 THEN
              IF DNTFILLER[VIRTUAL(VMDNT,TARGET)] 
              THEN   # FILLER ENTRY # 
                BEGIN 
                  GETNEWSOURCE; 
                  IF STACKPTR EQ -1 THEN # END OF PROCESSING #
                    BEGIN 
                      PARAM1 = 0; RETURN; 
                    END 
                  GOTO CORRLOOPEND; 
                END 
              ELSE # FOUND A CORRESPONDING PAIR # 
                BEGIN 
                  FOUNDPAIR; PARAM1 = 1;
                GETNEWSOURCE; # FIND NEW STARTING POINTS #
                IF STACKPTR EQ -1 THEN NOEMPTYSTACK = FALSE;
                RETURN; 
                END 
  
            # SOURCE WAS A GROUP ITEM SO CHECK TARGET # 
  
            IF SON(TARGET) EQ 0 THEN # TARGET IS ELEMENTARY#
              IF DNTFILLER[VIRTUAL(VMDNT,TARGET)] 
              THEN   # FILLER ENTRY # 
                BEGIN 
                  # IF    MORE BROTHERS OF TARGET THEN LEAVE SOURCE 
                    AS IS AND ADVANCE THRU BROTHERS OF TARGET UNTIL 
                    ONE IS FOUND WHOSE NAME IS THE SAME AS SOURCE OR
                    UNTIL THERE ARE NO MORE BROTHERS.#
  
                 IF BROTHER(TARGET,TFL) EQ 0 THEN #NO MORE BROTHERS#
                  BEGIN 
                    GETNEWSOURCE; 
                      IF STACKPTR EQ -1 THEN
                        BEGIN 
                          PARAM1 = 0; RETURN; 
                       END
                  END # OF NO MORE BROTHERS # 
                  ELSE
                     TARGET = BROTHER(TARGET,TFL);
                END 
              ELSE # HAVE CORRECT PAIR #
                BEGIN 
                  FOUNDPAIR; PARAM1 = 1;
                  GETNEWSOURCE; 
                  IF STACKPTR EQ -1 THEN NOEMPTYSTACK = FALSE;
                  RETURN; 
                END 
  
            ELSE # HAVE 2 GROUP NAMES, SO STACK THEM AND TRY AGAIN# 
              BEGIN 
                STACKPTR = STACKPTR + 1;
                SSTACK[STACKPTR] = SOURCE;
                TSTACK[STACKPTR] = TARGET;
               SLEVEL[STACKPTR] = DNTLEVEL[VIRTUAL(VMDNT,SOURCE)];
               TLEVEL[STACKPTR] = DNTLEVEL[VIRTUAL(VMDNT,TARGET)];
                SOURCE = SON(SOURCE); 
                TARGET = SON(TARGET); 
              END 
  
          END # OF NAMES THAT MATCH PART# 
        ELSE
          BEGIN 
             IF BROTHER(TARGET,TFL) EQ 0 THEN #NO MORE BROTHERS#
              BEGIN 
                GETNEWSOURCE; 
                IF STACKPTR EQ -1 THEN # END OF SEARCH# 
                    BEGIN 
                       PARAM1 = 0; RETURN;
                     END
              END 
            ELSE
               TARGET = BROTHER(TARGET,TFL);
          END 
  
CORRLOOPEND:  
        END # OF ASLONGAS LOOP #
  
      PARAM1 = 0; # MUST HAVE EMPTY STACK TO GET TO HERE #
  
      RETURN; 
   END # OF FINDPAIR #
CONTROL EJECT;
  
   PROC  SPBTBUILD(PARAM1,PARAM2);
          ITEM  PARAM1; 
          ITEM  PARAM2; 
    # BUILD THE SORT PROCEDURE BOUND TABLE FOR PPARSER# 
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"SPBTBUILD","CALLED.");
      $END
      REALSPBT = VIRTUAL(VMSPBT,SPBTNEXT);
      SPBT$LOBOUND[REALSPBT] = PARAM1;
      SPBT$HIBOUND[REALSPBT]  = PARAM2; 
      SPBT$LINE[REALSPBT] = SPLINE; 
      SPBT$COLUMN[REALSPBT] = SPCOL;
      SPBT$PROC[REALSPBT]   = PNTNEXT-1;
      SPBT$STATUS[REALSPBT] = 0;
      SPBT$TYPE[REALSPBT] = SPTYPE; 
      SPBT$VERB[REALSPBT] = 0;
      SPBT$DNAT[REALSPBT] = SPDNAT; 
      $BEGIN
        IF INDEBUG THEN BEGIN OUTPUT(8,"SPBTNEXT=",DEC(SPBTNEXT), 
                   "SPBTLOW=",DEC(PARAM1),"SPBTHI=",DEC(PARAM2),
                   "SPBTPROC=",DEC(SPBT$PROC[REALSPBT])); 
                OUTPUT(8,"SPYPE=",DEC(SPTYPE),"SPDNAT=",DEC(SPDNAT),
                "SPLINE=",DEC(SPLINE),"SPCOL = ",DEC(SPCOL)); 
              END 
      $END
      GETNEXTSPBT;
      RETURN; 
    END # OF SPBTBUILD #
 CONTROL EJECT; 
  
   PROC  CRLITATOM(QUALIFFLAGS);
       # THIS PROCEDURE CREATES A PLT ENTRY CONTAINING THE NAME # 
       # OF THE DATA-NAME OR THE PROCEDURE-NAME SCANNED.        # 
       # THIS PLT ENTRY IS USED BY THE DEBUGGING FACILITY.       #
  
        BEGIN 
          ITEM QUALIFFLAGS         I; 
          ITEM QUALIFPTR           I; 
          $BEGIN
            IF INDEBUG THEN OUTPUT(2,"STORALLPRO","CS CALLED.");
          $END
          AWRTPTR = AWRTNEXT; 
          AWRTQUALIF[VIRTUAL(VMAWRT,AWRTNEXT)] = 0; 
          REWINDAWRT1     # GET THE LAST ENTRY PUT IN THE AWRT #
          CLENGTH = 1;
          CHSTR = "                              "; 
          STORESTR(USEAWRT,AWRTPTR);
          # STORE THE QUALIFIERS OF THE NAME #
          GETAWRTENTRY; 
          QUALIFPTR = 0;
          # BUILD A PLT ENTRY TO CONTAIN THE GENERATED STRING # 
          REALPLT = VIRTUAL(VMPLAT,PLTNEXT);
          PL$CODE[REALPLT] = PLTQUOTEDLIT;
          PL$LINE[REALPLT] = CLALINE; 
          PL$COLUMN[REALPLT] = CLACOLUMN; 
          PL$STRINGPTR[REALPLT] = NEXTSTRENTRY; 
          ASLONGAS AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)] EQ 1 DO
            BEGIN 
            IF CLENGTH GR 27
            THEN  GOTO PLB; 
            ELSE  BEGIN 
                  IF B<QUALIFPTR,1> QUALIFFLAGS EQ 1
                     THEN C<CLENGTH-1,4> CHSTR = " OF ";
                     ELSE C<CLENGTH-1,4> CHSTR = " IN ";
                  QUALIFPTR = QUALIFPTR + 1;
                  CLENGTH = CLENGTH + 4;
                  STORESTR(USEAWRT,AWRTPTR);
                  END 
             GETAWRTENTRY;
             END
    PLB:  
  
           # STORE THE GENERATED STRING INTO PLT$CHAR # 
          STOREPLTCHAR(CLENGTH);
          PL$LENGTH[REALPLT] = CLENGTH - 1; 
          GETNEXTPLT; 
          RETURN; 
      END  # OF CRLITATOM # 
CONTROL EJECT;
  
   PROC  REDEFRESOLVE;
    # HAVE JUST PARSED "RWREDEFINES A" SO RESOLVE THE REFERENCE. IT 
      IMPLICITLY REFERS TO THE LAST DEFINED ITEM WITH THAT NAME - 
      THIS IS THE FIRST THING ON THE CHAIN WITH THIS NAME. IF IT IS 
      NOT DEFINED YET, THEN THE LOOKUP IS DONE AGAIN AT THE END OF
      S-SCANNER PROCESSING WITH THE OTHER REFERENCES.#
  
    BEGIN 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"REDEFRESOL","VE CALLED.");
      $END
      AWRTPTR = AWRTNEXT; 
      REWINDAWRT1  # GET LAST ENTRY PUT IN AWRT#
      I = HASHER(USEAWRT,AWRTPTR);
      SEARCHSTART = DNTHASHPTR[I];
      IF SEARCHSTART EQ 0 
      THEN
        MATCH = 0;  # NO ENTRY ON CHAIN # 
      ELSE
        NOQDNTSEARCH(USEAWRT,AWRTPTR);
      #IF MATCH IS 0 NO SUCH NAME IS YET DEFINED# 
      IF MATCH NQ 0 THEN
        BEGIN 
          #FIX UP THE AWRT ENTRY# 
          REALAWRT = VIRTUAL(VMAWRT,AWRTPTR); 
          AWRTCODE[REALAWRT] = AWRTCORRITEM;
          AWRTIMMED[REALAWRT] = MATCH;
        END 
      RETURN; 
    END # OF REDEFRESOLVE # 
CONTROL EJECT;
  
   PROC  ALTERLIT(QUALIFLAGS);
  
          # THIS PROCEDURE CREATES A PLT ENTRY CONTAINING THE NAME #
          # OF THE PARAGRAPH FOLLOWING TO IN AN ALTER STATEMENT.   #
          # THIS PLT ENTRY IS USED BY THE DEBUGGING FACILITY.      #
  
          BEGIN 
  
          ITEM QUALIFLAGS              I; 
          ITEM TOTALLENGTH             I; 
          ITEM WDF                     I; 
          ITEM INDX                    I; 
          SWITCH  PFLAG    #WORD0#, WORD1, WORD2, WORD3, SAVE;
  
          AWRTPTR = AWRTNEXT; 
          AWRTQUALIF[VIRTUAL(VMAWRT,AWRTNEXT)] = 0; 
          REWINDAWRT1       #GET THE LAST ENTRY PUT IN THE AWRT # 
          CLENGTH = 1;
          CHSTR = "                              "; 
          STORESTR(USEAWRT,AWRTPTR);
          GETAWRTENTRY; 
          TOTALLENGTH = 0;
  
          # BUILD A PLT ENTRY TO CONTAIN THE GENERATED STRING # 
          REALPLT = VIRTUAL(VMPLAT,PLTNEXT);
          PL$CODE[REALPLT] = PLTQUOTEDLIT;
          PL$LINE[REALPLT] = CLALINE; 
          PL$COLUMN[REALPLT] = CLACOLUMN; 
          PL$STRINGPTR[REALPLT] = NEXTSTRENTRY; 
          IF AWRTQUALIF[VIRTUAL(VMAWRT,AWRTPTR)]  EQ  0 
          THEN BEGIN
               STOREPLTCHAR(CLENGTH); 
               PL$LENGTH[REALPLT] = CLENGTH - 1;
               GOTO TELOS;
               END
          IF CLENGTH GQ 30
          THEN BEGIN
               STOREPLTCHAR(CLENGTH); 
               TOTALLENGTH = 30;
               CLENGTH = 1; 
               CHSTR = "                              ";
               END
  
          IF B<0,1> QUALIFLAGS EQ 1 
             THEN C<CLENGTH-1,4> CHSTR = " OF ";
             ELSE C<CLENGTH-1,4> CHSTR = " IN ";
          CLENGTH = CLENGTH + 4;
          # ACCESS THE QUALIFIER OF THE NAME FROM THE AWRT #
          NAMEGET(USEAWRT,AWRTPTR); 
          INDX = 0; 
          WORDFLAG = 1; 
  
          ASLONGAS WORDFLAG  LQ 4 DO
            BEGIN 
            GOTO PFLAG[WORDFLAG]; 
  WORD1:  
            WORDFLAG = 2; 
            WDF = 1;
            MOVESTRING(W1,INDX);
            GOTO REPEAT;
  WORD2:  
            WORDFLAG = 3; 
            WDF = 2;
            MOVESTRING(W2,INDX);
            GOTO REPEAT;
  WORD3:  
            WORDFLAG = 4; 
            WDF = 3;
            MOVESTRING(W3,INDX);
  SAVE: 
            STOREPLTCHAR(CLENGTH);
            IF INDX EQ 0
            THEN BEGIN
                 PL$LENGTH[REALPLT] = TOTALLENGTH + CLENGTH - 1;
                 GOTO TELOS;
                 END
            TOTALLENGTH = TOTALLENGTH + CLENGTH - 1;
            CLENGTH = 1;
            CHSTR = "                              "; 
            WORDFLAG = WDF; 
  REPEAT: 
            END 
  
  TELOS:  
          GETNEXTPLT; 
          RETURN; 
          END   #ALTERLIT#
  CONTROL EJECT;
  
   PROC  STOREPRGID(PARAM1);
          ITEM  PARAM1; 
          #THIS ROUTINE STORES THE PROGRAM-ID INTO THE FIRST #
          #PLT ENTRY. PARAM1 IS THE PROGRAM-ID CHARACTER STRING # 
  
          BEGIN 
          $BEGIN
            IF INDEBUG THEN OUTPUT(2,"STOREPRGID","CALLED.   ");
          $END
          # ALL ATTRIBUTES FOR THE PROGRAM-ID EXCEPT LINE,COLUMN
            AND THE ACTUAL STRING HAVE BEEN PREVIOUSLY SET UP BY
            INITTBLPROCS. # 
          REALPLT = VIRTUAL(VMPLAT,1);
          PL$LINE[REALPLT] = CLALINE; 
          PL$COLUMN[REALPLT] = CLACOLUMN; 
          PLT$CHAR[VIRTUAL(VMPLST,1)] = C<0,10>PARAM1;
          RETURN; 
          END # OF STOREPRGID # 
CONTROL EJECT;
  
   PROC  PNATBUILD; 
    # BUILD SKELETON PNAT FROM THE PNT #
  
    BEGIN 
      ITEM LASTSECT U, #LAST SECTION TEMPORARY# 
           SEGNUM   U; #SEGMENT NUMBER TEMPORARY# 
          ITEM  REALPNAT; 
      $BEGIN
        IF INDEBUG THEN OUTPUT(2,"PNATBUILD","CALLED.");
      $END
          # CREATE A PNT ENTRY FOR A SECTION NAME AND ONE FOR A    #
          # PARAGRAPH NAME, AFTER THE ALREADY EXISTING ENTRIES,    #
          # THESE ARE GOING TO BE USED BY THE REPORT-WRITER.       #
          CCTRPSECTNAM = 0; 
          TTABREADONLY[VMPNT] = FALSE;   # READ ONLY WAS SET BY AWRTREF#
          IF CCTSECTION[0]
          THEN BEGIN
               REALPNT = VIRTUAL(VMPNT,PNTNEXT);
               PNTINFO[REALPNT] = 0;
              PNTNAMEINFO[REALPNT] = 0; 
               PNTLINE[REALPNT] = 0;
               PNTCOLUMN[REALPNT] = 0;
               PNTSECTION[REALPNT] = 1; 
               LASTSECTION = PNTNEXT; 
          CCTRPSECTNAM = LASTSECTION; 
               GETNEXTPNT;   #GET NEXT FREE PNT ENTRY # 
               END
          REALPNT = VIRTUAL(VMPNT,PNTNEXT); 
           PNTINFO[REALPNT] = 0;
          PNTNAMEINFO[REALPNT] = 0; 
           PNTLINE[REALPNT] = 0;
           PNTCOLUMN[REALPNT] = 0;
           PNTSEGORSECT[REALPNT] = LASTSECTION; 
           IF  NOT CCTSECTION[0]  THEN CCTRPSECTNAM = PNTNEXT;
           GETNEXTPNT;
      #INITIALIZE LOOP END,SECTION AND SEGMENT NUMBERS# 
      J = PNTNEXT - 1;
      LASTSECT = 0; 
      SEGNUM = 0; 
      # ZERO OUT 0TH ENTRY #
      FOR I = 1 STEP 1 UNTIL J DO 
        BEGIN 
              REALPNT = VIRTUAL(VMPNT,I); 
              REALPNAT = VIRTUAL(VMPNAT,I); 
              PN$PROCKIND [REALPNAT] = PNTSECTION [REALPNT];
              PN$DEBUG [REALPNAT] = PNTDEBUG [REALPNT]; 
              PN$DECLARATV[REALPNAT] = PNTDECLARATV[REALPNT]; 
              IF  PNTSECTION[REALPNT] EQ 1
              THEN
                  BEGIN 
                  SEGNUM = PNTSEGORSECT[REALPNT]; 
                  PN$PREVSECTN [VIRTUAL(VMPNAT,LASTSECT)] = I;
                  LASTSECT = I; 
                  END 
              ELSE
                  BEGIN 
                  PN$PREVSECTN [REALPNAT] = PNTSEGORSECT [REALPNT]; 
                  END 
              PN$SEGMENTNO[VIRTUAL(VMPNAT,I)] = SEGNUM; 
        END 
      RETURN; 
      END # OF PNATBUILD #
  CONTROL EJECT;
  
   PROC  STORALLPROCS(PARAM1,PARAM2); 
          ITEM  PARAM1; 
          ITEM  PARAM2; 
          # THIS PROCEDURE IS CALLED WHEN THE ALL PROCEDURES PHRASE IS #
          # ENCOUNTERED IN A USE FOR DEBUGGING STATEMENT IN ORDER TO   #
          # STORE ALL THE PROCEDURE NAMES INTO THE PLT.                #
          # PARAM1: PLT POINTER TO THE 1ST PROCEDURE NAME.             #
          # PARAM2: NUMBER OF PROCEDURE NAMES INTO THE PLT.            #
  
          BEGIN 
  
          PARAM1 = PLTNEXT; 
          PARAM2 = 0; 
          J = PNTNEXT - 1;
          FOR I = 1 STEP 1 UNTIL J DO 
              BEGIN 
               REALPNT = VIRTUAL(VMPNT,I);
               IF PNTLINE[REALPNT] EQ 0  AND
                  PNTCOLUMN[REALPNT] EQ 0 
               THEN TEST;   # A COMPILER GENERATED PARAGRAPH #
              IF PNTDEBUG[REALPNT] EQ 0 
              THEN BEGIN
                  # PROCEDURE NOT DEFINED IN THE DEBUGGING SECTIONS#
                   CLENGTH = 1; 
                   CHSTR = "                              ";
                   STORESTR(USEPNT,I);
                   IF PNTSECTION[REALPNT] EQ 0 AND
                      CLENGTH LQ 27            AND
                      PNTSEGORSECT[REALPNT] NQ 0
                   THEN BEGIN 
                        C<CLENGTH-1,4>CHSTR = " OF "; 
                        CLENGTH = CLENGTH + 4;
                        STORESTR(USEPNT,PNTSEGORSECT[REALPNT]); 
                        END 
                # BUILD THE PLT ENTRY CONTAINING THE CREATED STRING # 
                 PARAM2 = PARAM2 + 1; 
                 REALPNT = VIRTUAL(VMPNT,I);
                 K = PNTLINE[REALPNT];
                 L = PNTCOLUMN[REALPNT];
                 REALPLT = VIRTUAL(VMPLAT,PLTNEXT); 
                 PL$CODE[REALPLT] = PLTQUOTEDLIT; 
                 PL$LINE[REALPLT] = K;
                 PL$COLUMN[REALPLT] = L;
                 PL$LENGTH[REALPLT] = CLENGTH - 1;
                 PL$STRINGPTR[REALPLT] = NEXTSTRENTRY;
                 STOREPLTCHAR(CLENGTH); 
                 GETNEXTPLT;
                 END
            END 
          RETURN; 
       END # OF STORALLPROCS #
  
  END # OF TBLPROCS # 
TERM
