*DECK             SRCH
USETEXT   TSOURCE 
USETEXT   TCOM37Q 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TCEXEC
PROC SRCH((NP),B,APP);
#*        "SRCH" - CONTAINS ALL SYMBOL-TABLE HANDLING ROUTINES.          SRCH/D 
*#                                                                       SRCH/D 
#ABORT 6---INDICATES SYMBOL TABLE OVERFOW#
  
BEGIN 
  
ITEM
     B B,      #SUCCESS FLAG# 
     AP,       #ATTRIBUTE POINTER-OUTPUT# 
          NP;       #INTERNAL NAME POINTER# 
ITEM APP,TMP; 
          XREF ITEM SAFREE;        #MIN CORE AVAILABLE AT LATEST FL #    SRCH/D 
      XREF ITEM SYSTART;     #STARTING ADDRESS OF SYMBOL TABLE# 
                                                                         SRCH/D 
#***      ENTRY POINTS . . . #                                           SRCH/D 
                                                                         SRCH/D 
         XREF FUNC MORESPC;                                              SRCH/D 
XREF PROC SYMABT;                                                        SRCH 
XDEF BEGIN
      PROC VSYMIN;
      PROC TSPACE;
      PROC RSPACE ; 
      PROC FIND;
      FUNC GET; 
      FUNC SPACE; 
      PROC PNAM;
      PROC DTXTNAM; 
      PROC LOOKUP;
END 
#***  #                                                                  SRCH/D 
                                                                         SRCH/D 
          DEF J801 #801#;          # SYMABT DIAGNOSTIC 801             # SRCH 
          DEF J802 #802#;          # SYMABT DIAGNOSTIC 802             # SRCH 
          ARRAY IL;;         #DUMMY FOR COM37I #                         21FEB77
                                                                         SRCH/D 
ITEM PTR, TEMP, CT, LLINK;
  
  
  
  
#     COMDECKS                                                         #
  
*CALL COMEX 
          # THIS-ID PLUS 1 IS *CALL COMCODE #                            SRCH/D 
*CALL COMCODE                                                            SRCH/D 
*CALL HASHCOM 
          # RESUME SRCH #                                                SRCH/D 
  
  
DEF BLKSIZ#ZBLKSZ#;     #SIZE OF TRANSIENT SPECE BLOCKS#
      CONTROL EJECT;
  
  
      PROC GETMORE; 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   G E T M O R E                                          #
#                                                                      #
#     INCREASE FL.  CALLS MOVETBL, WHICH CHECKS TO SEE IF AFREE        #
#     INDICATES FREE CORE DOES NOT EXTEND TO SYMCP-1.  IF NOT IT       #
#     ASSUMES THAT TO BE CODE BUFFERS AND MOVES THEM UP TO UNDER THE   #
#     NEW SYMCP VALUE.                                                 #
#     SEE MOVETBL FOR FURTHER EXPLANATION.                             #
#     MORESPC ABORTS IF REQUIRED FL IS NOT AVAILABLE TO THE JOB.       #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      ITEM D            I;         # TEMP FOR CURRENT FL-1             #
  
      D = MORESPC (1);             # REQUEST MORE FL -- DO NOT RETURN  #
                                   # IF NONE IS AVAILABLE              #
      MOVETBL (SYMCP - 2,          # FROM (SYM TAB INDEX)              #
               D - LOC(ZSYM) - 3,  # TO (SYM TAB INDEX)                #
               SYMCP - 1 - (NXTAV + AFREE));  # NUMBER OF WORDS        #
      AFREE = (D - FLMINUS1) + AFREE;  # INCREASE AFREE                #
      SAFREE = (D - FLMINUS1) + SAFREE;  # MIN AVAIL SO FAR            #
      FLMINUS1 = D;                    # SAVE ADDR OF FL-1             #
      SYMCP = FLMINUS1 - LOC(ZSYM) - 1;  # OFFSET OF NEW END OF SYM TAB#
  
      END 
      CONTROL EJECT;
  
  
      FUNC GET ((S)); 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     F U N C   G E T                                                  #
#                                                                      #
#     ACQUIRES SYMBOL TABLE SPACE.                                     #
#                                                                      #
#     INPUT PARAMETER -- S = NUMBER OF WORDS REQUESTED.                #
#     OUTPUT FUNCTION -- GET = SYMBOL TABLE OFFSET OF AVAILABLE SPACE  #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      ITEM D            I;         # TEMP FOR OLD NXTAV                #
      ITEM S            I;         # INPUT PARAMETER                   #
      ITEM X            I;         # TEMP                              #
  
      AFREE = AFREE - S;           # DECREMENT AFREE                   #
      D = NXTAV;                   # SAVE OLD NXTAV TEMPORARILY        #
      NXTAV = NXTAV + S;           # INCREMENT NXTAV                   #
      FOR D = D                    # IF NO MORE FREE SYM TAB SPACE     #
        WHILE AFREE LQ 0
      DO
        BEGIN 
        GETMORE;                   # ACQUIRE MORE FL FOR SYM TABLE     #
        END 
      FOR X = D STEP 1             # CLEAR SPACE FOR NEW ENTRY         #
        UNTIL NXTAV 
      DO
        BEGIN 
        SYM0[X] = 0;
        END 
      GET = D;                     # ESTABLISH OUTPUT FUNCTION         #
  
      END 
      CONTROL EJECT;
     SWITCH OPERSW SRCHL,SPOSTL;
     STATUS OPTYPE SEARCH,SPOST;
          ITEM O$P  S:OPTYPE; 
  
  
#FINALLY THE CODE FOR THE SEARCH ENTRANCE#
  
          O$P=S"SEARCH";
          GOTO TOP; 
  
ENTRY PROC SPOST( (NP), (WDS) , B , APP); 
#         IF NLNK OF NP IS NOT A "NAME" ENTRY, RETURN B=TRUE TO          SRCH/D 
*         INDICATE THERE IS ANOTHER ENTRY TO LOOK AT.                    SRCH/D 
*         "APP" IS THE NEW ENTRY"S INDEX.                                21FEB77
*         OTHERWISE, RETURN B=FALSE, POST ENTRY OF SIZE "WDS" ON THE NAM SRCH/D 
*         CHAIN, RETURN WITH APP= THE NEW ENTRY.                         SRCH/D 
*#                                                                       SRCH/D 
ITEM WDS;         #REQUIRED LENGTH# 
  
          O$P=S"SPOST"; 
  
TOP:  
          AP=NLNK[NP];
MID:      IF CLAS[AP] EQ S"NAME" THEN 
               BEGIN                              # NAME--END OF CHAIN# 
               B=FALSE; 
               GOTO OPERSW[O$P];
               END
          B=TRUE; 
          APP=AP; 
          RETURN; 
  
#ENTRY HERE WHEN SEARCHES FAIL# 
SRCHL:    B=FALSE;
          APP=AP; 
          RETURN; 
      CONTROL EJECT;
  
  
      PROC VSYMIN ($FIRST,$LAST); 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   V S Y M I N                                            #
#                                                                      #
#     INITIALIZE SYMBOL TABLE CONTROL VARIABLES RELATIVE TO PARAMETERS.#
#     VSYMIN IS ALWAYS CALLED ONCE BY INIT15.  IT IS CALLED AGAIN BY   #
#     INIT15 IF USETEXT PROCESSING OCCURRED.                           #
#                                                                      #
#     NXTAV = INDEX OF NEXT AVAILABLE SYMBOL TABLE WORD.               #
#     SYMCP = INDEX-1 OF THE SYMBOL TABLE WORD AT FL-1.                #
#     SYMSTART = INDEX OF FIRST SYMBOL TAB WORD (EXCLUDING HASH TABLE).#
#                                                                      #
#     INPUT -- $FIRST = FWA OF SYM TAB AREA (EXCLUDING HASH TABLE).    #
#             ($FIRST = 0 AND SERVES ONLY AS A FLAG IF SECOND CALL     #
#              FROM INIT15 FOR CURRENT COMPILATION MODULE.)            #
#              $LAST = LWA-1 OF SYM TAB AREA.                          #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      ITEM T            I;         # TEMP                              #
      ITEM $FIRST       I;         # INPUT PARAMETER                   #
      ITEM $LAST        I;         # INPUT PARAMETER                   #
  
      IF $FIRST NQ 0
      THEN                         # FIRST CALL ONLY                   #
        BEGIN 
        NXTAV = $FIRST - LOC(ZSYM) + 1;  # INDEX OF NEXT AVAIL ST WORD #
        SYMSTART = NXTAV; 
        AVLRS = 0;                 # NO ENTRIES ON AVAIL SPACE CHAIN   #
        FOR T = 0 STEP 1           # CLEAR HASH TABLE                  #
          UNTIL L$HASH
        DO
          BEGIN 
          SYM0[T] = 0;
          END 
        END 
  
      SYMCP = $LAST - LOC(ZSYM) - 1;   # INDEX OF LAST AVAIL ST WORD   #
      FLMINUS1 = $LAST;            # CURRENT FL-1                      #
  
      CONTROL IFEQ SYMTBLV,0;      # SCM SYMBOL TABLE                  #
      FOR T = T 
        WHILE (SYMCP - 2 - SMAX) LQ NXTAV 
      DO
        BEGIN 
        GETMORE;                   # GET MORE SYMBOL TABLE SPACE       #
        END 
      FOR T = SYMCP - 2 STEP -1 
        UNTIL SYMCP - 2 - SMAX
      DO
        BEGIN 
        SYM0[T] = 0;               # CLEAR CODE BUFF CONTROL ARRAY     #
        END 
      P<COBUFF> = LOC(SYM0[SYMCP - 2 - SMAX]);
      AFREE = (SYMCP - 2 - SMAX) - NXTAV;  # AFREE = CTL ARY ORIG-NXTAV#
      CONTROL ENDIF;               # SCM SYMBOL TABLE                  #
  
      CONTROL IFNQ SYMTBLV,0;      # LCM SYMBOL TABLE                  #
      AFREE = SYMCP - 1 - NXTAV;   # AFREE = SYM TAB END - NXTAV       #
      P<COBUFF> = LOC(LOCOBUFF);
      SAFREE = 0;                  # NO FREE SPACE IN LCM              #
      FREEPTR = FREESPACESIZ;      # INIT SCM FREESPACE POINTER        #
      FREEMAX = FREEPTR;           # FOR CALC OF MAX SCM USED          #
      CONTROL ENDIF;               # LCM SYMBOL TABLE                  #
  
      END 
      CONTROL EJECT;
# GET TRANSIENT SPACE FROM SYMBOL TABLE. IF ANY RETURNED SPACE IS 
  AVAILABLE, USE IT. IF NONE, CHECK IF ANY FREE SPACE REMAINS. IF 
  YES, USE IT. IF NONE, ABORT.# 
#                                                                      #
#         FOR THE LCM SYMBOL TABLE --                                  #
#         NOTE THAT WE ARE STILL ALOCATING THE SPACE FROM THE TOP TO   #
#         BOTTOM.  THIS ALLOWS EASY OVERFLOW CHECKING AND EASY         #
#         CALCULATION OF UNUSED SCM SPACE, BUT IT MAKES AUTOMATIC      #
#         SCM FIELD MANAGEMENT VERY DIFFICULT                          #
PROC TSPACE(PNT); 
BEGIN 
     ITEM PNT;
          ITEM I; 
           IF AVLRS NQ 0 THEN 
           BEGIN
           PTR=AVLRS; 
#SCM# CONTROL IFEQ SYMTBLV,0; 
                                                                         SRCH/D 
          AVLRS=COLK[AVLRS];       # ADVANCE TO LINKED BLOCK #           SRCH/D 
                                                                         21FEB77
#SCM# CONTROL ENDIF;
#LCM# CONTROL IFNQ SYMTBLV,0; 
          AVLRS=SPALK[AVLRS];      #SET FREE-POINTER UP TO THE NEXT ONE# 21FEB77
#LCM# CONTROL ENDIF;
  SCLER:   TMP=PTR+ BLKSIZ- 1;
#SCM# CONTROL IFEQ SYMTBLV,0; 
           FOR I= PTR STEP 1 UNTIL TMP DO SYM0[I]= 0; 
#SCM# CONTROL ENDIF;
#LCM# CONTROL IFNQ SYMTBLV,0; 
           FOR I=PTR STEP 1 UNTIL TMP DO
              SPACE0[I] = 0;               #ZERO OUT BUFFER            #
#LCM# CONTROL ENDIF;
           PNT= PTR;
           RETURN;
            END 
           ELSE 
#SCM# CONTROL IFEQ SYMTBLV,0; 
                 FOR I=I WHILE AFREE LS BLKSIZ DO                        SRCH/D 
                     GETMORE;    #ABORTS IF IT CAN GET NO FL #           21FEB77
           PTR=NXTAV+AFREE-BLKSIZ;
           AFREE=AFREE-BLKSIZ;
#SCM# CONTROL ENDIF;
#LCM# CONTROL IFNQ SYMTBLV,0; 
TSPAC2:    FREEPTR = FREEPTR - BLKSIZ;     #ALLOCATE NEW BUFFER        #
           PTR = FREEPTR; 
           IF FREEPTR LS 0 THEN 
              SYMABT(J801,"SCM FREE SPACE BLOCK INSUFFICIENT SIZE(TSPACE SRCH 
 IN SRCH",55);                                                           SRCH 
#LCM# CONTROL ENDIF;
           GOTO SCLER;
END 
      CONTROL EJECT;
# RETURN SPACE TO SYMBOL TABLE. 
  IF RETURNED SPACE IS AT BOUNDARY OF ALLOCATED TRANSIENT SPACE 
  AND AVAILABLE SPACE, ADD RETURNED SPACE TO AVAILABLE SPACE. 
  IF IT IS NOT, LINK THE RETURNED SPACE INTO  THE AVAILABLE CHAIN 
  AS NEXT AVAILABLE. #
          PROC RSPACE ((PTR));
ITEM PTR; 
BEGIN 
#SCM# CONTROL IFEQ SYMTBLV,0; 
           IF PTR EQ NXTAV+AFREE THEN 
            BEGIN 
       IF AFREE LS SAFREE THEN SAFREE=AFREE;
           AFREE=AFREE+BLKSIZ;
           RETURN;
            END 
                                                                         SRCH/D 
           COLK[PTR]=AVLRS;        # LINK FREE SPACE BEHIND HIM#         SRCH/D 
           AVLRS=PTR; 
           RETURN;
#SCM# CONTROL ENDIF;
#LCM# CONTROL IFNQ SYMTBLV,0; 
           IF PTR EQ FREEPTR THEN 
              BEGIN  #BOUNDARY#            #RETURN LAST BLOCK ALLOCATED#
              FREEPTR = FREEPTR + BLKSIZ; 
              IF FREEPTR LS FREEMAX THEN
                 FREEMAX = FREEPTR; 
              END  #BOUNDARY# 
           ELSE 
              BEGIN  #ADD TO CHAIN# 
              SPALK[PTR] = AVLRS; 
              AVLRS = PTR;
              END  #ADD TO CHAIN# 
#LCM# CONTROL ENDIF;
END 
  
ENTRY PROC SOVER(APP);
          AP= NLNK[AP]; 
          GOTO MID; #RETRY# 
  
#POST ENTRANCE# 
ENTRY PROC POST ( (NP) , (WDS) ,APP); 
  
  
SPOSTL:        #ALSO ENTER HERE AFTER SPOST FAILS#
  
          AP =  GET(WDS); 
          NLNK[AP]=NLNK[NP];
          NNAM[AP]=NNAM[NP];
          NLNK[NP]=AP;
          APP=AP; 
          RETURN; 
  
PROC FIND(AP,NAMEPAR);
BEGIN 
ITEM AP, NAMEPAR; 
          NP=AP;
ITEM TJ;
          FOR TJ=1 STEP 1 UNTIL SYMCP DO
               BEGIN
               IF CLAS[NP]EQ S"NAME" THEN    BEGIN
                                             NAMEPAR=NP;
                                             RETURN;
                                             END
               NP=NLNK[NP]; 
               END
          SYMABT(-J802,"FIND LOOP(FIND IN SRCH)",23);                    SRCH 
END 
  
FUNC SPACE (WDS); 
BEGIN 
      ITEM WDS; 
          SPACE  = GET( WDS) ;
          RETURN; 
END 
  
  
PROC PNAM (STRA, (LEN), NAMEPAR) ;
BEGIN 
     ARRAY STRA; ITEM STR;
      ITEM LEN,NAMEPAR; 
          TEMP=(LEN-1)/10;    #LAST WORD# 
  
          TMP=STR[0]; 
          LLINK = STHASH( TMP );
TRY:      NP=HLNK[LLINK];                         #NEXT ENTRY ON HSH CH#
          IF NP EQ 0 THEN                         #POST#
               BEGIN
                 NP = GET ( TEMP+2) ; 
               FOR CT=0 STEP 1 UNTIL TEMP DO INAM[NP+CT]=STR[CT]; 
               HLNK[NP]=0;
               NLNK[NP]=NP; 
               NCHR[NP]=LEN;
               CLAS[NP]=S"NAME";
               HLNK[LLINK]=NP;
               NAMEPAR=NP;
               RETURN;
               END
          IF INAM[NP] NQ TMP THEN GOTO MISS;
          IF NCHR[NP] NQ LEN THEN 
MISS:          BEGIN
               LLINK=NP;
               GOTO TRY;
               END
          FOR CT=1 STEP 1 UNTIL TEMP DO IF INAM[NP+CT]NQ STR[CT]THEN
                    GOTO MISS;
          IF CLAS[NP] NQ S"NAME"   THEN GOTO MISS;
          NAMEPAR=NP; 
END 
                                                                         SRCH/D 
                                                                         SRCH/D 
                                                                         SRCH/D 
PROC DTXTNAM(STRA, (LEN), NAMEPAR);                                      SRCH/D 
#         POST THE CONTENTS OF A DEF AS A "DTXT" ENTRY #                 SRCH/D 
                                                                         SRCH/D 
BEGIN 
      ARRAY STRA ; ITEM STR;
      ITEM LEN , NAMEPAR; 
           TEMP = (( LEN *2 ) -1 ) / 10;   #EACH DEF CHAR IS 12 BITS# 
  
           TMP = STR[0];
           LLINK = STHASH( TMP ); 
TRYD:      NP = HLNK[LLINK];
           IF NP EQ 0 THEN
              BEGIN 
              NP = GET (TEMP +2); 
  
              FOR CT =0 STEP 1 UNTIL TEMP DO INAM[NP+CT] = STR[CT]; 
              HLNK[NP] =0;
              NLNK[NP] = NP;
              NCHR[NP] = LEN; 
              CLAS[NP] = S"DTXT"; 
              HLNK[LLINK] = NP; 
              NAMEPAR = NP; 
              RETURN; 
              END 
           IF INAM[NP] NQ TMP THEN GOTO MISSD;
           IF NCHR[NP] NQ LEN THEN
              BEGIN 
MISSD:        LLINK = NP; 
              GOTO TRYD;
              END 
           FOR CT=1 STEP 1 UNTIL TEMP DO
              IF INAM[NP+CT] NQ STR[CT] THEN GOTO MISSD;
  
           IF CLAS[NP] NQ S"DTXT" THEN GOTO MISSD;
           NAMEPAR = NP;
           RETURN;
END 
PROC LOOKUP (STRA, (LEN) , NAMEPAR);
BEGIN 
      ARRAY STRA; ITEM STR; 
      ITEM LEN,NAMEPAR; 
   #SPECIAL ENTRY USED BY $BEGIN,$END PROCESSING, LOOKS UP A NAME 
    IN THE SYMBOL TABLE BUT DOES NOT ENTER IT IF NOT FOUND #
        TEMP=(LEN-1)/10;
        LLINK = STHASH( STR[0] ); 
 TRYL:  NP=HLNK[LLINK]; 
        IF NP EQ 0 THEN BEGIN NAMEPAR=0; RETURN;
                        END 
        IF INAM[NP] NQ STR[0] THEN GOTO MISSL;
        IF NCHR[NP] NQ LEN THEN BEGIN 
 MISSL: LLINK=NP; 
        GOTO TRYL; END
        FOR CT=1 STEP 1 UNTIL TEMP DO 
             IF INAM[NP+CT] NQ STR[CT] THEN GOTO MISSL; 
        NAMEPAR=NP; 
        RETURN; 
END 
                                                                         SRCH/D 
                                                                         SRCH/D 
#***    #                                                                SRCH/D 
PROC MOVETBL (OLDEND,NEWEND, HOWMANY);                                   SRCH/D 
#***      MOVE ALL TABLES WE HAVE IN SYM-TAB AREA, AND ADJUST THEIR      SRCH/D 
**        POINTERS.                                                      SRCH/D 
*         COBUFF, THE CONTROL-WORDS ARRAY, IS BASED TO OCCUPY THE WORDS  SRCH/D 
*         THROUGH SYM0[SYMCP-2].  IMMEDIATELY BELOW THAT ARE THE CODE    SRCH/D 
*         BUFFERS, (BLKSIZ) WORDS PRR BUFFER.                            SRCH/D 
*         PRESENCE OF CODE BUFFERS IS DETERMINED BY                      SRCH/D 
*                NXTAV+AFREE LS SYMCP-1                                  SRCH/D 
*         BECAUSE SYM0[NXTAV+AFREE] IS THE FIRST WORD OF CODE BUFFERS,   21FEB77
*         WHILE SYM0[SYMCP-1] IS THE LWA+1 OF THE CORE WE USE.           SRCH/D 
*                                                                        SRCH/D 
*         SEE "CODE" FOR DESCRIPTION OF THE CODE-BUFFER FREE SPACE.      SRCH/D 
*#                                                                       SRCH/D 
   BEGIN                                                                 SRCH/D 
       ITEM OLDEND ,         # LWA (NOT LWA+1) BEFORE RFL  #             SRCH/D 
            NEWEND ,         # LWA (NOT LWA+1) NOW  #                    SRCH/D 
           HOWMANY ;  # WORDS OF CORE TO BE MOVED  #                     SRCH/D 
   CONTROL IFEQ SYMTBLV,0;         #BUFFERS AREN"T IN SYMTAB WHEN S.T.   SRCH/D 
                                   * IS IN LCM.                       #  SRCH/D 
      BEGIN                                                              SRCH/D 
      ITEM DISTANCE,                                                     SRCH/D 
           I  , J , K;                                                   SRCH/D 
                                                                         SRCH/D 
      IF HOWMANY LQ 1 THEN RETURN;                                       SRCH/D 
      DISTANCE = NEWEND - OLDEND  ;                                      SRCH/D 
                             # FIRST, ADJUST THE CONTROL ARRAY . . . #   SRCH/D 
      FOR I=SMAX STEP -1 UNTIL 0 DO     #MOVE CTL ARRAY, ADJUSTING PTRS# 21FEB77
        BEGIN                                                            SRCH/D 
        IF LINK[I] GR SMAX THEN                                          SRCH/D 
            LINK[I]=LINK[I]+DISTANCE;    #ADJUST THE LINK FIELD#         SRCH/D 
        IF LSTR[I] NQ 0 THEN                                             SRCH/D 
            LSTR[I]=LSTR[I]+DISTANCE;    #A POINTER IS PRESENT #         SRCH/D 
        SAVWRD[I+DISTANCE]=SAVWRD[I];                                    21FEB77
        END                                                              SRCH/D 
      P<COBUFF>=P<COBUFF>+DISTANCE;                                      21FEB77
                                                                         21FEB77
#     IF CURRENT BUFFER IS NOT GOING DIRECTLY OUT TO THE IL- MOVE IT   #
  
      IF P<PUTIL> GQ SYSTART THEN 
          P<PUTIL>=P<PUTIL>+DISTANCE;    #ADJUST BASE TO THE NEW LOC #   21FEB77
                                                                         SRCH/D 
                      #THEN MOVE THE BUFFERS AND ADJUST THEIR LINKS... # SRCH/D 
      K=NEWEND-HOWMANY+1;    # NEW FWA OF BLOCKS #                       21FEB77
      FOR I=P<COBUFF>-LOC(ZSYM)-BLKSIZ   #1ST BUFFER BELOW MOVED COBUFF# 21FEB77
          STEP -BLKSIZ UNTIL K DO                                        SRCH/D 
          BEGIN                                                          SRCH/D 
          FOR J=I+BLKSIZ-1 STEP -1 UNTIL I DO                            SRCH/D 
                  SYM0[J]=SYM0[J-DISTANCE];   #MOVE ALL WRODS BODILY #   SRCH/D 
          IF COLK[I] NQ 0 THEN                                           SRCH/D 
              COLK[I]=COLK[I]+DISTANCE;   #ADJUST ANY POINTER. #         SRCH/D 
          END                                                            SRCH/D 
                                                                         SRCH/D 
                 IF AVLRS NQ 0 THEN                                      SRCH/D 
                   # AVLRS BLOCKS MOVED   ADJUST AVLRS OTSELF  #         SRCH/D 
                 AVLRS = AVLRS + DISTANCE;                               SRCH/D 
                                                                         SRCH/D 
                                                                         SRCH/D 
      END                                                                SRCH/D 
   CONTROL ENDIF;                                                        SRCH/D 
   END  #MOVETBL#                                                        SRCH/D 
     END
TERM
