*DECK  COMPILE                                                          012850
USETEXT TCLFN 
USETEXT TENVIRN 
USETEXT TOPTION 
USETEXT TREPORT 
      PROC  COMPILE;     BEGIN                                          012860
      XREF FUNC CMM$ALF;           # CMM FUNCTION TO ALLOCATE CM BLOCK #
      XREF PROC CMM$FGR;           # CMM PROC TO FREE GROUP ID         #
      XREF PROC CMM$FRF;           # CMM PROC TO FREE CM BLOCK         #
      XREF PROC DIAG;              # DIAGNOSTIC PROCESSOR              #
      XREF PROC WRITEBR;                                                013020
      XREF PROC LOADX0;                                                 013040
      XREF PROC RUA;               # REQUEST USEABLE AREA FOR TABLE    #
      XREF PROC FUA;               # FREE USEABLE AREA                 #
      XREF PROC GETFL;             # REQUEST CURRENT FL                #
  
      XREF ITEM UALENG;            # LENGTH OF USEABLE AREA            #
      XREF ITEM UAFWA;             # FWA OF USEABLE AREA               #
      XREF ITEM UNIVERSAL;         # UNIVERSAL CHARACTER               #
      XREF ITEM CURRENTLFPTR; 
      XREF ITEM QUFL;              # CURRENT FL                        #
      XREF ITEM SM$GROUPID;        # GROUP ID FOR THIS REPORT          #
                                                                        013050
      ITEM TEMP,I,DUMMY;                                                013060
      ITEM LFNAME C(10);                                                013070
      ITEM CCODE;                  # CONVERT CODE ENTRY IN EXPR. STACK #
      ITEM TBLG,EXPTBPT;                                                013080
      ITEM OLDNEWTBLG,OLDNEWTBPT,OLDNEWTBPT1;                           013090
      ITEM THISOLD,NEXTOLD,NEXTNEW,LENGTH;                              013100
      ITEM DEFLNEW,DESLNEW,SPELNEW;  #POINTERS TO NEW TABLE ENTRIES.   #013110
      ITEM ADDNEW,ADDOLD;                                               013120
      ITEM THISNEW,TEMPADD,INTBYTES;                                    013130
      ITEM ADDREL;                                                      013140
      ITEM F,W;                    # 1ST BIT POSITION    WORD NUMBER   #013150
      ITEM SAVEADD;                # SAVE ADDRESS OF GIVE ARRAY.       #013160
      ITEM SAVEADD1;               # SAVE ADDRESS OF GIVE ARRAY        #
      ITEM SAVEADD3,DONE,KK;
      ITEM SAVEADD5;
      ITEM CONVERTCODE;            # CONVERT CODE                      #013170
      ITEM SAVEADD2,EXPFROM,J;                                          013180
      ITEM DUMMY3,L,STBAR1,STBAR2;                                      013190
      ITEM SADDNEW;                                                     013200
      ITEM SAVEADD4,DUMMY4;                                             013210
      ITEM F1,FLAG1,LOOPDONE,CHARS;                                     013220
      ITEM EXPLENGTH;                                                   013240
      ITEM K;                                                           013250
      ITEM WSAVE; 
      ITEM BEGINTABLES;            # BEGINING OF TABLES.               #013260
      ITEM  EDITBIT;                                                    013270
      ITEM OFFSET I;               # NEW ADDRESS - OLD ADDRESS         #
      ITEM MOVDEF B;               # TRUE IF MOVING DEFINE LIST        #
                                                          CONTROL EJECT;013280
      BASED ARRAY  DEST;           # DESTINATION ARRAY.                #013290
        ITEM DESAR    U(0,0,60),                                        013300
             DESARC   C(0,0,10),                                        013310
             DESARI   I(0,0,60),                                        013320
             DESLINK  I(0,42,18);  # POINTER AREA TO NEXT              #013330
                                   # ENTRY IN THE NEW STRING.          #013340
                                                                        013350
      BASED ARRAY  GIVE;           # GIVING AREA ARRAY.                #013360
        ITEM GIVAR    U(0,0,60),                                        013370
             GIVARC   C(0,0,10),                                        013380
             GIVARI   I(0,0,60);                                        013390
                                                                        013400
      BASED ARRAY  GIVEX;          # AUX AREA GIVING ARRAY             #013410
        ITEM GIVARX  U(0,0,60);                                         013420
                                                                        013430
      BASED ARRAY  TABAR;                                               013440
        ITEM TBAR1    U(0,0,30),                                        013450
             TBAR2    U(0,30,30);                                       013460
                                                                        013470
      BASED ARRAY  OLDNEWTB;       # OLD NEW TABLE ADDRESS POINTERS.   #013480
        ITEM OLDNEW1  U(0,0,30),                                        013490
             OLDNEW2  U(0,30,30);                                       013500
                                                                        013510
      BASED ARRAY  DESCRAY;        # ARRAY TO DEFINE KEY AREAS OF THE  #013520
                                   # DESCRIBE LIST ENTRIES.            #013530
        ITEM DESPOINT I(0,42,18),  # POINTER TO NEXT ENTRY IN STRING.  #013540
            DESNAMEL U(1,6,6),     # NAME LENGTH IN WORDS              #
            DEWPOS I(1,18,18),     # ADDRESS OF DEFINE VALUE           #
            DECLSLG I(1,42,18),    # DATA LENGTH IN CHARACTERS         #
            DESOCCF U(2,2,1),      # IF ADDITIONAL WORD IS PRESENT     #
            DESMURP I(2,42,18),    # MURAL POINTER                     #
            DMAXOCR I(3,6,18);     # MAX ENTRIES IN VARIABLE ARRAY     #
                                                                        013580
      BASED ARRAY  FWA;;                                                013590
       BASED ARRAY RA;  ITEM IRA U(0,42,18);
  
      ARRAY AMVEVFROM [1];         # BIT IS SET IF FROMPTR IN MOVE     #
                                   # TABLE OR PROGRAM STACK CONTAINS   #
                                   # ATTRIBUTE TABLE ADDRESS FOR       #
                                   # CORRESPONDING CONVERT CODE        #
        BEGIN 
        ITEM MVEVFROM I(0,0,60) = [O"00077777700000000000",    #NO EDIT#
                                   O"20177777704020140000"];   # EDIT  #
        END 
  
      ARRAY AMVTO [1];             # BIT IS SET IF TOPTR IN MOVE       #
                                   # TABLE CONTAINS ATTRIBUTE TABLE    #
                                   # ADDRESS FOR CORRESPONDING CONVERT #
                                   # CODE                              #
        BEGIN 
        ITEM MVTO I(0,0,60) = [O"37670707070707000000",   # IF NO EDIT #
                               O"00030506050505000000"];  # IF EDIT    #
        END 
                                                          CONTROL EJECT;013600
# INITIALIZATION SECTION.                                              #013610
  
      GETFL;                       # REQUEST CURRENT FL                #
  
      RUA;                         # REQUEST USEABLE AREA FOR TABLE    #
      OLD65 = UAFWA;               # SAVE FWA OF TABLE IN OLD65        #
      P<DEST> = OLD65;             # TABLE IN USEABLE AREA BELOW HHA   #
                                                                        013630
# SET UP THE LOADER PREFIX TABLE AND REPORT NAME IN WORD 0 AND 1.      #013640
      TEMP=ILFNLG[IUPO];
      C<0,TEMP>LFNAME=C<0,TEMP>ILFN[IUPO];
      CHKDEST(2);                  # CHECK FOR ROOM IN BUFFER          #
                                   # PUT REPORT NAME IN PREFIX HEADER  #
                                   # ZERO BITS 0-17 FOR TEXT FILE      #
      DESAR[0]=CURREPT LAN O"77777777777777000000"; 
      DESAR[1]=CURREPT;            # MOVE REPORT NAME                  #013680
      P<DEST>=P<DEST>+2;           # UPDATE POINTE-.                   #013690
                                                                        013700
# MOVE FROM COMMON CREPORT.                                            #013710
      RPTWORD0[0] = RPTWORD0[RPTCTR];  # EVALUATE/MOVE BEFORE/AFTER REP#
      RPTWORD1[0] = RPTWORD1[RPTCTR]; 
      IF RPTCTR NQ 0
      THEN
        BEGIN 
        RPTWORD0[RPTCTR] = 0; 
        RPTWORD1[RPTCTR] = 0; 
        END 
      P<GIVE>=LOC(CREPTLG);                                             013720
      CHKDEST(CREPTLG);            # CHECK FOR ROOM IN BUFFER          #
      FOR I=0  STEP 1  UNTIL CREPTLG-1  DO                              013730
        DESAR[I]=GIVAR[I];                                              013740
      P<DEST>=P<DEST>+CREPTLG;     # UPDATE POINTER.                   #013750
                                                                        013760
# MOVE UNIVERSAL CHARACTER                                             #
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      DESAR[0] = UNIVERSAL;        # UNIVERSAL CHARACTER               #
      P<DEST> = P<DEST> + 1;       # UPDATE POINTER                    #
  
# MOVE FROM COMMON ENVIRON THE RECORD SIZE OF THE SOURCE FILE          #013770
# AS COMPUTED BY DESCRIBE OR EXTRACT DIRECTIVES.                       #013780
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      DESAR[0]=FSIZE;                                                   013790
      P<DEST>=P<DEST>+1;                                                013800
                                                                        013810
# MOVE COMMON AREA CLFN.                                               #013820
      CHKDEST(42);                 # CHECK FOR ROOM IN BUFFER          #
      FOR I=0  STEP 1  UNTIL 20  DO                                     013830
        BEGIN                                                           013840
        DESARC[I]=ILFN[I];                                              013850
        DESARI[I+21]=ILFNLG[I];                                         013860
        END                                                             013870
      P<DEST>=P<DEST>+42;                                               013880
                                   # SAVE THE LOCATIONS OF             #013940
                                   # CURRENTSOURCE                     #013950
                                   # FORMDLADDR                        #013960
                                   # SO THAT REP7100 KNOWS WHERE       #013970
                                   # THEY WERE.                        #013980
      CHKDEST(3);                  # CHECK FOR ROOM IN BUFFER          #
      DESAR[0]=LOC(CURRENTSOURC);                                       013990
      DESAR[1]=LOC(FORMDLADDR);                                         014000
                                   # ALSO SAVE LOCATIONS OF THE VARIOUS#014010
                                   # HEADDING ARAYS                    #014020
      DESAR[2]=LOC(SELDTLHEAD);                                         014030
      P<DEST>=P<DEST>+3;           # UPDATE THE POINTER                #014040
                                                          CONTROL EJECT;014050
# GET CORE FOR TABAR,  AN ARRAY THAT WILL BE USED TO                   #014060
# KEEP TRACK OF EXPRESSION STACK ENTRIES.                              #014070
      P<TABAR> = CMM$ALF(15, 0, SM$GROUPID);
      TBLG=0;                                                           014090
      EXPTBPT=P<TABAR>;                                                 014100
                                                                        014160
# FETCH CORE FOR THE OLD NEW TABLE OF ADDRESSES.                       #014170
      P<OLDNEWTB> = CMM$ALF(250, 0, SM$GROUPID);
      OLDNEWTBLG=1;                                                     014190
      OLDNEWTBPT=P<OLDNEWTB>;                                           014200
      OLDNEWTBPT1=P<OLDNEWTB>;                                          014210
                                                                        014220
                                                                        014250
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      DESAR[0]=0;                  # ZERO OUT LENGHT OF TABLES WORD.   #014260
      P<DEST>=P<DEST>+1;                                                014270
      BEGINTABLES=P<DEST>;         # SAVE POINTER TO 1ST TABLE ENTRY   #014280
                                   # SET DUMMY WORD TO KEEP TABLES     #014290
                                   # FROM STARTING AT RELATIVE ZERO    #014300
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      DESARC[0] = "QU32REPORT";    # IDENTIFY TABLES CREATED BY QU 3.2 #
      P<DEST>=P<DEST>+1;                                                014320
                                                                        014330
# MOVE THE DESCRIBE TABLE ENTRIES  IF THEY EXIST.                      #014340
      IF DESLIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #014350
                                   # IF NON ZERO ADDRESS OF 1ST ENTRY. #014360
        BEGIN                                                           014370
        THISOLD=DESLIST;           # POINTER TO CURRENT ENTRY          #014380
                                   # IN THE OLD STRING.                #014390
        DESLNEW=P<DEST>;           # POINTER TO FIRST NEW ENTRY.       #014400
        MOVDEF = FALSE;            # NOT MOVING DEFINE LIST            #
        MOVETAB1;                  # PROCESS THIS STRING.              #014420
        END                                                             014430
                                                                        014440
# MOVE THE DEFINE TABLE ENTRIES IF THEY EXIST.                         #014450
      IF DEFLIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #014460
                                   # IF NON ZERO ADDRESS OF 1ST ENTRY. #014470
        BEGIN                                                           014480
        THISOLD=DEFLIST;           # POINTER TO CURRENT ENRTY          #014490
                                   # IN THE OLD STTING.                #014500
        DEFLNEW=P<DEST>;           # POINTER TO FIRST NEW ENTRY.       #014510
        MOVDEF = TRUE;             # MOVING DEFINE LIST                #
        MOVETAB1;                  # PROCESS THIS STRING.              #014530
        END                                                             014540
                                                                        014550
# MOVE THE SPECIFY TABLE ENTRIES IF THEY EXIST.                        #014560
      IF SPELIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #014570
                                   # IF NON ZERO ADDRESS OF 1ST ENTRY. #014580
        BEGIN                                                           014590
        THISOLD=SPELIST;           # POINTER TO CURRENT ENTRY.         #014600
                                   # IN THE OLD STRING.                #014610
        SPELNEW=P<DEST>;           # POINTER TO FIRST NEW ENTRY.       #014620
        MOVDEF = FALSE;            # NOT MOVING DEFINE LIST            #
        MOVETAB1;                  # PROCESS THIS STRING.              #014640
        END                                                             014650
                                                                        014660
                                                                        014670
# CHECK TO SEE IF THERE ARE ANY DEFINE ENTRIES.                        #014680
# IF SO MOVE ALL RELATED ITEMS, ECT.                                   #014690
      IF DEFLIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #014700
        BEGIN                                                           014710
                                   # YES THERE IS A DEFLIST.           #014720
        THISNEW=DEFLNEW;                                                014730
        MOVECONTROL;               # MOVE ALL RELATED ITEMS.           #014740
        END                                                             014750
                                                                        014760
# CHECK TO SEE IF THERE ARE ANY SPECIFY ENTRIES .  IF THEY             #014770
# EXIST MOVE ALL RELATED ITEMS,  ECT.                                  #014780
      IF SPELIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #014790
        BEGIN                                                           014800
                                   # YES THERE IS A SPECIFY LIST.      #014810
        THISNEW=SPELNEW;           # SET UP THE POINTER.               #014820
        MOVECONTROL;               # MOVE THE LIST.                    #014830
        END                                                             014840
                                                                        014850
                                                                        014860
# NOW MOVE THE REPORT HEADDER TABLES.                                  #014870
# THEY CAN POINT TO AN  EXPRESSION STACK                               #014880
# OR TO A MOVE TABLE.                                                  #014890
                                                                        014900
                                   # POSITION TO THE ARRAY  REPORT     #014910
                                   # IN THE NEW RECORD.                #014920
      P<GIVE>=OLD65+2+LOC(REPORT)-LOC(CREPTLG);                         014930
      LOOPDONE = 10;               # SET LOOP LIMIT                    #
      MOVEREPT;                    # MOVE EXPRESSION OR MOVE TABLES.   #014950
                                                                        014960
                                   # POSITION TO THE ARRAY FOOTEVAL.   #014970
      P<GIVE>=OLD65+2+LOC(FOOTEVAL)-LOC(CREPTLG);                       014980
      LOOPDONE = MAXBREAK + 2;     # SET LOOP LIMIT                    #
      MOVEREPT;                                                         015000
                                                                        015010
                                   # POSITION TO THE ARRAY HEADEVAL.   #015020
      P<GIVE>=OLD65+2+LOC(HEADEVAL)-LOC(CREPTLG);                       015030
      MOVEREPT;                                                         015040
                                                                        015050
                                   # POSITION TO THE ARRAY BRKEVAL.    #015060
      P<GIVE>=OLD65+2+LOC(BRKEVAL)-LOC(CREPTLG);                        015070
      MOVEREPT;                                                         015080
                                                                        015090
                                   # POSITION TO THE ARRAY SELEVAL.    #015100
      P<GIVE>=OLD65+2+LOC(SELEVAL)-LOC(CREPTLG);                        015110
      LOOPDONE = MAXSELECT + 2; 
      MOVEREPT;                                                         015130
                                                                        015140
                                   # POSITION TO THE ARRAY DTLEVAL.    #015150
      P<GIVE>=OLD65+2+LOC(DTLEVAL)-LOC(CREPTLG);                        015160
      LOOPDONE = MAXSELECT + 1; 
      MOVEREPT;                                                         015170
                                                                        015180
                                   # POSITION TO THE ARRAY TITEVMV.    #015190
      P<GIVE>=OLD65+2+LOC(TITEVMV)-LOC(CREPTLG);                        015200
      LOOPDONE=1;                                                       015210
      MOVEREPT;                                                         015220
                                                                        015230
                                   # POSITION TO THE ARRAY RCPEVMV.    #015240
      P<GIVE>=OLD65+2+LOC(RCPEVMV)-LOC(CREPTLG);                        015250
      MOVEREPT;                                                         015260
                                                                        015270
                                                                        015280
                                                                        015290
# NOW MOVE THE AREPORTLIST ENTRIES.                                    #015300
# THE REPORT ENTRIES ARE POINTED TO BY ITEM AREPORTLIST.               #015310
# THE INDEX TO THE LAST ENTRY IS IN REPORTINDEX.                       #015320
                                   # POSITION TO IT IN NEW RECORD.     #015330
      P<GIVE>=OLD65+2+LOC(AREPORTLIST)-LOC(CREPTLG);                    015340
      P<GIVEX>=GIVAR[0];           # POINT TO LIST IN CORE.            #015350
      SAVEADD4=P<DEST>;            # SAVE POSITION OF FIRST ENTRY IN   #015360
                                   # THE NEW RECORD.                   #015370
      LOOPDONE = (REPORTINDEX + 1) * 3;  # EACH ENTRY 3 WORDS LONG     #
      CHKDEST(LOOPDONE+2);         # CHECK FOR ROOM IN BUFFER          #
      FOR I=0 STEP 1
      UNTIL LOOPDONE-1
      DO
        BEGIN 
        DESAR[I]=GIVARX[I];        # MOVE THE 3 WORD ENTRIES OF LIST.  #015410
        END 
      DESAR[LOOPDONE] = 0;         # ZERO OUT THE LAST 2 WORDS         #
      DESAR[LOOPDONE + 1] = 0;
      P<DEST> = P<DEST> + 2 + LOOPDONE;  # UPDATE POINTER              #
      GIVAR[0]=SAVEADD4;           # CORRECT LINKAGE TO THE LIST.      #015460
                                                                        015470
# NOW GO BACK AND LINK UP THE ITEMS REFERENCED                         #015480
# BY REPORTLIST ENTRIES.                                               #015490
      FOR DUMMY4=4  STEP 3  UNTIL  LOOPDONE  DO                         015500
        BEGIN                                                           015510
        P<GIVE>=SAVEADD4+DUMMY4;   # POSITION ARRAY TO WORD 1 OD       #015520
                                   # THIS ENTRY.                       #015530
        MOVEMOVE;                  # MOVE OR LINK ITEMS.               #015540
        P<GIVE> = SAVEADD4 + DUMMY4 - 1;  # POSITION TO WORD 0         #
        IF B<21,1>GIVAR[0] NQ 0    # IF AT LINE ITEM                   #
        THEN
          BEGIN 
          INTBYTES = 10;           # MOVE ONE WORD                     #
          F = 24; 
          W = 0;
          BITCHECK;                # MOVE LINE NO ITEM                 #
          END 
        END                                                             015550
                                                                        015560
                                                                        015570
# CHANGE SOME OF THE POINTERS IN CREPORT TO SHOW RELATIVE POSITIONS    #
# IN THE NEW RECORD,  NOT ABSOLUTE CORE LOCATIONS.                     #
      P<GIVE>=OLD65+2+LOC(AREPORTLIST)-LOC(CREPTLG);                    015620
      IF GIVAR[0]  NQ  0  THEN                                          015630
        GIVAR[0]=SAVEADD4-BEGINTABLES;                                  015640
                                                                        015650
                                                                        015770
                                                                        015780
# NOW WORK ON SELDTHEAD.   IT CAN POINT TO AN EXPRESSION STACK         #
# AND TO THE RESULTS OF THE EXPRESSION   ( 1 WORD RESULTS ).           #
      P<GIVE>=OLD65+2+LOC(SELEXPR[1])-LOC(CREPTLG);                     015840
      INTBYTES=10;                 # SUP UP LENGTH OF RESULTS          #015850
      F=24;                        # FIRST BIT POSITION OF RESULTS     #015860
      F1=42;                       # 1ST BIT OF EXPRESSION STACK ADD.  #015870
                                   # SET UP THE FOR LOOP.              #015880
      FOR K=0  STEP 1  UNTIL MAXSELECT-1  DO                            015890
        BEGIN                                                           015900
                                   # CHECK FOR THE EXPRESSION STACK    #015920
        W=K;                       # SET WORD POSITION                 #
        EXPROC;                    # PROCESS THIE STACK IF PRESENT     #
                                   # CHECK FOR RESULTS OF EXP STK.     #015980
        BITCHECK;                  # MOVE ITEM IF FIELD PRESENT        #
        END                                                             016040
                                                                        016050
# NOW WORK ON BREAKHEAD.   IT CAN POINT TO AN EXPRESSION STACK         #
# AND TO THE RESULTS OF THE EXPRESSION   ( 1 WORD RESULTS ).           #
                                   # POSITION GIVE                     #016080
      P<GIVE>=OLD65+2+LOC(BRKEXPR[0])-LOC(CREPTLG);                     016090
      F1=42;                       # 1ST BIT POSITION OF ADDRESS       #016100
                                   # SET UP THE LOOP                   #016110
      FOR K = 0 STEP 1
        UNTIL MAXBREAK
      DO
        BEGIN                                                           016130
                                   # TEST FOR PRESENTS OF EXPRESSION   #016150
        W=K;                       # SET WORD POSITION                 #
        EXPROC;                    # PROCESS THE STACK IF PRESENT      #
        END                                                             016210
                                                                        016220
                                                                        016230
      TEMP=P<DEST>-BEGINTABLES;    # COMPUTE LENGHT OF TABLES.         #016240
      P<GIVEX>=BEGINTABLES-1;                                           016250
      GIVARX[0]=TEMP;              # STORE THE LENGHT IN THE RECORD    #016260
                                                                        016270
                                                                        016280
                                   # NOW SAVE THE POINTERS             #
                                   # DESLIST,  DEFLIST,  AND  SPELIST  #
                                   # THEY ARE NO LONGER PART OF THE    #
                                   # COMMON DECK CREPORT               #
  
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      IF DESLNEW NQ 0 THEN
        BEGIN 
        DESAR[0] = DESLNEW - BEGINTABLES; 
        END 
      ELSE
        BEGIN 
        DESAR[0] = 0; 
        END 
      P<DEST> = P<DEST>+1;
  
  
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      IF DEFLNEW NQ 0 THEN
        BEGIN 
        DESAR[0] = DEFLNEW - BEGINTABLES; 
        END 
      ELSE
        BEGIN 
        DESAR[0] = 0; 
        END 
      P<DEST> = P<DEST>+1;
  
  
      CHKDEST(1);                  # CHECK FOR ROOM IN BUFFER          #
      IF SPELNEW NQ 0 THEN
        BEGIN 
        DESAR[0] = SPELNEW - BEGINTABLES; 
        END 
      ELSE
        BEGIN 
        DESAR[0] = 0; 
        END 
      P<DEST> = P<DEST>+1;
                                   # COPY LFNINFO ARRAY TO TABLE       #
  
      P<GIVE> = CURRENTLFPTR;      # POSITION TO LFNINFO ARRAY         #
      FOR I = 0 STEP 1
        UNTIL LFNINFOSIZE - 1 
      DO
        BEGIN 
        DESAR[I] = GIVAR[I];
        END 
      P<DEST> = P<DEST> + LFNINFOSIZE;
      CHARS = P<DEST> - OLD65;     # NUMBER OF WORDS TO WRITE          #
      P<FWA>=OLD65;                                                     016300
      WRITEBR(LFNAME,CHARS,FWA);                                        016340
      COMPLETE;                    # CLEANUP BUFFERS AND LOAD (1,0)    #
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#         C H K D E S T                                                #
#                                                                      #
# THIS PROC CHECKS TO MAKE SURE THERE IS ROOM LEFT IN THE BUFFER TO    #
# TO MOVE THE INDICATED NUMBER OF WORDS.  IF THERE IS NOT ENOUGH       #
# ROOM THEN THE COMPILE DIRECTIVE IS ABANDONED  WITH A DIAGNOSTIC.     #
#         ENTRY  LENGTH = LENGTH OF BLOCK TO BE ADDED TO THE BUFFER.   #
#----------------------------------------------------------------------#
      PROC CHKDEST(LENGTH); 
      BEGIN 
      ITEM LENGTH;                 # LENGTH OF BLOCK TO BE MOVED       #
  
      IF P<DEST> + LENGTH GQ UAFWA + UALENG 
      THEN
        BEGIN 
        DIAG(900);                 # REPORT TOO LARGE FOR COMPILE      #
        COMPLETE;                  # RELEASE BUFFERS AND LOAD (1,0)    #
        END 
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#         C O M P L E T E                                              #
#                                                                      #
# THIS PROC RELEASES ALL BUFFERS USED BY THE OVERLAY BEFORE LOADING    #
# (1,0).                                                               #
#----------------------------------------------------------------------#
      PROC COMPLETE;
      BEGIN 
      FUA;                         # FREE USEABLE AREA                 #
      CMM$FGR(SM$GROUPID);
      CMM$FRF(AREPORTLIST);        # RELEASE AREPORTLIST BUFFER        #
      AREPORTLIST = LOC(FORMATDLINE); 
      RPTLISTASN = FALSE;          # FLAG THAT AREPORTLIST NOT ASSIGNED#
      PRIMARY = 1;
      SECONDARY = 0;
      LOADX0;                      # LOAD (1,0) OVERLAY AND EXECUTE IT #
      END 
                                                          CONTROL EJECT;016370
#**********************************************************************#016380
#                                                                      #
# PROCEDURE TO MOVE ENTRIES IN THE DESCRIBE,                           #016390
# THE DEFINE, AND SPECIFY TABLES.                                      #016400
# ON ENTRY THISOLD EQUALS THE ADDRESS OF FIRST ENTRY IN THE STRING.    #016410
#                                                                      #
#**********************************************************************#
                                                                        016420
      PROC MOVETAB1;                                                    016430
        BEGIN                                                           016440
        FOR DUMMY=0  STEP 1  DO    # LOOP TO MOVE ONE ENTRY EACH PASS  #016450
                                   # THRU THE LOOP.  LOOP WILL END     #016460
                                   # WHEN A ZERO VALUE FOR THE POINTER #016470
                                   # IS FOUND.                         #016480
          BEGIN                                                         016490
          P<GIVE>=THISOLD;         # POSITION ARRARY TO                #016500
          ADDOLD=THISOLD;          # ENTER OLD AND NEW TABLE           #
          ADDNEW=P<DEST>;          # ADDRESS IN THE OLD NEW TABLE      #
          STORENEW;                # PLACE IN THE TABLE                #
          P<DESCRAY>=THISOLD;      #OLD ENTRY LOCATION.                #016510
          NEXTOLD=DESPOINT[0];      # LINK TO NEXT ENTRY.              #016520
                                   #COMPUTE LENGTH OF THIS ENTRY.      #016530
          LENGTH=3+DESNAMEL[0]+DESOCCF[0];                              016540
                                   # MOVE ENTRY INTO THE NEW AREA.     #016590
          CHKDEST(LENGTH);         # CHECK FOR ROOM IN BUFFER          #
          FOR I=0  STEP 1  UNTIL LENGTH-1  DO                           016600
            DESAR[I]=GIVAR[I];                                          016610
          IF DESMURP NQ 0 THEN     # IF MURAL EXISTS                   #
            BEGIN 
            P<GIVE> = THISOLD + DESMURP;  # POSITION TO MURAL          #
            J = B<55,5>GIVAR[0];   # LENGTH OF MURAL                   #
            CHKDEST(LENGTH+J);     # CHECK FOR ROOM IN BUFFER          #
            FOR I=0 STEP 1         # COPY MURAL INTO BUFFER            #
              UNTIL J-1 
            DO
              BEGIN 
              DESAR[LENGTH+I] = GIVAR[I]; 
              END 
            P<DESCRAY> = P<DEST>;  # POSITION TO ENTRY IN TABLE BUFFER #
            DESMURP = LENGTH;      # UPDATE MURAL POINTER              #
            LENGTH = LENGTH + J;   # INDICATE MURAL COPIED             #
            END 
          P<DESCRAY> = THISOLD;    # POSITION TO DEFINE ENTRY          #
          IF MOVDEF                # IF MOVING DEFINE LIST             #
            AND DESOCCF NQ 0       # IF DEFINED ARRAY                  #
          THEN
            BEGIN 
            J = (DECLSLG * DMAXOCR + 9) / 10;  # LENGTH OF ARRAY IN WRD#
            CHKDEST(J + LENGTH);   # CHECK FOR ROOM IN BUFFER          #
            OFFSET = LOC(DESAR[LENGTH]) - DEWPOS;  # NEW ADD - OLD ADD #
            P<GIVE> = DEWPOS;      # POSITION TO ARRAY OF VALUES       #
            FOR I = 0 STEP 1       # MOVE ENTIRE ARRAY                 #
              UNTIL J - 1 
            DO
              BEGIN 
              DESAR[LENGTH + I] = GIVAR[I]; 
              END 
            LENGTH = LENGTH + J;   # UPDATE NO OF WORDS COPIED         #
            J = -DECLSLG; 
            FOR I = 1 STEP 1       # ENTER OLD AND NEW ADDRESS OF EACH #
                                   # VALUE OF ARRAY IN OLD-NEW TABLE   #
              UNTIL DMAXOCR 
            DO
              BEGIN 
              J = J + DECLSLG;     # CHAR POSITION WITHIN ARRAY        #
              ADDOLD = (J + 9) / 10 + DEWPOS;  # CONVERT TO WORD ADDR  #
              ADDNEW = ADDOLD + OFFSET; 
              STORENEW;            # STORE ADDRESSES IN OLD-NEW TABLE  #
              END 
            END 
                                   # TEST TO SEE IF THIS IS THE        #016620
                                   # LAST ENTRY IN THE STING.          #016630
          IF NEXTOLD  NQ  0  THEN                                       016640
            BEGIN                                                       016650
                                   # NOT THE LAST ENTRY OF STRING.     #016660
            NEXTNEW=P<DEST>+LENGTH;                                     016670
                                   # UPDATE POINTER TO NEW AREA.       #016680
                                   # SET HIGH ORDER BIT AS A FLAG      #016690
                                   # TO REPORT.                        #016700
            DESLINK[0]=(NEXTNEW-BEGINTABLES)+O"400000";                 016710
            P<DEST>=NEXTNEW;       # UPDATE POINTER TO NEW AREA.       #016720
            THISOLD=NEXTOLD;       # SET UP AND LOOP BACK ON NEXT ENTRY#016730
            END                                                         016740
           ELSE                                                         016750
            BEGIN                                                       016760
                                   # POINTER IS ZERO.  LAST ENTRY IN   #016770
                                   # THIS STRING.                      #016780
            P<DEST>=P<DEST>+LENGTH;  # UPDATE POINTER                  #016790
            RETURN;                # EXIT PROCEDURE.                   #016800
            END                                                         016810
          END                                                           016820
        END                                                             016830
                                                          CONTROL EJECT;016840
#**********************************************************************#016850
#                                                                      #
# THIS PROCEDURE MOVES THE VALUES, CONVERT TABLES AND EXPRESSION       #
# STACKS REFERENCED BY *DEFINE* OR *DESCRIBE* TABLES.                  #
# ON ENTRY THISNEW = LOCATION OF 1ST ENTRY IN STRING.                  #016890
#                                                                      #
#**********************************************************************#
                                                                        016900
      PROC MOVECONTROL;                                                 016910
      BEGIN                                                             016920
      FOR DUMMY=0  STEP 1  DO      # DUMMY LOOP.                       #016930
        BEGIN                                                           016940
        P<GIVE>=THISNEW;           # POSITION ARRAY                    #016950
                                                                        017010
        IF B<2,1>GIVAR[2] NQ 0     # IF DEPENDING ON WORD PRESENT      #
        THEN
          BEGIN 
          INTBYTES = 10;           # ONE WORD INTEGER VALUE TO MOVE    #
          F = 42; 
          W = 3;
          BITCHECK;                # MOVE ITEM IF PRESENT              #
          END 
  
        F=6;                                                            017020
        W=0;                                                            017030
        INTBYTES=20;               # CONVERT TABLE 2 WORDS LONG.       #017040
        BITCHECK;                  # CHECK ADDRESS OF CONVERT TABLE.   #017050
                                   # NOW CHECK TO SEE IF A CONVERT     #017060
                                   # TABLE WAS PRESENT.  IF IT WAS     #017070
                                   # ALREADY MOVED NO NEED TO RE-LINK  #017080
        IF TEMPADD   NQ  0
        AND FLAG1    NQ  0   THEN  # WAS IT PREVIOUSLY MOVED.          #
          BEGIN 
                                   # NO.  LINK UP THE CONVERT TABLE.   #017120
          SAVEADD=P<GIVE>;         # SAVE CURRENT POSITION.            #
          P<GIVE>=P<DEST>-2;       # BACK UP TO CONVERT TABLE.         #
          MOVEMOVE;                # MOVE ITEMS REFERENCED BY THE      #
                                   # CONVERT TABLE.                    #017160
          P<GIVE>=SAVEADD;         # RESET POSITION.                   #01
          END 
                                                                        017190
                                   # CHECK FOR EXPRESSION STACK        #017200
        F1=24;                     # SET 1ST BIT POSITION              #
        W=0;                       # SET WORD POSITION                 #
        EXPROC;                    # PROCESS THE STACK IF PRESENT      #
                                                                        016960
        F=18;                      # SET FIRST BIT POSITION TO 18.     #016970
        W=1;                       # SET WORD TO ONE.                  #016980
        INTBYTES=B<42,18>GIVAR[1];   # FETCH SIZE OF VALUE IN BYTES.   #016990
        IF INTBYTES  EQ  0  THEN   # MUST BE AT LEAST ONE WORD LONG    #
          INTBYTES = 10;
        IF B<2,1>GIVAR[2] NQ 0     # IF DIMENSIONED ITEM               #
        THEN
          BEGIN 
          INTBYTES = INTBYTES * B<6,24>GIVAR[3];  # TIMES NO. OF VALUES#
          END 
        BITCHECK;                  # CHECK ADDRESS OF VALUE  FIELD.    #017000
                                                                        017430
                                   # NOW FOLLOW THIS STRING.           #017440
        THISNEW=B<42,18>GIVAR[0];  # FETCH FORWARD LINK.               #017450
                                   # LINK.  SUBTRACT HIGH BIT.         #017460
        IF THISNEW  EQ  0  THEN    # IF POINTER ZERO                   #017470
          RETURN;                  # DONE WITH THIS STRING.            #017480
                                                                        017490
                                   # POINTER NOT ZERO.                 #017500
                                   # FIND CORE LOCATION.               #017510
                                   #  SUBTRACT HIGH ORDER BIT.         #017520
          THISNEW=(THISNEW+BEGINTABLES)-O"400000";                      017530
        END                                                             017540
      END                                                               017550
                                                          CONTROL EJECT;017560
#**********************************************************************#017570
#                                                                      #
# PROCEDURE TO BE MAIN SUBCONTROL OF MOVING CONVERSION                 #017580
# PARAMETER OR MOVE PARAMETERS.                                        #017590
# ON ENTRY ARRAY  GIVE  SHOULD BE POSITIONED TO THE                    #017600
# FIRST WORD ON THE TABLE.                                             #017610
#                                                                      #
#**********************************************************************#
                                                                        017620
      PROC MOVEMOVE;                                                    017630
      BEGIN                                                             017640
      ITEM TEMP;                   # SAVE P<GIVE>                      #
        EDITBIT=B<3,1>GIVAR[0];     #FETCH EDIT FLAG BIT.              #017650
        CONVERTCODE=B<0,3>GIVAR[0];  # FETCH ENTRY CODE                #
                                                                        017670
        CCODE = B<0,6>GIVAR[1];    # CONVERT CODE                      #
  
                                   # START ON THE FROM FIELD           #
        F = 24;                    # SET FIRST BIT POSITION            #
        W = 0;                     # SET WORD NUMBER                   #
        INTBYTES = B<12,12>GIVAR[0];  # SET ITEM LENGTH                #
        IF CONVERTCODE GQ 2        # IF CONVERSION REQUIRED            #
          AND B<CCODE,1>MVEVFROM[EDITBIT] NQ 0  # IF FROM POINTER POINT#
                                                # TO ATTRIBUTE TABLE   #
        THEN
          BEGIN 
          ATTCONTROL;              # PROCESS THE FROM ATTRIB           #
          END 
        ELSE
          BEGIN 
          BITCHECK;                # CHECK FROM FIELD FOR ADDRESS      #
          END 
  
        F = 42;                    # NOW WORK ON *TO* FIELD            #
        W = 0;
        IF CONVERTCODE GQ 2        # IF CONVERSION REQUIRED            #
          AND B<CCODE,1>MVTO[EDITBIT] NQ 0  # IF TO POINTER POINTS TO  #
                                            # ATTRIBUTE TABLE          #
        THEN
          BEGIN 
          ATTCONTROL;              # PROCESS TO ATTRIB                 #
          END 
        ELSE
          BEGIN 
          BITCHECK;                # CHECK TO FIELD FOR ADDRESS        #
          END 
                                                                        018090
                                   # NOW CHECK FIELD  I                #018100
                                   # WHICH CAN BE THE ADDRESS OF AN    #018110
                                   # EXPRESSION STACK, SUBSCRIPT TABLE #018120
                                   # OR ZERO.                          #018130
          TEMP=B<6,18>GIVAR[1];    # GET ADDRESS FIELD.                #018140
          IF TEMP  NQ  0  THEN                                          018150
            BEGIN                                                       018160
                                   # ADDRESS FIELD IS NON ZERO.        #018170
            IF CONVERTCODE EQ 3    # IF EXPRESSION STACK               #
            THEN
              BEGIN 
              F1 = 6;              # BIT POSITION                      #
              W = 1;
              EXPROC;              # PROCESS EXPRESSION STACK          #
              END 
          ELSE
            BEGIN 
            IF CONVERTCODE EQ 4    # IF SIMPLE SUBSCRIPT TABLE         #
                                   # I.E., MOVE A(X) TO B              #
            THEN
              BEGIN 
              J = 0;
              F = 6;               # BIT POSITION                      #
              MOVFIG;              # MOVE SUBSCRIPT TABLE              #
              END 
            IF CONVERTCODE GQ 5    # IF SUBSCRIPT TABLE CONTAINS ATTRIB#
              AND CONVERTCODE LQ 7 # EXPRESSION STACK, OR SUBSCRIPT    #
                                   # TABLE POINTERS                    #
            THEN
              BEGIN 
              TEMP = P<GIVE>;      # SAVE ADDRESS OF MOVE ENTRY        #
              P<GIVE> = B<6,18>GIVAR[1]; # ADDRESS OF SUBSCRIPT TABLE  #
              INTBYTES = 10;       # ONE WORD ENTRY                    #
              F = 42; 
              W = 0;
              BITCHECK;            # MOVE FIG SUBSCRIPT                #
              IF B<6,4>GIVAR[0] GR 1  # IF 2ND WORD PRESENT            #
              THEN
                BEGIN 
                F = 42; 
                W = 1;
                BITCHECK;          # DEPENDING ON ITEM                 #
                END 
              F = 18; 
              W = 2;
              ATTCONTROL;          # MOVE ATTRIBUTE TABLE              #
              IF CONVERTCODE EQ 5  # IF SUBSCRIPT TABLE CONTAINS       #
                                   # PTR TO SUBSCRIPT TABLE            #
                                   # I.E., MOVE A(X) TO B(Y)           #
              THEN
                BEGIN 
                J = 1;
                F = 42; 
                MOVFIG;            # MOVE SUBSCRIPT TABLE              #
                END 
              IF CONVERTCODE EQ 7  # IF SUBSCRIPT TABLE CONTAINS EXP   #
                                   # STACK POINTER                     #
                                   # I.E., MOVE A + B TO C(X)          #
              THEN
                BEGIN 
                W = 2;
                F1 = 42;
                EXPROC;            # MOVE EXPRESSION STACK             #
                END 
              P<GIVE> = TEMP;      # POSITION TO MOVE TABLE            #
              W = 1;
              F = 6;
              INTBYTES = 30;       # MOVE 3 WORDS                      #
              BITCHECK;            # MOVE SUBSCRIPT TABLE              #
              END 
            END 
            END                                                         018550
                                                                        017960
                                   # THIS FIELD IS THE  J  FIELD,      #017970
                                   # SEE THE  IMS  FOR DETAILS.        #017980
          INTBYTES=10;             # ENTRIES ARE ONE WORD.             #017990
          F=24;                    # SET UP BIT AND                    #018000
          W=1;                     # WORD POSITIONS.                   #018010
          BITCHECK;                # CHECK FIELD FOR ADDRESS.          #018020
                                                                        018030
                                   # THIS FIELD IS THE  K  FIELD,      #018040
                                   # SEE  IMS  FOR DETAILS.            #018050
          F=42;                    # SET UP BIT AND                    #018060
          W=1;                     # WORD POSITION.                    #018070
          BITCHECK;                # CHECK FIELD FOR ADDRESS.          #018080
          P<GIVE>=SAVEADD;         # RESET TO ENTRY POSITION.          #018560
      END                                                               018570
                                                                        018580
                                                                        018590
#********************************************************************* #018600
#                                                                      #
# PROCEDURE TO CONTROL MOVING AND LINKING OF THE ATTRIBUTE TABLES.     #018610
# ON ENTRY GIVE SHOULD BE POSITIONED ON THE FIRST WORD OF THE          #018620
# REFERENCING TABLE                                                    #018630
#                                                                      #
#**********************************************************************#
                                                                        018640
      PROC ATTCONTROL;                                                  018650
      BEGIN                                                             018660
      ITEM SAVBYTES;               # SAVE LENGTH OF ITEM               #
  
      SAVBYTES = INTBYTES;         # SAVE PREVIOUS LENGTH              #
      INTBYTES = 70;               # MOVE 70 CHARACTERS                #
      BITCHECK;                    # TEST FIELD FOR ADDRESS            #018670
      INTBYTES = SAVBYTES;         # RESTORE PREVIOUS LENGTH           #
      IF TEMPADD NQ 0              # IF FIELD PRESENT                  #
        AND FLAG1 NQ 0             # AND WE JUST MOVED ITEM            #
      THEN
        BEGIN                                                           018690
                                   # YES NOW CHECK ITS POINTER         #018700
        SAVEADD1 = P<GIVE>;        # SAVE CURRENT POSITION OF GIVE     #
        P<GIVE>=P<DEST>-6;         # POSITION TO SECOND WORD           #018730
        F = 18; 
        W=0;                                                            018750
        BITCHECK;                                                       018760
        P<GIVE> = SAVEADD1;        # RESTORE OLD POSITION OF GIVE      #
        INTBYTES = SAVBYTES;       # RESTORE PREVIOUS LENGTH           #
        END                                                             018790
      END                                                               018810
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# PROCEDURE TO CONTROL THE MOVING OF EXPRESSION STACKS                 #
# ON ENTRY   F1 = 1ST BIT OF STACK ADDRESS                             #
#             W = WORD INDEX IN GIVAR                                  #
#                                                                      #
#**********************************************************************#
  
      PROC  EXPROC; 
      BEGIN 
      TEMP=B<F1,18>GIVAR[W];       # LOOK FOR AN STACK ADDRESS         #
                                   # IF TEMP BETWEEN HHA AND FL        #
      IF TEMP GR HIGHEST AND TEMP LS QUFL THEN
        BEGIN 
                                   # FOUND AN EXPRESSION STACK ADDRESS #
        SAVEADD5=P<GIVE>;          # SAVE POSITION OF GIVE             #
        WSAVE=W;
        P<GIVE>=TEMP;              # POSITION TO EXPRESSION STACK      #
        MOVEXPST;                  # MOVE THE STACK                    #
        P<GIVE>=SAVEADD5;          # RESTORE POSITION OF GIVE          #
        W=WSAVE;
        B<F1,18>GIVAR[W]=ADDNEW;   # UPDATE THE LINK TO NEW STACK LOC  #
  
                                   # DID THIS STACK REFERENCE OTHER    #
                                   # EXPRESSION STACKS                 #
        IF TBLG  NQ  0  THEN
          BEGIN 
                                   #  YES   IT DID                     #
          UNSTACK;                 # UNSTACK THEM                      #
          P<GIVE>=SAVEADD5;        # RESTORE POSITION OF GIVE          #
          END 
        END 
      END 
                                                          CONTROL EJECT;018820
#**********************************************************************#018830
#                                                                      #
#PROCEDURE TO BE THE MAIN SUBCONTROL OF MOVING EXPRESSION STACKS.      #018840
# THIS PROCEDURE WILL MOVE THE ENTIRE STACK,  THEN GO BACK AND LINK    #018850
# UP THE POINTERS.                                                     #018860
# ON ENTRY  GIVE   SHOULD BE POSITIONED ON THE FIRST ENTRY             #018870
# IN THE EXPRESSION STACK.                                             #018880
#                                                                      #
#**********************************************************************#
                                                                        018890
      PROC MOVEXPST;                                                    018900
      BEGIN                                                             018910
                                   # CHECK TO SEE IF THE STACK HAS     #018920
                                   # ALREADY BEEN MOVED.               #018930
      ADDOLD=P<GIVE>;              # ADDRESS OF STACK.                 #018940
      OLDNEW;                      # CHECK.                            #018950
      IF ADDNEW  NQ  0  THEN                                            018960
                                   # STACK HAS NEW ADDRESS.  IT HAS    #018970
        RETURN;                    # BEEN MOVED ALREADY.               #018980
      MOVEXPT2;                    # MOVE THE VARABLE LENGTH STACK.    #018990
                                   # ON RETURN I= INDEX VALUE OF 2     #019000
                                   # WORD ENTRIES IN THE EXPRESSION    #019010
                                   # STACK.                            #019020
      SADDNEW=ADDREL;              # SAVE LINKAGE TO STACK...          #019030
      P<GIVE>=ADDNEW;              # POSITION TO NEW STACK LOCATION.   #019040
      EXPLENGTH=I;                 # EXP STACK LENGHT.                 #019050
      FOR J = 0 STEP 4
        UNTIL EXPLENGTH 
      DO
        BEGIN                                                           019070
        INTBYTES=B<12,12>GIVAR[J];  #FETCH SIZE OF THE ITEM.           #019080
                                   # INTBYTES MUST BE AT LEAST 1 WORD  #
          IF INTBYTES  EQ  0  THEN
            INTBYTES=10;           # FOR TYPE 7 ENTRIES                #
                                                                        019090
                                   # TEST FIELD  F  OF THE EXP STACK.  #019100
                                   # IF ANY ARE TRUE THEN THE FROM     #
                                   # (F)F FIELD POINTS TO AN           #
                                   # ATTRIBUTE ENTRIES                 #
        EDITBIT=B<3,1>GIVAR[J]; 
        CONVERTCODE=B<0,3>GIVAR[J]; 
                                                                        019140
        CCODE = B<0,6>GIVAR[J+1];  # CONVERT CODE FIELD IN EXPRESSION  #
  
        F = 24;                    # SET FIRST BIT POSITION            #
        W = J;                     # SET WORD NUMBER                   #
        IF CONVERTCODE GQ 2        # IF CONVERSION REQUIRED            #
          AND B<CCODE,1>MVEVFROM[EDITBIT] NQ 0  # IF FROM POINTER POINT#
                                                # TO ATTRIBUTE TABLE   #
        THEN
          BEGIN 
          ATTCONTROL;              # PROCESS THE FROM ATTRIB           #
          END 
        ELSE
          BEGIN 
          BITCHECK;                # CHECK FROM FIELD FOR ADDRESS      #
          END 
  
        IF INTBYTES LQ 10 
          AND (CCODE EQ O"37"      # FLOATING TO DOUBLE                #
          OR CCODE EQ O"40"        # FLOATING TO COMPLEX               #
          OR CCODE EQ O"31"        # FLOATING TO DOUBLE                #
          OR CCODE EQ O"32"        # FLOATING TO COMPLEX               #
          OR CCODE EQ O"23"        # INTEGER TO DOUBLE                 #
          OR CCODE EQ O"24"        # INTEGER TO COMPLEX                #
          OR CCODE EQ O"15"        # NUMERIC TO DOUBLE                 #
          OR CCODE EQ O"16"        # NUMERIC TO COMPLEX                #
          OR CCODE EQ O"6"         # CHARACTER TO DOUBLE               #
          OR CCODE EQ O"7")        # CHARACTER TO COMPLEX              #
        THEN
          BEGIN 
          INTBYTES = 20;           # TWO WORD RESULT IS EXPECTED       #
          END 
  
                                   # TEST FIELD  G  OF THE EXP STACK.  #019150
        F=42;                      # SET BIT POSITION.                 #019160
        W = J;
        BITCHECK;                  # CHECK FIELD FOR ADDRESS.          #019170
                                                                        019180
                                   # TEST FIELD  J  OF THE EXP STACK   #019190
        F=24;                                                           019200
        W=J+1;                                                          019210
        BITCHECK;                  # CHECK FIELD FOR ADDRESS.          #019220
                                                                        019230
                                   # TEST FIELD  K  OF THE EXP STACK   #019240
        F=24;                                                           019250
        BITCHECK;                  # CHECK FIELD FOR AN ADDRESS        #019260
                                                                        019270
                                   # NOW CHECK FIELD  I  WHICH CAN     #019280
                                   # POINT TO ANOTHER EXPRESSION STACK.#019290
        IF B<6,18>GIVAR[J+1]  EQ  0                                     019300
          THEN  TEST J;            # IF ZERO NO STACK FOR THIS         #019310
                                   # ENTRY IN THE EXPRESSION STACK.    #019320
                                                                        019330
        IF CONVERTCODE EQ 4        # IF FIGURATIVE SUBSCRIPT POINTER   #
          OR CONVERTCODE EQ 5 
        THEN
          BEGIN 
          F = 6;                   # BIT POSITION                      #
          MOVFIG;                  # MOVE FIGURATIVE SUBSCRIPT TABLE   #
          TEST J; 
          END 
  
        IF CONVERTCODE NQ 7        # IF AN OPERATOR THEN THIS FIELD    #
        THEN                       # CONTAINS NUMBER OF PARAMETERS     #
          BEGIN 
        ADDOLD=B<6,18>GIVAR[J+1];  # CHECK TO SEE IF EXPRESSION STACK  #019360
        OLDNEW;                    # HAS ALREADY BEEN MOVED.           #019370
        IF ADDNEW  NQ  0  THEN                                          019380
          BEGIN                                                         019390
                                   # IT HAS ALREADY BEEN MOVED.        #019400
          B<6,18>GIVAR[J+1]=ADDNEW;  # UPDATE LINK.                    #019410
          TEST  J;                 # CHECK NEXT 2 WORD ENTRY IN STACK  #019420
          END                                                           019430
                                                                        019440
                                   # STACK HAS NOT YET BEEN MOVED.     #019450
        TBAR1[TBLG]=P<GIVE>+J+1;  # REFERENCE ADDRESS                  #019460
        TBAR2[TBLG]=ADDOLD;        # ADDRESS OF EXPRESSION STACK.      #019470
        TBLG=TBLG+1;               # UPDATE POINTER.                   #019480
          END 
        END                                                             019490
      ADDNEW=SADDNEW;              # RESTORE ADD OF THIS EXP. STACK    #019500
      END                                                               019510
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#         M O V F I G                                                  #
#                                                                      #
#         THIS PROC MOVES A FIGURATIVE SUBSCRIPT ENTRY ADDRESSED BY    #
#         THE EXPRESSION STACK FIELD OF THE CURRENT EXPRESSION STACK   #
#         ENTRY.  THE SUBSCRIPT TABLE MAY BE ONE OR TWO WORDS LONG.    #
#         IF THE INDEX OR DEPENDENCY FIELDS ARE PRESENT THESE ITEMS    #
#         WILL BE MOVED TOO.                                           #
#                                                                      #
#         ENTRY  B<F,18>GIVAR[J+1] = SUBSCRIPT TABLE POINTER           #
#----------------------------------------------------------------------#
      PROC MOVFIG;
      BEGIN 
      ITEM TEMP;                   # SAVE EXPRESSION STACK POINTER     #
      ITEM SAVEF;                  # SAVE F                            #
  
      TEMP = P<GIVE>;              # SAVE SOURCE POINTER               #
      SAVEF = F;                   # SAVE F                            #
      P<GIVE> = B<F,18>GIVAR[J+1]; # FIGURATIVE SUBSCRIPT ADDRESS      #
      INTBYTES = 10;               # ONE WORD ENTRY                    #
      F = 42;                      # CHECK INDEX POINTER               #
      W = 0;
      BITCHECK;                    # MOVE THIS ITEM IF PRESENT         #
      IF B<6,4>GIVAR[0] GR 1       # IF 2ND WORD PRESENT               #
      THEN                         # IF SECOND WORD PRESENT            #
        BEGIN 
        F = 42;                    # CHECK DEPENDING ON ITEM           #
        W = 1;
        BITCHECK;                  # MOVE THIS ITEM IF PRESENT         #
        END 
      INTBYTES = B<6,4>GIVAR[0] * 10;  # LENGTH OF SUBSCRIPT TABLE     #
      P<GIVE> = TEMP;              # RESTORE POINTER TO EXPRESSION     #
      F = SAVEF;                   # RESTORE F                         #
      W = J + 1;
      BITCHECK;                    # MOVE THIS TABLE ENTRY             #
      END 
                                                          CONTROL EJECT;019520
#**********************************************************************#019530
#                                                                      #
# THIS PROCEDURE WILL MOVE ONE EXPRESSION STACK EACH                   #019540
# TIME THRU THE PROC.   THE EXPRESSION STACK ENDS                      #019550
# WHEN A VALUE OF OCTAL 70 IS FOUND IN FIELD  J  .                     #019560
#                                                                      #
#**********************************************************************#
                                                                        019570
      PROC MOVEXPT2;                                                    019580
      BEGIN                                                             019590
      FOR I = 0 STEP 4             # SET UP LOOP                       #
      DO
        BEGIN                                                           019610
        CHKDEST(I + 4);            # CHECK FOR ROOM IN BUFFERS         #
        DESAR[I]=GIVAR[I];         # MOVE THE                          #019620
        DESAR[I + 1] = GIVAR[I + 1];  #FOUR WORD STACK ENTRY           #
        DESAR[I+2]=GIVAR[I+2];
        DESAR[I + 3] = GIVAR[I + 3];
        IF B<24,18>GIVAR[I]  EQ  O"70"  THEN                            019640
          BEGIN                                                         019650
                                   # OCTAL 70 IS END OF STACK.         #019660
          ADDOLD=P<GIVE>;          # ENTER STACK OLD AND NEW ADDRESS   #019670
          ADDNEW=P<DEST>;          # SO WE KNOW THAT IT HAS BEEN       #019680
          STORENEW;                # MOVED.                            #019690
        # END OF STACK.  UPDATE POINTERS                               #
        P<DEST> = P<DEST> + I + 4;
          RETURN;                  # EXIT PROC.                        #019710
          END                                                           019720
        END                                                             019730
      END                                                               019740
                                                                        019750
                                                                        019760
#**********************************************************************#019770
#                                                                      #
# PROCEDURE TO CONTROL UNSTACKING OF TABAR ARRAY>                      #019780
#                                                                      #
#**********************************************************************#
                                                                        019790
      PROC UNSTACK;                                                     019800
      BEGIN                                                             019810
      FOR DUMMY3=0  STEP 1  DO                                          019820
        BEGIN                                                           019830
        STBAR1=TBAR1[0];           # SAVE THE POINTERS                 #019840
        STBAR2=TBAR2[0];           # FROM POSITION 0.                  #019850
        IF STBAR1  EQ  0  THEN     # TBAR1 IS EMPTY                    #019860
          RETURN;                  # WHEN ZERO.  RETURN.               #019870
        FOR L=1  STEP 1  UNTIL TBLG-1  DO                               019880
          BEGIN                                                         019890
          TBAR1[L-1]=TBAR1[L];     # MOVE THE STACK DOWN               #019900
          TBAR2[L-1]=TBAR2[L];     # ONE POSITION.                     #019910
          END                                                           019920
        TBAR1[L]=0;                # ZERO OUT LAST WORD                #019930
        TBAR2[L]=0;                # IN THE STACK.                     #019940
        TBLG=TBLG-1;               # DECREASE TABLE POINTER.           #019950
                                   # NOW PROCESS THIS EXPRESSION       #019960
                                   # STACK.                            #019970
        P<GIVE>=STBAR2;            # MOVE THIS EXPRESSION STACK.       #019980
        MOVEXPST;                  # MOVE THIS EXPRESSION STACK.       #019990
        TEMP=P<DEST>;                                                   020000
        P<DEST>=STBAR1;            # SET UP TO                         #020010
        B<6,18>DESAR[0]=ADDNEW;    # UPDATE THE LINK.                  #020020
        P<DEST>=TEMP;              # RESTORE CURRENT STORE ADDRESS.    #020030
        END                                                             020040
      END                                                               020050
                                                          CONTROL EJECT;020770
#**********************************************************************#020780
#                                                                      #
# PROCEDURE TO BE THE MAIN CONTROL OF RE-LINKING                       #020790
# THE VARIOUS HEADING , FOOTING, ECT.  ARRARYS.                        #020800
# THESE ARRARYS CAN POINT TO EATHER AN EXPRESSION                      #020810
# STACK OR A MOVE TABLE.                                               #020820
#                                                                      #
#**********************************************************************#
                                                                        020830
      PROC MOVEREPT;                                                    020840
      BEGIN                                                             020850
      FOR DUMMY4=0  STEP 1  UNTIL LOOPDONE-1   DO 
        BEGIN                                                           020870
        IF B<24,18>GIVAR[0]  NQ  0  THEN  EEV24;   # CHECK FOR         #020880
        IF B<42,18>GIVAR[0]  NQ  0  THEN  EEV42;   # EXPRESSIONS.      #020890
        P<GIVE>=P<GIVE>+1;                                              020900
        IF B<24,18>GIVAR[0]  NQ  0  THEN  EMV24;   # CHECK FOR         #020910
        IF B<42,18>GIVAR[0]  NQ  0  THEN  EMV42;   # MOVE TABLES       #020920
        P<GIVE>=P<GIVE>+1;                                              020930
        END                                                             020940
      END                                                               020950
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# COLLECTION OF PROCEDURES TO BE THE CONTROL OF MOVING                 #
# AND OR LINKING THE LIST OF CONVERSION PRAMETERS,  EXPRESSION STACKS  #
# AND ATTRIBUTE TABLES POINTED TO IN THE EVALUATE BEFOR/AFERT ARRAYS   #
#                                                                      #
#**********************************************************************#
  
  
  
# STRING POINTER IN BITS  24-41.                                       #
  
      PROC  EEV24;
      BEGIN 
      F1=24;                       # SET 1ST BIT POSITION              #
      EEVCOM;                      # COMMON CONTROL ROUTINE            #
      END 
  
  
# STRING POINTER IN BITS  42-59                                        #
  
      PROC  EEV42;
      BEGIN 
      F1=42;                       # SET 1ST BIT POSITION              #
      EEVCOM;                      # COMMON CONTROL ROUTINE            #
      END 
  
  
# COMMON ROUTINE TO PROCESS EVALUATE BEFOR/AFTER STRINGS               #
# ON ENTRY  F1 = BIT POSITION                                          #
#         GIVE = POSITION (WORD) OF REFERENCE                          #
  
      PROC  EEVCOM; 
      BEGIN 
      SAVEADD3=P<GIVE>;            # SAVE POSITION OF GIVE             #
      P<GIVE>=B<F1,18>GIVAR[0];    # POSITION TO 1ST ENTRY OF STRING   #
      MEVALSTNG;                   # MOVE EVAL STRING,  ALL OF IT      #
  
      P<GIVE>=SAVEADD3;            # POSITION BACK TO REF LOCATION     #
                                   # UPDATE THE LINK. MAKE IT RELATIVE #
      B<F1,18>GIVAR[0]=(ADDNEW-BEGINTABLES)+O"400000";
  
                                   # NOW STEP THRU THE STRING MOVING   #
                                   # AND/OR LINKING ITEMS REFERENCED.  #
                                   # THEY CAN BE CONVERSION TABLES,    #
                                   #          OR EXPRESSION STACKS,    #
                                   #          OR ATTRIBUTE TABLES.     #
      P<GIVE>=ADDNEW;              # POSITION TO THE TABEL             #
      FOR DONE=0  WHILE  DONE  EQ  0  DO
        BEGIN 
        FOR K=0  STEP 1  UNTIL 5  DO
          BEGIN 
          IF GIVAR[K]  EQ  0  THEN
            BEGIN 
            DONE=1;                # FOUND ZERO WORD.  END  OF POINTERS#
            TEST DONE;             # EXIT PROC                         #
            END 
          ELSE
            BEGIN 
                                   # NOT ZERO.  NOT END OF STRING.     #
  
                                   # CHECK FOR EXPRESSION STACK ADD    #
            F1=24;                 # SET 1ST BIT POSITION              #
            W=K;                   # SET WORD POSITION                 #
            EXPROC;                # PROCESS THE STACK IF PRESENT      #
  
                                   # CHECK FOR CONVERSION TABLE        #
                                   # CONVERT TABLE IS 2 WORDS LONG     #
            F=6;                   # SET TO STARTING BIT               #
            W=K;                   # SET WORD POSITION                 #
            INTBYTES=20;           # 2 WORDS LONG                      #
            BITCHECK;              # CHEK FOR CONVERT TABLE ADDRESS    #
                                   # NOW CHECK TO SEE IF A CONVERT     #
                                   # TABLE WAS PRESENT                 #
            IF TEMPADD  NQ  0 
            AND  FLAG1  NQ  0  THEN   # WAS IT ALREADY MOVED           #
              BEGIN 
                                   # NO.  LINK IT UP                   #
              SAVEADD=P<GIVE>;     # SAVE POSITION                     #
              P<GIVE>=P<DEST>-2;   # BACK UP TO CONVERSION TABLE       #
              MOVEMOVE;            # MOVE/LINK ITEMS REF BY CONVERT TAB#
              P<GIVE>=SAVEADD;     # RESTORE POSITION                  #
              END 
  
                                   # CHECK FOR ATTRIBUTE TABLE         #
            IF B<42,18>GIVAR[K]  NQ  0   THEN 
              BEGIN 
                                   # THERE IS ONE.  IT IS 7 WORDS LONG #
              F=42;                # 1ST BIT POSITION                  #
              W=K;                 # WORD NUMBER                       #
              ATTCONTROL;          # PROCESS THE ATTRIBUTE TABLE       #
              END 
            END 
          END 
                                   # TEST WORD 7 FOR POINTER TO NEXT   #
                                   # SEVEN WORD STACK                  #
        IF GIVAR[6]  NQ  0  THEN
          BEGIN 
                                   # MORE TO WORK ON                   #
          P<GIVE>=P<GIVE>+7;       # POSITION TO NEXT BLOCK OF 7 WORDS #
          TEST DONE;               # WORK ON THIS NEXT BLOCK           #
          END 
        ELSE                       # END OF EVALUATE TABLE             #
          BEGIN 
          DONE = 1;                # INDICATE END OF *FOR* LOOP        #
          TEST DONE;
          END 
        END 
      P<GIVE> = SAVEADD3;          # RESTORE ORIGINAL POSITION         #
      END 
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# COLLECTION OF PROCEDURES TO BE THE CONTROL OF MOVING                 #
# AND/OR LINKINK THE LIST OF MOVE TABLES POINTED TO IN THE             #
# MOVE BEFOR/AFTER ARRAYS                                              #
#                                                                      #
#**********************************************************************#
  
  
  
# STRING POINTER IN BITS  24-41.                                       #
  
      PROC  EMV24;
      BEGIN 
      F1=24;                       # SET 1ST BIT POSITION              #
      EMVCOM;                      # COMMON CONTROL ROUTINE            #
      END 
  
  
# STRING POINTER IN BITS 42-59.                                        #
  
      PROC  EMV42;
      BEGIN 
      F1=42;                       # SET 1ST BIT POSITION              #
      EMVCOM;                      # COMMON CONTROL ROUTINE            #
      END 
  
  
  
# COMMON ROUTINE TO PROCESS MOVE BEFOR/AFTER STRINGS                   #
# ON ENTRY  F1 = BIT POSITION                                          #
#         GIVE = POSITION (WORD) OF REFERENCE                          #
  
      PROC  EMVCOM; 
      BEGIN 
      SAVEADD3=P<GIVE>;            # SAVE POSITION OF GIVE             #
      P<GIVE>=B<F1,18>GIVAR[0];    # POSITION TO 1ST ENTRY OF STRING   #
      MMOVESTNG;                   # MOVE MOVE STRING,  ALL OF IT      #
  
      P<GIVE>=SAVEADD3;            # POSITION BACK TO REF LOCATION     #
                                   # UPDATE LINK.  MAKE IT RELATIVE    #
      B<F1,18>GIVAR[0]=(ADDNEW-BEGINTABLES)+O"400000";
  
                                   # NOW STEP THRU THE STRING MOVING   #
                                   # AND/OR LINKING ITEMS REFERENCED   #
      P<GIVE>=ADDNEW;              # POSITION TO THE STRING            #
      FOR DONE=0  WHILE  DONE  EQ  0  DO
        BEGIN 
                                   # EACH ENTRY IS 2 WORDS LONG        #
                                   # 7 ENTRIES PER STRING              #
        FOR K=0  STEP 2  UNTIL 12  DO 
          BEGIN 
          IF GIVAR[K]  EQ  0  THEN
            BEGIN 
                                   # ZERO FOUND   END OF STRING        #
            DONE=1;                # SET DONE                          #
            TEST DONE;             # EXIT                              #
            END 
          ELSE
            BEGIN 
                                   # NOT ZERO.  NOT END OF STRING      #
                                   # HAVE TABLE TO PROCESS             #
            SAVEADD4=P<GIVE>;      # SAVE POINTER TO TABLE             #
            P<GIVE>=P<GIVE>+K;     # POINT TO ENTRY IN TABLE           #
            MOVEMOVE;              # MOVE AND/OR LINK THE TABLE        #
            P<GIVE>=SAVEADD4;      # RESTORE POSITION OF GIVE          #
            END 
          END 
  
                                   # TEST WORD 15 OF THE STRING FOR    #
                                   # POINTER TO NEXT GROUP OF 7        #
          IF GIVAR[14]  NQ  0   THEN
          BEGIN 
          P<GIVE>=P<GIVE>+15;      # POSITION TO NEXT BLOCK            #
          TEST DONE;               # WORK ON THIS BLOCK                #
          END 
          ELSE                     # END OF MOVE TABLE                 #
            BEGIN 
            DONE = 1;              # INDICATE END OF *FOR* LOOP        #
            TEST DONE;
            END 
        END 
      P<GIVE> = SAVEADD3;          # RESTORE ORIGINAL POSITION         #
      END 
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# THIS PROCEDURE WILL MOVE ONE ENTIRE SET OF POINTERS.                 #
# IF THE SET HAS MORE THAN SIX ENTRIES EACH SECTION WILL BE            #
# MOVED AND POINTERS UPDATED                                           #
# ON ENTRY  GIVE IS POSITIONED TO THE 1ST ENTRY.                       #
# ON EXIT  ADDNEW = 1ST ENTRY NEW LOCATION                             #
#                                                                      #
#**********************************************************************#
  
      PROC  MEVALSTNG;
      BEGIN 
      ADDNEW=P<DEST>;              # SAVE 1ST POSITION OF NEW LOCATION #
      FOR DUMMY=0  STEP 1  DO 
        BEGIN 
        CHKDEST(7);                # CHECK FOR ROOM IN BUFFER          #
        FOR K=0  STEP 1  UNTIL 6  DO
          BEGIN 
          DESAR[K]=GIVAR[K];       # MOVE 1 WORD                       #
          END 
        P<DEST>=P<DEST>+7;         # UPDATE TO NEXT FREE LOCATION      #
        IF DESAR[-1]  NQ  0  THEN  # IF NOT 0 POINTER TO NEXT 7 WORDS  #
          BEGIN 
        TEMP=DESAR[-1];            # SAVE POINTER TO NEXT BLOCK        #
                                   # UPDATE LINK POINTER TO RELATIVE   #
        DESAR[-1]=(P<DEST>-BEGINTABLES)+O"400000";
        P<GIVE>=TEMP;              # POSITION TO NEXT BLOCK            #
          END 
        ELSE
          RETURN;                  # IF ZERO DONE WITH ENTIRE STRNG    #
        END 
      END 
  
  
  
#**********************************************************************#
#                                                                      #
# THIS PROCEDURE WILL MOVE ONE ENTIRE SET OF POINTERS.                 #
# IF THE SET HAS MORE THAN 10  ENTRIES EACH SECTION WILL BE            #
# MOVED AND POINTERS UPDATED.   EACH ENTRY IS 3 WORDS LONG WITH        #
# WORD 31 POINTING TO THE NEXT BLOCK IF PRESENT                        #
# ON ENTRY  GIVE IS POSITIONED TO THE 1ST ENTRY.                       #
# ON EXIT  ADDNEW = 1ST ENTRY NEW LOCATION                             #
#                                                                      #
#**********************************************************************#
  
      PROC  MMOVESTNG;
      BEGIN 
      ADDNEW=P<DEST>;              # SAVE 1ST POSITION OF NEW LOCATION #
      FOR DUMMY=0  STEP 1  DO 
        BEGIN 
        CHKDEST(15);               # CHECK FOR ROOM IN BUFFER          #
        FOR K=0  STEP 1  UNTIL  14   DO 
          BEGIN 
          DESAR[K]=GIVAR[K];       # MOVE 1 WORD                       #
          END 
        P<DEST>=P<DEST>+15; 
        IF DESAR[-1]  NQ  0  THEN  # IF NOT 0 POINTER TO NEXT 31 WORDS #
          BEGIN 
        TEMP=DESAR[-1];            # SAVE POINTER TO NEXT BLOCK        #
                                   # UPDATE LINK POINTER TO RELATIVE   #
        DESAR[-1]=(P<DEST>-BEGINTABLES)+O"400000";
        P<GIVE>=TEMP;              # POSITION TO NEXT BLOCK            #
          END 
        ELSE
          RETURN;                  # IF ZERO DONE WITH ENTIRE STRNG    #
        END 
      END 
                                                          CONTROL EJECT;020960
#**********************************************************************#020970
#                                                                      #
# PROCEDURE TO CHECK BIT FIELDS FOR ADDRESSES.                         #020980
# IF PRESENT CHECK TO SEE IF THE ADDRESSED ITEM HAS ALREADY            #020990
# BEEN MOVED.  IF SO PLACE NEW RELATIVE ADDRESS IN LINK.               #021000
# IF NOT GET NEW RELATIVE ADDRESS FOR ITEM AND UPDATE LINKAGE.         #021010
# ON ENTRY F = FIRST BIT POSITION.                                     #021020
#          W = WORD NUMBER.                                            #021030
#    EXIT  TEMPADD = 0 IF NO ADDRESS PRESENT.                          #
#          FLAG1 = 0 IF ADDRESS PRESENT AND DATA ITEM HAS ALREADY      #
#          BEEN MOVED.                                                 #
#                                                                      #
#**********************************************************************#
                                                                        021040
      PROC  BITCHECK;                                                   021050
      BEGIN                                                             021060
      TEMPADD=B<F,18>GIVAR[W];     # LOOK AT 18 BIT ADDRESS FIELD.     #021070
      IF TEMPADD  EQ  0  THEN                                           021080
        RETURN;                    # IF ZERO NO ADDRESS   RETURN.      #021090
                                   # THIS SECTION MAY BE CHANGED....   #021100
                                   # TEST TO SEE IF ADDRESS FIELD IS   #021110
                                   # RELATIVE TO RECORD START OR A     #021120
                                   # LINK TO A VALUE IN CORE.          #021130
                                   # CHECK TO SEE IF THE ADDRESS       #021140
                                   # IS WITHIN THE RANGE FOR TABLES.   #021150
                                   # IF TEMPADD BELOW HHA OR ABOVE FL  #
      IF TEMPADD LQ HIGHEST OR TEMPADD GQ QUFL THEN 
        BEGIN                                                           021170
        TEMPADD=0;                 # IF SMALLER THAN HIGHEST IT MUST   #021180
        RETURN;                    # BE A RELATIVE CHAR POSITION.      #021190
        END                                                             021200
      ADDOLD=TEMPADD;                                                   021210
      OLDNEW;                      # CHECK TO SEE IF ITEM HAS ALREADY  #021220
                                   # BEEN MOVED.                       #021230
      IF ADDNEW  NQ  0  THEN                                            021240
        BEGIN                                                           021250
                                   # ITEM HAS ALREADY BEEN MOVED.      #021260
        B<F,18>GIVAR[W]=ADDNEW;    # UPDATE LINKAGE.                   #021270
        FLAG1=0;                   # FLAG = 0. NO NEED TO RE-LINK.     #021280
        END                                                             021290
       ELSE                                                             021300
        BEGIN                                                           021310
                                   # ITEM HAS NOT BEEN MOVED.          #021320
        ADDNEW=P<DEST>;            # GET CURRENT ADDRESS.              #021330
        STORENEW;                  # STORE OLD AND NEW ADDRESS.        #021340
        MOVETAB2;                  # MOVE THE ITEM.                    #021350
        B<F,18>GIVAR[W]=ADDREL;    # UPDATE LINKAGE.                   #021360
        FLAG1=1;                   # FLAG = 1. MUST RE-LINK.           #021370
      ADDNEW=ADDREL;               # FOR COMPATIBLTY WITH EXP STACK.   #021380
        END                                                             021390
      END                                                               021400
                                                                        021410
#**********************************************************************#021420
#                                                                      #
# PROCEDURE TO MOVE ITEMS IN CORE.                                     #021430
# FIRST WORD TO MOVE FROM IS IN TEMPADD.                               #021440
# NUMBER OF BYTES IS IN INTBYTES.                                      #021450
# INFORMATION IS MOVED TO ADDRESS OF DEST ARRAY.                       #021460
#                                                                      #
#**********************************************************************#
                                                                        021470
      PROC MOVETAB2;                                                    021480
      BEGIN                                                             021490
      LENGTH=(INTBYTES+9)/10;      # COMPUTE LENGTH IN WORDS.          #021500
      CHKDEST(LENGTH);             # CHECK FOR ROOM IN BUFFER          #
      P<GIVEX>=TEMPADD;            # POSITION GIVING ARRAY.            #021510
      FOR I=0  STEP 1  UNTIL LENGTH-1  DO                               021520
        DESAR[I]=GIVARX[I];        # MOVE ONE WORD.                    #021530
      P<DEST>=P<DEST>+LENGTH;      # UPDATE POINTER TO NEXT COR LOC.   #021540
      END                                                               021550
                                                          CONTROL EJECT;021560
#**********************************************************************#021570
#                                                                      #
# PROCEDURE TO SEARCH THE OLD-NEW ADDRESS TABLE.                       #021580
# ON ENTRY ADDOLD = OLD ADDRESS.                                       #021590
# IF THE ADDRESS IS FOUND TABLE HAS ALREADY BEEN MOVED.                #021600
# IF FOUND ADDNEW = NEW ADDRESS OF ITEM.                               #021610
# IF NOT FOUND ADDOLD IS UNCHANGED AND ADDNEW = 0.                     #021620
#                                                                      #
#**********************************************************************#
                                                                        021630
      PROC OLDNEW;                                                      021640
      BEGIN                                                             021650
      ADDREL=0;                    # ZERO OUT VALUE.                   #021660
      ADDNEW=0;                    # ZERO OUT VALUE.                   #021670
      P<OLDNEWTB>=OLDNEWTBPT;      # POSITION ARRAY TO FIRST BLOCK.    #021680
      FOR DUMMY=0  STEP 1  DO      #  DUMMY LOOP.                      #021690
        BEGIN                                                           021700
        FOR I=0  STEP 1  UNTIL 249  DO   #SET UP SCAN FOR 250 WORD BLK #021710
          BEGIN                                                         021720
          IF OLDNEW1[I]  EQ 0  AND           # IF BOTH POINTERS EQ 0   #021730
             OLDNEW2[I]  EQ 0  THEN RETURN;  #THEN END OF TABLE.       #021740
                                   # IF LOOKING AT WORD 250 LOOK FOR   #021750
                                   # LINK TO NEXT 250 WORD BLOCK.      #021760
          IF I  EQ  249  AND                                            021770
             OLDNEW1[I]  EQ 0  AND                                      021780
             OLDNEW2[I] GR HIGHEST THEN 
            BEGIN                                                       021800
            P<OLDNEWTB>=OLDNEW2[I];        # REPOSITION ARRAY TO NEXT  #021810
                                           # BLOCK OF 250 WORDS.       #021820
            TEST DUMMY;            # EXIT TO OUTSIDE LOOP.             #021830
            END                                                         021840
                                                                        021850
          IF OLDNEW1[I]  EQ  ADDOLD  THEN   # TEST ADDRESS.            #021860
            BEGIN                                                       021870
            ADDNEW=OLDNEW2[I];     # IF FOUND RETURN NEW ADDRESS.      #021880
            RETURN;                # EXIT PROCEDURE.                   #021890
            END                                                         021900
          END                                                           021910
        END                                                             021920
      END                                                               021930
                                                          CONTROL EJECT;021940
#**********************************************************************#021950
#                                                                      #
# PROCEDURE TO PLACE ENTRIES IN THE OLD-NEW ADDRESS TABLE.             #021960
# ON ENTRY  ADDOLD = THE OLD ITEM ADDRESS.                             #021970
#           ADDNEW = THE NEW ITEM ADDRESS.                             #021980
# THE OLD ABS LOCATION IS STORED IN OLDNEW1.                           #021990
# THE NEW RELATIVE LOCATION IS STORED IN OLDNEW2,                      #022000
# AND RETURNED IN ADDREL.                                              #022010
#                                                                      #
#**********************************************************************#
                                                                        022020
      PROC STORENEW;                                                    022030
      BEGIN                                                             022040
      P<OLDNEWTB>=OLDNEWTBPT1+OLDNEWTBLG-1;     # POSITION ARRAY.      #022050
      IF OLDNEWTBLG  EQ  250  THEN    # IF EQUAL TO 250 GET NEXT       #022060
                                                # BLOCK OF CORE.       #022070
        BEGIN                                                           022080
        OLDNEW2[0] = CMM$ALF(250, 0, SM$GROUPID); 
        OLDNEWTBPT1=OLDNEW2[0];    # UPDATE POINTER TO CURRENT BLOCK.  #022100
        P<OLDNEWTB>=OLDNEW2[0];    # REPOSITION ARRAY TO NEW BLK.      #022110
        OLDNEWTBLG=1;              # RESET TABLE LENGHT.               #022120
        END                                                             022130
      OLDNEW1[0]=ADDOLD;           # STORE OLD ADDRESS.                #022140
                                   # STORE NEW RELATIVE ADDRESS.       #022150
                                   # RELATIVE TO THE FIRST WORD OF     #022160
                                   # THE NEW LOCATION OF TABLES        #022170
                                   # SET THE HIGH ORDER BIT OF THE     #022180
                                   # ADDRESS FIELD AS A FLAG TO REPORT #022190
      OLDNEW2[0]=(ADDNEW-BEGINTABLES)+O"400000";                        022200
      ADDREL=OLDNEW2[0];           # RELATIVE ADDRESS.                 #022210
      OLDNEWTBLG=OLDNEWTBLG+1;     # UPDATE TABLE LENGHT.              #022220
      END                                                               022230
                                                                        022240
      END    TERM                                                       022250
