*DECK  REP7100                                                          022280
USETEXT TAFIT 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TREPCOM 
USETEXT TREPORT 
USETEXT TSSRC 
      PROC REP7100;                                                     022290
      BEGIN                                                              REP7100
                                                                         REP7100
CONTROL EJECT;                                                           REP7100
                                                                        022480
# THIS IS THE DRIVER FOR THE FIRST PRIMARY OVERLAY OF REPORT.  FIRST   #
# IT SAVES THE LIST OF REPORTS TO BE WRITTEN.  THEN IT READS IN THE    #022500
# TABLES AND VARIABLE DEFINITIONS FOR EACH REPORT AND CALLS XEQREP TO  #022510
# WRITE IT OUT.                                                        #
                                                                        022530
      CONTROL EJECT;                                                    022550
      DEF MINBUF #1025#;           # REPORT FILE BUFFER LENGTH         #
      XREF PROC CRACKCC;     #CONTROL CARD CRACKING                    #022560
      XREF PROC LOADOVL;     #OVERLAY  LOADING                         #022570
      XREF PROC XEQREP;      # MAKE REPORT                             #022580
      XREF PROC OPENM;       # CRM ROUTINE TO OPEN FILE                #022590
      XREF PROC CLOSEM;            # CRM ROUTINE TO CLOSE A FILE       #
      XREF PROC CLOSETL;     # CLEAN UP BEFOR EXIT                     #
      XREF PROC DIAG;        # PRINT DIAGNOSTIC                        #022600
      XREF PROC FIXVARS;     # FILL IN VARIABLE PARAMETERS             #022610
      XREF PROC OCTAL;       # DEBUG ROUTINE                           #022620
      XREF PROC WRITEH;            # WRITE *H* FORMAT LINE             #
      XREF PROC WRITER;            # WRITE END OF RECORD               #
      XREF ITEM PFLAG;             # PREVIEW FLAG FOR *REPORT*         #
      XREF ITEM REP I;       #LOOP COUNTER                             #022630
      XREF ITEM SAVEAD I;    # ADDRESS FOR GET/FREE CM                 #
      XREF ITEM SLVL I;      # REPORT COUNT                            #
      XREF ITEM SILFN  C(7); # MAIN REPORT NAME                        #
      XREF ITEM SLFNLG I;    # MAIN REPORT NAME LENGTH                 #
      XREF ITEM UNIVERSAL;         # UNIVERSAL CHARACTER               #
      XREF ARRAY TEXTFIT;          # MODEL FIT FOR TEXT SOURCE FILE    #
        BEGIN 
        ITEM TEXTWD U(0,0,60);
        END 
      XREF ITEM FOUNDI B;          # TRUE IF I PARAMETER INCLUDED      #
      XREF ITEM INFILE C(7);       # DATA INPUT LFN                    #
      XREF ITEM CURRENTLFPTR; 
        XREF ARRAY RPTS  [9]  S(3);  # STORAGE FOR REPORT NAMES ECT    #
          ITEM  REPNAME   C(0,0,7), 
                RFROMLFN  C(2,0,7),   # FROM LOGICAL FILE NAME         #
                RFROMLEN  I(2,42,6),  # NO OF CHARS IN FROM FILE NAME  #
                RTEXTFG   B(2,59,1),  # TRUE IF REPORT IS TEXT         #
                REPW0     U(0,0,60),
                REPW1     U(1,0,60),
                REPW2     U(2,0,60);
      ITEM ADDR I;           # BUFFER ADDRESS OF THE TABLES            #022660
      ITEM CCODE I;                # CONVERSION CODE FROM MOVE TABLE   #
                                                                        022670
      ITEM  THISOLD,THISNEW,BEGINTABLES,NEXTOLD,F,W;                    022680
      ITEM  FLAG1,SAVEADD,TEMP,SAVEADD2,CONVERTCODE;                    022690
      ITEM  TBLG,J,DUMMY3,STBAR1,L,LOOPDONE,I,F1;                       022700
      ITEM  K,TEMP1,SAVEADD1,EDITBIT;                                   022710
      ITEM  SAVEADD3,SAVEADD4,DONE; 
      ITEM SAVEREP I;              # INDEX OF REPORT SPECIFIED ON CTL C#
      ITEM  EXPTBPT;               # POINTER TO EXP STACK TABLE        #
      ITEM  OLDCURSOURCE,          # OLD CURRENTSOURCE LOCATION        #022720
            OLDFORMADD,            # OLD FORMLADDR LOCATION.           #022730
            OLDSEHEAD;             # OLD SELDTLHEAD.                   #022740
                                                                        022750
                                                                        022760
      BASED ARRAY  GIVE;           # GIVING AREA ARRAY.                #022770
        ITEM GIVAR    U(0,0,60);                                        022780
                                                                        022790
      BASED ARRAY  DESCRAY;        # ARRAY TO DEFINE KEY AREAS OF THE  #022800
                                   # LIST ENTRIES.                     #022810
        ITEM DESPOINT U(0,42,18);                                       022820
                                                                        022830
      BASED ARRAY  TABAR;                                               022840
        ITEM TBAR1    U(0,0,60);                                        022850
      BASED ARRAY UNAMEIT S(1);                                          REP7100
        BEGIN                                                            REP7100
        ITEM COPYIT (00,00,60);    #ARRAY FOR MOVING CORE              # REP7100
        END                                                              REP7100
  
      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;                                                    022860
        FUNC GETREC(TABNAME) I;                                         022870
                                                                        022880
#**********************************************************************#
#                                                                      #
# READ RECORDS FROM THE TABLE FILE UNTIL THE ONE WITH THE RIGHT NAME   #
# IS FOUND.  START THE READING WHEREVER THE FILE HAPPENS TO BE         #
# POSITIONED, READ TO THE FIRST EOI, REWIND, READ TO THE NEXT EOI.     #
# IF THE RIGHT TABLE STILL HASN"T BEEN FOUND, DIE.  EOP AND EOS MAY BE #
# IGNORED SAFELY--EVEN IF THERE IS NO NEW RECORD TRANSFERRED, NO HARM  #
# IS DONE BY CHECKING THE NAME OF THE PREVIOUS ONE AGAIN.  RETURN THE  #
# FWA OF THE TABLES IN CORE                                            #
#                                                                      #
#**********************************************************************#
                                                                        022960
          BEGIN                                                         022970
          ITEM TABNAME C(7); # PARAMETER--NAME OF TABLE SOUGHT         #022980
          XREF PROC GET;     # CRM READ ROUTINE                        #022990
          XREF PROC GETP;    # READ PARTIAL RECORD                     #023000
          XREF PROC SKIP;    # CRM SKIP TO EOR                         #023010
          XREF PROC REWND;   # CRM REWIND ROUTINE                      #023020
          ITEM TABLENG I;    # LENGTH OF TABLES                        #023040
          ITEM EOINUM I;     # COUNTER FOR EOI"S                       #023050
          ARRAY PREFIXTAB[0] S(2);   # BUFFER FOR PREFIX TABLE         #023060
            ITEM RECNAME C(1,0,7);   # NAME OF TABLE READ IN           #023070
          BASED ARRAY WSA;         # WSA FOR READ OF TABLES            #
            BEGIN 
            ITEM WSAC        C(00,00,10);  # FOR ACCESSING ID WORD     #
            END 
                                                                        023090
      P<FIT> = LOC(TABFIT); 
      FITBBH = TRUE;               # ALLOCATE BUFFERS BELOW HHA        #
      OPENM(TABFIT, RA0);    # OPEN TABLE FILE                         #023810
          EOINUM = 0;        # MARK NO EOI FOUND YET                   #023100
          FOR J=J                                                        REP7100
            WHILE EOINUM LS 2                                            REP7100
          DO                                                             REP7100
            BEGIN                                                       023120
                                   # READ PREFIX TABLE                 #023130
            GETP(TABFIT, PREFIXTAB, 20, RA0);                           023140
            IF FITFP EQ O"100"     # IF EOI                            #
            THEN
              BEGIN                                                     023160
              EOINUM = EOINUM + 1;   # INCREMENT COUNT                 #023170
              REWND(TABFIT, RA0);  # REWIND FILE                       #023180
              END                                                       023200
            ELSE                                                        023210
              BEGIN                                                     023220
                                   # CHECK TABLE NAME.                 #023260
              IF B<0,42>RECNAME[0]  EQ B<0,42>TABNAME                   023270
              THEN                                                      023280
                BEGIN                                                   023290
                                    # READ CREPORT LENGTH.             #023300
                GETP(TABFIT, CREPTLG, 10, RA0);                         023310
                                    # READ CREPORT.                    #023320
                                   # - 1 BECAUSE CREPTLG ALREADY READ  #023330
                GETP(TABFIT, CURREPT, CREPTLG*10-10, RA0);              023340
                                   # READ UNIVERSAL CHARACTER          #
                GETP(TABFIT, UNIVERSAL, 10, RA0); 
                                   # READ IN FSIZE                     #023350
                GETP(TABFIT, FSIZE, 10, RA0);                           023360
                                   # READ IN COMMON AREA CLFN.         #023380
                GETP(TABFIT, LFNS, 420, RA0);                           023390
                                                                        023410
                                   # READ IN THE OLD LOCATIONS FOR     #023420
                                   # CURRENTSOURCE.                    #023430
                 GETP(TABFIT, OLDCURSOURCE, 10, RA0);                   023440
                                   # FORMDLADDR                        #023450
                 GETP(TABFIT, OLDFORMADD, 10, RA0);                     023460
                                   # SELDTHEAD                         #023470
                GETP(TABFIT, OLDSEHEAD, 10, RA0);                       023480
                                                                        023490
                                    # READ TABLE SIZE.                 #023500
                GETP(TABFIT, TABLENG, 10, RA0);                         023510
                P<WSA> = CMM$ALF(TABLENG,0,0);
                IF P<WSA> EQ 0 THEN   # CHECK SUCCESS OF GETCM         #023540
                  STOP;                                                 023550
                GETREC = P<WSA>;   # RETURN LOC OF TABLES              #023560
                BEGINTABLES=P<WSA>;                                     023570
                SAVEAD=BEGINTABLES;  # SAVE ADDRESS IN  0,0            #
                                   # READ THE TABLES                   #023600
                GETP(TABFIT, WSA, TABLENG*10, RA0);                     023610
                IF WSAC[0] NQ "QU32REPORT"  # IF NOT QU 3.2 TABLES     #
                THEN
                  BEGIN 
                  DIAG(251);       # DIAGNOSE USE OF OLD TABLES        #
                  CLOSETL;         # FLUSH FILES                       #
                  STOP;            # STOP. CANNOT RUN WITH OLD TABLES  #
                  END 
                                   # READ DESLIST                      #
                GETP(TABFIT, DESLIST, 10, RA0); 
                                   # READ DEFLIST                      #
                GETP(TABFIT, DEFLIST, 10, RA0); 
                                   # READ SPELIST                      #
                GETP(TABFIT, SPELIST, 10, RA0); 
                                   # READ LFNINFO ARRAY                #
                P<LFNINFO> = SAVELFNINFO; 
                GETP(TABFIT, LFNINFO, LFNINFOSIZE * 10, RA0); 
                REWND(TABFIT, RA0);  # REWIND THE FILE.                #023620
                RETURN;      # RETURN IF CORRECT                       #023630
                END                                                     023640
              ELSE                                                      023650
                SKIP(TABFIT, 0, RA0);   # SKIP TO START OF NEXT RECORD #023660
              END                                                       023670
            END                                                         023680
          DIAG(238, TABNAME);  # ERROR: TABLE NOT FOUND                #023690
          CLOSETL;                 # CLEAN UP BEFOR EXIT               #
          STOP;                                                         023700
          END                                                           023710
        CONTROL EJECT;                                                  023720
                                                                        023730
      IF REP LS 0 THEN    #THIS OVERLAY IS LOADED FOR THE 1ST TIME     #023740
      BEGIN                                                             023750
      CRACKCC;     # ANALYZE CONTROL CARD PARAMETERS                   #023760
                                                                        023770
# READ UP THE TABLE FOR THE MAIN REPORT SO WE CAN PICK OUT THE LIST OF #
# PREFACES/SUMMARIES.                                                  #
                                                                        023800
                                   # CONVERT ZEROS TO BLANKS (55)      #
      FOR  I=0  STEP 6  UNTIL  54   DO
        IF B<I,6>REPFILE  EQ  O"00"   THEN   B<I,6>REPFILE = O"55"; 
      SAVELFNINFO = CMM$ALF(LFNINFOSIZE, 0, 0);  # GET CM FOR LFNINFO  #
      ADDR = GETREC(REPFILE);                                           023830
                                                                        023840
      FOR REP=0 STEP 1                                                   REP7100
        UNTIL LVL                  #SAME REPORT NAME LIST              # REP7100
      DO                                                                 REP7100
        BEGIN 
        IF B<0,42>RPTNAME[REP]  EQ  B<0,42>REPFILE  THEN
          BEGIN 
          IF FOUNDI THEN           # IF REPORT, I=LFN                  #
            BEGIN 
            B<0,42>FROMLFN[REP] = B<0,42>INFILE;
            END 
          FROMLEN[REP] = 7; 
          SILFN = ILFN[IPRE];      # SAVE IN 0,0  REPORT NAME          #
          SLFNLG = ILFNLG[IPRE];   # AND NAME LENGTH                   #
          SAVEREP = REP;           # INDEX OF REPORT ON CONTROL CARD   #
          END 
        REPW0[REP] = WORD1A[REP]; 
        REPW1[REP] = WORD2 [REP]; 
        REPW2[REP] = WORD3A[REP]; 
        END 
      IF PFLAG NQ 0                # IF PREVIEW                        #
      THEN
        BEGIN 
        REPW0[0] = REPW0[SAVEREP];  # MOVE TO 1ST ENTRY                #
        REPW1[0] = REPW1[SAVEREP];
        REPW2[0] = REPW2[SAVEREP];
        LVL = 0;                   # ONLY PREVIEW 1 REPORT             #
        END 
      SLVL = LVL;                  # SAVE IN 0,0 REPORT COUNT          #
      REP=0;   #CLEAR THE 1ST-TIME-THRU FLAG                           #023870
      END                                                               023880
      CMM$FRF(SAVEAD);             # GIVE BACK CORE THAT GETFEC USED   #
                                                                        023890
# NOW EXECUTE EACH REPORT.  BUT FIRST MUST READ IN THE TABLE FOR       #
# THE REPORT AND ANY VARIABLES THAT MAY BE PRESENT.                    #
                                                                        023920
NEXTREP:  
      IF  REP  GR  LVL   THEN 
        BEGIN 
        CLOSETL;                   # IF ALL REPORTS DONE               #
        STOP;                      # S T O P .                         #
        END 
                                                                        023940
  
# TEST THE TEXT FLAG.  IF IT IS SET LIST OUT THE TEXT INFO             #
  
      IF RTEXTFG[REP] THEN
        BEGIN 
        LISTTEXT;                  # FLAG WAS SET.  LIST THE FILE.     #
        GOTO  NEXTREP;             # LOOP BACK FOR NEXT REPORT         #
        END 
  
      ADDR = GETREC(REPNAME[REP]);  # READ IN APPROPRIATE TABLE        #
                                                                        023960
      LVL = SLVL;                  # PLACE BACK REPORT COUNT           #
                                                                        023980
# THIS SECTION OF CODE WILL RE-LINK THE TABLES SAVED BY                #023990
# THE REPORT DIRECTIVE.  SOME OF THE PROCEDURES ARE FROM               #024000
# THE REPORT CODE.  THEY MAY HAVE BEEN MODIFIED TO RE-LINK.            #024010
                                                                        024020
      CURRENTLFPTR = P<LFNINFO>;   # POSITION TO LFNINFO ARRAY         #
      P<AFIT> = LOC(L$FITLOC);                                           REP7100
      AFITPDF = FALSE;             #ALLOW FILE CARD INFO TO BE READ    # REP7100
      AFITFWB = 0;                 #FORCE XEQREP TO ALLOCATE BUFFER    # REP7100
      P<TABAR> = CMM$ALF(15,0,0);  # GET CORE FOR EXPRESSION STACK     #
      TBLG = 0;                    # POINTERS.  SET INDEX TO ZERO      #
      EXPTBPT = P<TABAR>;          # SAVE POSITION                     #
      FOR I=0  STEP 1  UNTIL 14  DO 
        BEGIN 
        TBAR1[I] = 0;              # ZERO OUT THE CORE                 #
        END 
  
                                   # MUST CHANGE SOME POINTERS IN      #024030
                                   # CREPORT TO POINT TO CORE          #024040
                                   # LOCATIONS NOT TO RELATIVE         #024050
                                   # POSITIONS IN THE RECORD.          #024060
      IF AREPORTLIST  NQ  0  THEN                                       024070
        AREPORTLIST=AREPORTLIST+BEGINTABLES;                            024080
                                                                        024090
      IF DESLIST  NQ  0  THEN                                           024100
        DESLIST=DESLIST+BEGINTABLES;                                    024110
                                                                        024120
      IF DEFLIST  NQ  0  THEN                                           024130
        DEFLIST=DEFLIST+BEGINTABLES;                                    024140
                                                                        024150
      IF SPELIST  NQ  0  THEN                                           024160
        SPELIST=SPELIST+BEGINTABLES;                                    024170
                                                                        024180
                                                                        024230
# RE LINK THE DESCRIBE TABLE ENTRIES IF PRESENT.                       #024240
      IF DESLIST  NQ  0  THEN      # IF ZERO  NO ENTRIES.              #024250
                                   # IF NON-ZERO  RELEATIVE ADDRESS    #024260
                                   # OF 1ST ENTRY TO START OF TABLES.  #024270
        BEGIN                                                           024280
        THISOLD=DESLIST;                                                024290
        RELINK1;                   # PROCESS THIS STRING.              #024300
        END                                                             024310
                                                                        024320
# RE LINK THE DEFINE TABLE ENTRIES IF PRESENT.                         #024330
      IF DEFLIST  NQ  0  THEN                                           024340
        BEGIN                                                           024350
        THISOLD=DEFLIST;                                                024360
        RELINK1;                   # PROCESS THIS STRING.              #024370
        END                                                             024380
                                                                        024390
# RE LINK THE SPECIFY TABLE ENTRIES IF PRESENT.                        #024400
      IF SPELIST  NQ  0  THEN                                           024410
        BEGIN                                                           024420
        THISOLD=SPELIST;                                                024430
        RELINK1;                   # PROCESS THIS STRING.              #024440
        END                                                             024450
                                                                        024460
                                                                        024470
# CHECK TO SEE IF THERE ARE ANY DEFINE ENTRIES.                        #024480
# IF SO RE-LINK ALL RELATED ITEMS.                                     #024490
      IF DEFLIST  NQ  0  THEN      # IF ZERO NO ENTRIES.               #024500
        BEGIN                                                           024510
                                   # YES, SOME PRESENT.                #024520
        THISNEW=DEFLIST;                                                024530
        LINKCONTROL;               # RE LINK ALL RELATED ITEMS.        #024540
        END                                                             024550
                                                                        024560
# CHECK TO SEE IF THERE ARE ANY SPECIFY ENTRIES.                       #024570
# IF SO RE-LINK ALL RELATED ITEMS.                                     #024580
      IF SPELIST  NQ  0  THEN      # IF ZERO NO ENTRIES                #024590
        BEGIN                                                           024600
                                   # YES, SOME PRESENT.                #024610
        THISNEW=SPELIST;                                                024620
        LINKCONTROL;               # RE LINK ALL RELATED ITEMS.        #024630
        END                                                             024640
                                                                        024650
                                                                        024660
# NOW RE-LINK THE REPORT HEADDER TABLES.                               #024670
# THEY CAN POINT TO AN EXPRESSION STACK                                #024680
# OR TO A MOVE TABLE.                                                  #024690
                                                                        024700
                                   # POSITION TO THE ARRAY REPORT      #024710
                                   # IN THE COMMON AREA  CREPORT.      #024720
      P<GIVE>=LOC(REPORT);                                              024730
      LOOPDONE = 10;               # SET LOOP LIMIT                    #
      LINKREPT;                    # RE-LINK EXPRESSION OR MOVE TABLES #024750
                                                                        024760
      P<GIVE>=LOC(FOOTEVAL);       # POSITION TO THE ARRAY FOOTEVAL.   #024770
      LOOPDONE = MAXBREAK + 2;
      LINKREPT;                                                         024790
                                                                        024800
      P<GIVE>=LOC(HEADEVAL);       # POSITION TO THE ARRAY HEADEVAL.   #024810
      LINKREPT;                                                         024820
                                                                        024830
      P<GIVE>=LOC(BRKEVAL);        # POSITION TO THE ARRAY BRKEVAL.    #024840
      LINKREPT;                                                         024850
                                                                        024860
      P<GIVE>=LOC(SELEVAL);        # POSITION TO THE ARRAY SELEVAL.    #024870
      LOOPDONE = MAXSELECT + 2; 
      LINKREPT;                                                         024890
                                                                        024900
      P<GIVE>=LOC(DTLEVAL);        # POSITION TO THE ARRAY DTLEVAL     #024910
      LOOPDONE = MAXSELECT + 1; 
      LINKREPT;                                                         024920
                                                                        024930
      P<GIVE>=LOC(TITEVMV);        # POSITION TO THE ARRAY TITEVMV.    #024940
      LOOPDONE=1;                                                       024950
      LINKREPT;                                                         024960
                                                                        024970
      P<GIVE>=LOC(RCPEVMV);        # POSITION TO THE ARRAY RCPEVMV.    #024980
      LINKREPT;                                                         024990
                                                                        025000
                                                                        025010
# NOW RE-LINK THE AREPORTLIST ENTRIES.                                 #025020
# THE REPORT ENTRIES ARE POINTED TO BY ITEM AREPORTLIST.               #025030
# THE INDEX TO THE LAST ENTRY IS REPORTINDEX.                          #025040
                                                                        025050
      LOOPDONE = (REPORTINDEX + 1) * 3;  # EACH ENTRY 3 WORDS LONG     #
      FOR DUMMY3=4  STEP 3  UNTIL LOOPDONE  DO                          025070
        BEGIN                                                           025080
                                   # POSITION TO THE SECOND WORD OF    #025090
                                   # EACH THREE WORD ENTRY.            #025100
        P<GIVE>=AREPORTLIST+DUMMY3;                                     025110
        LINKCONVERT;               # RE-LINK THE ENTRY.                #025120
        P<GIVE> = AREPORTLIST + DUMMY3 - 1;  # POSITION TO WORD 0      #
        IF B<21,1>GIVAR[0] NQ 0    # IF AT LINE ITEM                   #
        THEN
          BEGIN 
          F = 24; 
          W = 0;
          BITCHECK;                # MOVE LINE NO ITEM                 #
          END 
        END                                                             025130
                                                                        025140
                                                                        025150
                                   # NOW CHECK THE FIRST WORD OF EACH  #025160
                                   # REPORTLIST ENTRY TO SEE IF IT     #025170
                                   # POINTS TO A HEADDING ARRAY.       #025180
      FOR DUMMY3=3  STEP 3  UNTIL LOOPDONE  DO                          025190
        BEGIN                                                           025200
        P<GIVE>=AREPORTLIST+DUMMY3;  # POSITION TO THE ENTRY           #025210
        TEMP1=B<42,18>GIVAR[0];    # FETCH THE POINTER                 #025220
        IF TEMP1  EQ  0  THEN                                           025230
          TEST DUMMY3;             # IF ZERO TRY NEXT ENTRY            #025240
        TEMP=TEMP1-OLDSEHEAD;      # SUBTRACT OLD LOCATION             #025250
        B<42,18>GIVAR[0]=TEMP+LOC(SELDTLHEAD);  # ADD TO NEW LOC       #025260
        END                                                             025270
                                                                        025280
                                   # NOW WORK ON SELDTHEAD.  IT CAN    #025290
                                   # POINT TO AN EXPRESSION STACK AND  #025300
                                   # TO THE RESULTS OF THE STACK       #025310
      P<GIVE>=LOC(SELEXPR[1]);     # POSITION GIVE.                    #025320
      F=24;                        # 1ST BIT POSITION OF RESULTS.      #025330
      F1=42;                       # 1ST BIT OF EXPRESSION STACK ADD.  #025340
                                   # SET UP THE FOR LOOP               #025350
      FOR K=0  STEP 1  UNTIL MAXSELECT-1  DO                            025360
        BEGIN                                                           025370
                                   # CHECK FOR EXPRESSION STACK        #025380
        W=K;                       # SET WORD INDEX                    #
        EXPROC;                    # PROCESS EXP STACK IF PRESENT      #
                                                                        025440
                                   # CHECK FOR RESULTS WORD            #025450
        IF B<F,1>GIVAR[K]  NQ  0  THEN                                  025460
          BEGIN                                                         025470
          W=K;                     # SET SAME INDEX VALUE              #025480
          BITCHECK;                                                     025490
          END                                                           025500
        END                                                             025510
                                                                        025520
                                   # NOW WORK ON BREAKHEAD.  IT CAN    #025530
                                   # POINT TO AN EXPRESSION STACK.     #025540
      P<GIVE> = LOC(BRKEXPR[0]);   # POSITION GIVE                     #
      F1=42;                       # 1ST BIT POSITION                  #025560
                                   # SET UP THE LOOP                   #025570
      FOR K = 0 STEP 1
        UNTIL MAXBREAK
      DO
        BEGIN                                                           025590
        W=K;                       # SET WORD INDEX                    #
        EXPROC;                    # PROCESS THE EXP STACK IF THERE    #
  
                                   # CHECK FOR RESULTS WORD            #
        IF B<F,1>GIVAR[K]  NQ  0  THEN
          BEGIN 
          W=K;                     # SET WORD INDEX                    #
          BITCHECK;                # LINK IT IN                        #
          END 
        END 
        PRWFG  = PFLAG;      # SET PREVIEW FLAG IN CREPORT             #025670
        IF FOUNDV THEN                                                  025680
          FIXVARS(REPNAME[REP]);                                        025690
  
      WORD1A[REP] = REPW0[REP];    # MOVE BACK REPORT NAME LIST        #
      WORD2 [REP] = REPW1[REP];    # AND FROMLFN                       #
      WORD3A[REP] = REPW2[REP]; 
  
      ILFN[IPRE] = SILFN;          # PLACE BACK NAME OF MAIN REPORT    #
      ILFNLG[IPRE] = SLFNLG;       # AND ITS LENGTH                    #
      RPTCTR = REP;                # CORRECT POINTER TO THE LIST       #
      RPTWORD0[RPTCTR] = RPTWORD0[0];  # EVALUATE/MOVE BEFORE/AFTER REP#
      RPTWORD1[RPTCTR] = RPTWORD1[0]; 
      REP = REP+1;   #INCREMENT LOOP COUNTER                           #025700
                     #TO BE TESTED UPON RETURN FROM 72-00              #025710
      CMM$FRF(EXPTBPT);            # GIVE BACK THE CORE                #
      CREPTLG = 0;                 # SET TO ZERO AS FLAG TO XEQREP.    #025720
        P<FIT> = LOC(TABFIT); 
        IF FITOC EQ OC$OPEN        # IF TABLE FILE OPEN                #
        THEN
          BEGIN 
          CLOSEM(FIT, $DET$, RA0);  # CLOSE FILE, RELEASE BUFFER SPACE #
          END 
  
      LOADOVL(BASEX0, O"2", 0);    # LOAD (2,0) FOR PROCESSING         #
      #--------------                                                  #025750
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# SECTION TO COPY THE TEXT FILE TO THE REPORT FILE                     #
#                                                                      #
#**********************************************************************#
  
      PROC LISTTEXT;
      BEGIN 
      XREF PROC GET;
      XREF PROC PUT;
      XREF PROC CMOVE;
      ITEM TBUFPTR I; 
      ITEM LINECNT I; 
      ITEM WP I;                   # WORD POSITION OF END OF LINE      #
      ITEM CP I;                   # CHARACTER POSITIONOF END OF LINE  #
      BASED ARRAY WSA;
        BEGIN 
        ITEM WSAC C(0,0,1);        # CARRIAGE CONTROL CHARACTER        #
        ITEM WSAI I(0,0,60);       # WHOLE WORD ENTRY                  #
        END 
  
                                   # IF THE PREVIEW FLAG IS SET        #
                                   # DO NOT LIST OUT THE TEXT FILE     #
      IF PFLAG EQ 0                # IF NOT A PREVIEW                  #
      THEN
        BEGIN 
      P<SRCFIT> = CMM$ALF(LFIT, 0, 0);  #ALLOCATE CM FOR NEW FIT       # REP7100
      P<FIT> = P<SRCFIT>;                                                REP7100
      P<UNAMEIT> = P<FIT>;                                               REP7100
      FOR I=0 STEP 1                                                     REP7100
        UNTIL LFITM1                                                     REP7100
      DO                                                                 REP7100
        BEGIN                                                            REP7100
        COPYIT[I] = TEXTWD[I];     #COPY FIT FROM MODEL                # REP7100
        END                                                              REP7100
      FITLFN = 0;                  #SET UP THE FET FOR THE FILE THAT   # REP7100
      I = RFROMLEN[REP] * 6;       #CONTAINS THE TEXT TO BE LISTED     # REP7100
      B<0,I>FITLFN = B<0,I>RFROMLFN[REP];                                REP7100
      FITBBH = TRUE;               # ALLOCATE BUFFERS BELOW HHA        #
      OPENM(FIT, $IO$, $R$, RA0);                                        REP7100
  
      IF REP  EQ  0  THEN          # TEST FOR FIRST TIME               #
        BEGIN 
                                   # YES, FIRST TIME.  XEQREP NOT YET  #
                                   # CALLED SO MUST INITIALIZE THE     #
                                   # REPORT FILE                       #
        I = SLFNLG * 6; 
        P<FIT> = LOC(RPTFIT);                                            CHANGES
        FITLFN = 0;                                                      REP7100
        B<0,I>FITLFN = B<0,I>SILFN;                                      REP7100
        P<AFIT> = LOC(RPTFIT);
        AFITFWB = CMM$ALF(MINBUF,FIXED$LWA,0);  # DEFINE A BUFFER      #
        AFITIN = AFITFWB;          # SET IN = OUT = FWA                #
        AFITOUT = AFITFWB;
        AFITLAST = AFITFWB + MINBUF;  # SET LIMIT POINTER              #
        END 
  
                                   # ALL REQUIRED FILES ARE OPEN       #
      P<FIT> = P<SRCFIT>;                                                REP7100
      P<WSA> = CMM$ALF(((FITFL + 9)/10), 0, 0);  #ALLOCATE WSA         # REP7100
      TBUFPTR = P<WSA>; 
      LINECNT = 1000;              # FORCE TOP OF PAGE ROUTINE         #
  
                                   # SET UP LOOP TO DO THE READING     #
                                   # AND OUTPUTING TO THE REPORT FILE  #
      FOR DUMMY=0  WHILE  DUMMY EQ 0  DO
       BEGIN
       GET(SRCFIT, WSA, RA0);      #GET ONE RECORD                     # REP7100
       P<FIT> = P<SRCFIT>;         #NEED TO ACCESS FITRL               # REP7100
       TEMP = FITRL;                                                     REP7100
        IF SRCFITES EQ ENDOFILE                                          REP7100
        OR TEMP EQ 0                                                     REP7100
      THEN                                                               REP7100
          BEGIN 
          DUMMY=1;                 # FOUND END OF FILE.  SET EXIT      #
          TEST DUMMY;              # FROM THIS LOOP                    #
          END 
  
        IF SRCFITES[0]  NQ  0  THEN   # TEST FOR ERROR CODE            #
          BEGIN 
          P<GIVE> = LOC(SRCFIT);
          DIAG (903,SRCFITES[0],GIVE);
          CLOSETL;
          STOP; 
          END 
  
        IF TEMP  GR  PSCOLUMN  THEN  # MAX PAGE SIZE                   #
          TEMP = PSCOLUMN;         # TAKE THE REPORT SIZE              #
  
  
                                   # SHIFT OVER 1 CHARACTER            #
                                   # FOR THE PRINTER CONTROL CHAR      #
        CMOVE (WSA, 0, TEMP, WSA, 1); 
                                   # TEST FOR MAX LINES PER PAGE       #
        IF LINECNT GQ PSLINE       # IF LINE LIMIT EXCEEDED            #
        THEN
          BEGIN 
          LINECNT =0; 
          WSAC[0] = "1";           # TOP OF FORM CHARACTER             #
          END 
        ELSE
          WSAC[0] = " ";           # SET SINGLE SPACE                  #
          WP = TEMP/10;            # WORD POSITION                     #
          CP = TEMP - 10*TEMP;     # CHARACTER POSITION FOR END OF LINE#
          IF CP NQ 0               # IF NO NEED TO BLANK LAST WORD     #
          THEN
            BEGIN 
            C<CP,10-CP>WSAI[WP] = " ";  # BLANK FILL REST OF RECORD    #
            END 
          WRITEH(RPTFIT,WSA,(TEMP+9)/10);  # WRITE A LINE OF REPORT    #
        LINECNT = LINECNT + 1;     # INCREASE LINE COUNT               #
        END 
  
                                   # ALL PRINTING IS DONE              #
                                   # TEST TO SEE IF THIS IS THE LAST   #
                                   # REPORT.  IF SO MUST CLOSE REPORT  #
      CMM$FRF(TBUFPTR);            # GIVE BACK THE CORE                #
      CLOSEM(SRCFIT, $DET$, RA0);  # CLOSE FILE, RELEASE BUFFER SPACE  #
      TBUFPTR = P<SRCFIT>;
      CMM$FRF(TBUFPTR);            # RELEASE CM USED BY FIT            #
        END 
      REP = REP + 1;               # INCREASE REPORT COUNTER           #
      IF REP  GR  LVL  THEN 
        BEGIN 
        WRITER(RPTFIT);            # FLUSH BUFFER AND WRITE EOR        #
        END 
      END 
                                                         CONTROL EJECT; 025760
#**********************************************************************#025770
#                                                                      #
# PROCEDURE TO RE-LINK THE ENTRIES IN THE DESCRIBE,                    #025780
# THE DEFINE, AND SPECIFY TABLES.                                      #025790
# ON ENTRY THISOLD EQUALS THE ADDRESS OF THE FIRST                     #025800
# ENTRY IN THE STRING.                                                 #025810
#                                                                      #
#**********************************************************************#
                                                                        025820
      PROC RELINK1;                                                     025830
        BEGIN                                                           025840
        FOR DUMMY=0  STEP 1  DO    # LOOP TO RELINK ONE ENTRY EACH     #025850
                                   # PASS THROUGH THE LOOP.            #025860
          BEGIN                                                         025870
          P<DESCRAY>=THISOLD;      # POSITION THE ARRAYS TO            #025880
          P<GIVE>=THISOLD;         # THIS ENTRY.                       #025890
          NEXTOLD=DESPOINT[0];     # FETCH LINK TO NEXT ENTRY.         #025900
          IF NEXTOLD  NQ  0  THEN  # IS LINK ZERO IF SO DONE.          #025910
            BEGIN                                                       025920
            DESPOINT[0]=(NEXTOLD-O"400000")+BEGINTABLES;                025930
            THISOLD=DESPOINT[0];   # LINK TO NEXT ENTRY.               #025940
            END                                                         025950
          ELSE                                                          025960
            RETURN;                # EXIT.  LINK WAS ZERO              #025970
          END                                                           025980
        END                                                             025990
                                                         CONTROL EJECT; 026000
#**********************************************************************#026010
#                                                                      #
# THIS PROC RELOCATES CONVERT TABLES, EXPRESSION STACKS AND ITEM       #
# VALUES REFERENCED BY *DEFINE* AND *DESCRIBE* TABLES.                 #
# ON ENTRY THISNEW EQUALS LOCATION OF 1ST ENTRY IN STRING.             #026040
#                                                                      #
#**********************************************************************#
                                                                        026050
      PROC LINKCONTROL;                                                 026060
      BEGIN                                                             026070
      FOR DUMMY=0  STEP  1  DO     # DUMMY LOOP.                       #026080
        BEGIN                                                           026090
        P<GIVE>=THISNEW;           # POSITION ARRAY.                   #026100
        F=18;                      # SET FIRST BIT POSITION TO 18.     #026110
        W=1;                       # SET WORD TO ONE.                  #026120
        BITCHECK;                  # CHECK FIELD FOR ADDRESS.          #026130
  
        IF B<2,1>GIVAR[2] NQ 0     # IF DEPENDENCY WORD PRESENT        #
        THEN
          BEGIN 
          W = 3;
          F = 42; 
          BITCHECK;                # RELOCATE THIS ADDRESS IF PRESENT  #
          END 
                                                                        026140
        F=6;                                                            026150
        W=0;                                                            026160
        BITCHECK;                  # CONVERT TABLE FIELD.              #026170
                                                                        026180
                                   # NOW CHECK TO SEE IF A CONVERT     #026190
                                   # TABLE WAS PRESENT.                #026200
                                   # IF SO MUST RELINK IT.             #026210
        IF FLAG1  NQ  0  THEN                                           026220
          BEGIN                                                         026230
          SAVEADD=P<GIVE>;                                              026240
          P<GIVE>=B<F,18>GIVAR[W]; # GET ADDRESS OF CONVERT TABLE.     #026250
          LINKCONVERT;             # LINK ITEMS REF BY CONVERT TABLE.  #026260
          P<GIVE>=SAVEADD;                                              026270
          END                                                           026280
                                                                        026290
                                   # CHECK FOR EXPRESSION STACK.       #026300
          W=0;
          F1=24;                   # SET BIT POSITION                  #
          EXPROC;                  # PROCESS STACK IF PRESENT          #
                                                                        026560
                                   # NOW FOLLOW THIS STRING.           #026570
        THISNEW=B<42,18>GIVAR[0];  # FETCH FORWARD LINK.               #026580
        IF THISNEW  EQ  0  THEN    # IF POINTER ZERO DONE              #026590
          RETURN;                  # WITH THIS STRING.                 #026600
                                                                        026610
                                   # POINTER IS NOT ZERO.              #026620
                                   # IT POINTS TO CORE LOCATION OF     #026630
                                   # NEXT ENTRY IN THE STRING.         #026640
                                   # LOOP BACK ON THIS ENTRY.          #026650
        END                                                             026660
      END                                                               026670
                                                         CONTROL EJECT; 026680
#**********************************************************************#026690
#                                                                      #
# PROCEDURE TO BE MAIN SUBCONTROL OF LINKING                           #026700
# CONVERSION PARAMETERS OR MOVE PARAMETERS TABLES.                     #026710
# ON ENTRY ARRAY GIVE SHOULD BE POSITIONED TO THE                      #026720
# FIRST WORD OF THE 2 WORD TABLE.                                      #026730
#                                                                      #
#**********************************************************************#
                                                                        026740
      PROC LINKCONVERT;                                                 026750
      BEGIN                                                             026760
      EDITBIT=B<3,1>GIVAR[0];      # FETCH EDITBIT                     #026770
      CONVERTCODE=B<0,3>GIVAR[0];  # FETCH ENTRY TYPE CODE             #
                                                                        026790
      CCODE = B<0,6>GIVAR[1];      # CONVERT CODE                      #
  
                                   # START ON THE FROM FIELD           #
      F = 24;                      # SET FIRST BIT POSITION            #
      W = 0;                       # SET WORD NUMBER                   #
      IF CONVERTCODE GQ 2          # IF CONVERSION REQUIRED            #
        AND B<CCODE,1>MVEVFROM[EDITBIT] NQ 0  # IF FROM POINTER POINTS #
                                   # 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 
                                                                        027050
                                   # TEST FIELD  J.                    #027060
      F=24;                                                             027070
      W=1;                                                              027080
      BITCHECK;                                                         027090
                                                                        027100
                                   # TEST FIELD  K.                    #027110
      F=42;                                                             027120
      BITCHECK;                                                         027130
                                                                        027140
                                   # TEST FIELD  I.                    #027150
                                   # IT CAN BE THE ADDRESS OF AN       #027160
                                   # EXPRESSION STACK, SUBSCRIPT TABLE #027170
                                   # OR ZERO.                          #027180
                                   # IF CONVERT CODE  = 3 EXP. STACK.  #027240
                                   # IF CODE = 4,5,6,7 SUBSCRIPT TABLE #027250
        IF CONVERTCODE  EQ  3  THEN                                     027260
          BEGIN 
                                   # ADDRESS POINTS TO AN EXPRESSION   #027280
                                   # STACK.                            #027290
          F1=6;                    # SET BIT POSITION                  #
          EXPROC;                  # PROCESS THE EXP STACK IF THERE    #
          END                                                           027430
        ELSE
          BEGIN 
                                   # CAN STILL POINT TO SUBSCRIPT TABLE#
          F=6;
          BITCHECK; 
          IF CONVERTCODE GQ 4      # IF SUBSCRIPT                      #
          THEN
            BEGIN 
            J = 0;
            F = 6;                 # BIT POSITION                      #
            LINKFIG;               # LINK DEPENDING ITEMS              #
            END 
          IF CONVERTCODE GQ 5      # IF SUBSCRIPT TABLE CONTAINS       #
                                   # ATTRIB, EXPRESSION STACK, OR      #
                                   # SUBSCRIPT TABLE POINTERS          #
          THEN
            BEGIN 
            P<GIVE> = B<6,18>GIVAR[1];  # POSITION TO SUBSCRIPT TABLE  #
            F = 18; 
            W = 2;
            ATTCONTROL;            # LINK ATTRIBUTE TABLE              #
            IF CONVERTCODE EQ 5    # IF CONTAINS SUBSCRIPT TABLE PTR   #
            THEN
              BEGIN 
              F = 42;              # LINK SUBSCRIPT TABLE              #
              W = 2;
              BITCHECK;            # LINK SUBSCRIPT TABLE              #
              J = 1;               # WORD NUMBER                       #
              F = 42;              # BIT POSITION                      #
              LINKFIG;             # LINK DEPENDING ITEMS              #
              END 
            IF CONVERTCODE EQ 7    # IF CONTAINS EXPRESSION            #
            THEN
              BEGIN 
              W = 2;
              F1 = 42;
              EXPROC;              # LINK EXPRESSION STACK             #
              END 
            END 
          END 
      END                                                               027450
                                                                        027460
                                                                        027470
#**********************************************************************#027480
#                                                                      #
# PROCEDURE TO HELP IN RE-LINKING THE ATTRIBUTE ENTRIES                #027490
#                                                                      #
#**********************************************************************#
                                                                        027500
      PROC ATTCONTROL;                                                  027510
      BEGIN                                                             027520
      BITCHECK;                                                         027530
      IF FLAG1  NQ  0  THEN        # DID WE FIND A POINTER             #027540
        BEGIN                                                           027550
                                   # YES NOW LINK IN ATTRIBUTE POINTER #027560
        TEMP1=B<F,18>GIVAR[W];     # FETCH NEW ADDRESS                 #027570
        SAVEADD1=P<GIVE>;          # SAVE CURRENT POSITION             #027580
        P<GIVE>=TEMP1;             # POSITION TO ATTRIBUTE ENTRY       #027590
        F = 18; 
        W=1;                       # SECOND WORD                       #027610
        BITCHECK;                  # RELINK IF ADDRESS PRESENT         #027620
        P<GIVE>=SAVEADD1;          # RESTORE POSITION OF GIVE          #027630
        END                                                             027640
      RETURN;                                                           027650
      END                                                               027660
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# PROCEDURE TO CONTROL THE LINKING OF EXPRESSION STACKS                #
# ON ENTRY  F1= 1ST BIT POSITION                                       #
#            W = WORD INDEX IN GIVAR                                   #
#                                                                      #
#**********************************************************************#
  
      PROC  EXPROC; 
      BEGIN 
                                   # LOOK FOR AN EXPRESSION STACK      #
                                   # ADDRESS,  CHECK THE HIGH BIT POS  #
      IF B<F1,1>GIVAR[W]  EQ  0   THEN
        BEGIN 
        RETURN;                    # IF NOT SET RETURN                 #
        END 
      ELSE
        BEGIN 
                                   # EXPRESSION STACK PRESENT          #
        SAVEADD2=P<GIVE>;          # SAVE THE POSITION OF GIVE         #
                                   # CORRECT THE LINKAGE TO THE STACK  #
        B<F1,18>GIVAR[W]=B<F1,18>GIVAR[W]-O"400000"+BEGINTABLES;
        P<GIVE>=B<F1,18>GIVAR[W];  # POSITION TO THE EXP STACK         #
        LINKEXPST;                 # LINK IN THE EXPRESSION STACK      #
  
                                   # DID THIS STACK REFERENCE OTHER    #
                                   # EXPRESSION STACKS                 #
        IF TBLG  NQ  0  THEN
          BEGIN 
                                   # YES IT DID                        #
          UNSTACK;                 # UNSTACK THE ENTRIES               #
          END 
        P<GIVE>=SAVEADD2;          # RESTORE POSITION OF GIVE          #
        END 
      END 
                                                         CONTROL EJECT; 027670
#**********************************************************************#027680
#                                                                      #
# PROCEDURE TO BE THE MAIN SUB-CONTROL OF RELINKING                    #027690
# EXPRESSION STACKS.                                                   #027700
# ON ENTRY GIVE SHOULD BE POSITIONED ON THE 1ST                        #027710
# ENTRY IN THE EXPRESSION STACK.                                       #027720
#                                                                      #
#**********************************************************************#
                                                                        027730
      PROC LINKEXPST;                                                   027740
      BEGIN                                                             027750
      FOR J = 0 STEP 4             # DUMMY LOOP                        #
      DO
        BEGIN                                                           027770
                                   # TEST FIELD  F  OF EXP STACK.      #027780
        W = J;
        IF B<0,3>GIVAR[J] NQ 7 THEN  # IF FIELD F NOT OPERATOR         #
          BEGIN 
          F = 24; 
          EDITBIT = B<3,1>GIVAR[J];  # FETCH EDITBIT                   #
          CONVERTCODE = B<0,3>GIVAR[J];  # FETCH ENTRY TYPE CODE       #
          CCODE = B<0,6>GIVAR[J+1];  # FETCH CONVERT CODE              #
          IF CONVERTCODE GQ 2      # IF CONVERSION REQUIRED            #
            AND B<CCODE,1>MVEVFROM[EDITBIT] NQ 0  # IF FROM POINTER    #
                                   # POINTS TO ATTRIBUTE TABLE         #
          THEN
            BEGIN 
            ATTCONTROL;            # PROCESS THE *FROM* ATTRIB         #
            END 
          ELSE
            BEGIN 
            BITCHECK;              # CHECK *FROM* FIELD FOR ADDRESS    #
            END 
          W = J;
          END 
                                                                        027820
                                   # TEST FIELD  G  OF EXP STACK.      #027830
        F=42;                                                           027840
        BITCHECK;                                                       027850
                                                                        027860
                                   # TEST FIELD  J  OF EXP STACK.      #027870
        F=24;                                                           027880
        W=J+1;                                                          027890
        BITCHECK;                                                       027900
                                                                        027910
                                   # TEST FIELD  K  OF EXP STACK.      #027920
        F=24;                                                           027930
        BITCHECK;                                                       027940
                                                                        027950
                                   # NOW CHECK FIELD  I  WHICH CAN     #027960
                                   # POINT TO ANOTHER EXPRESSION STACK.#027970
        F=6;                                                            027980
        BITCHECK;                                                       027990
        IF FLAG1 NQ 0              # IF WE JUST RELOCATED ADDRESS      #
          AND B<0,3>GIVAR[J] NQ 4  # IF A FIGURATIVE SUBSCRIPT TABLE   #
          AND B<0,3>GIVAR[J] NQ 5  # IF A FIGURATIVE SUBSCRIPT TABLE   #
        THEN
          BEGIN                                                         028010
                                   # SAVE ITS ADDRESS IN TBAR1.        #028020
          TBAR1[TBLG]=B<6,18>GIVAR[J+1];                                028030
          TBLG=TBLG+1;                                                  028040
          END                                                           028050
  
        IF FLAG1 NQ 0              # IF ENTRY JUST LINKED              #
          AND (B<0,3>GIVAR[J] EQ 4 # IF A FIGURATIVE SUBSCRIPT TABLE   #
          OR B<0,3>GIVAR[J] EQ 5)  # IF A FIGURATIVE SUBSCRIPT TABLE   #
        THEN
          BEGIN 
          F = 6;                   # BIT POSITION                      #
          LINKFIG;                 # LINK FIGURATIVE SUBSCRIPT TABLE   #
          END 
                                                                        028060
                                   # NOW TEST FOR END OF STACK.        #028070
        IF B<24,18>GIVAR[J]  EQ  O"70"  THEN                            028080
          RETURN;                  # IF FOUND END OF STACK RETURN.     #028090
        END                                                             028100
      END                                                               028110
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     L I N K F I G                                                    #
#                                                                      #
#     THIS PROC RELINKS FIGURATIVE SUBSCRIPT TABLES POINTED TO BY      #
#     AN EXPRESSION STACK ENTRY.  IF THE INDEX OR DEPENDINCY FIELDS ARE#
#     PRESENT THEN THESE FIELDS WILL BE RELINKED.                      #
#                                                                      #
# ENTRY  B<F,18>GIVAR[J+1] = SUBSCRIPT TABLE POINTER                   #
#----------------------------------------------------------------------#
      PROC LINKFIG; 
      BEGIN 
      ITEM TEMP;                   # SAVE EXPRESSION STACK POINTER     #
  
      TEMP = P<GIVE>;              # SAVE EXPRESSION STACK VALUE       #
      P<GIVE> = B<F,18>GIVAR[J+1];  # POSITION TO SUBSCRIPT TABLE      #
      F = 42; 
      W = 0;
      BITCHECK;                    # LINK THIS FIELD IF PRESENT        #
      IF B<6,4>GIVAR[0] GR 1       # IF TWO WORD ENTRY                 #
      THEN
        BEGIN 
        F = 42; 
        W = 1;
        BITCHECK;                  # LINK THIS FIELD IF PRESENT        #
        END 
      P<GIVE> = TEMP;              # RESTORE EXPRESSION STACK POINTER  #
      END 
                                                         CONTROL EJECT; 028120
#**********************************************************************#028130
#                                                                      #
# PROCEDURE TO CONTROL THE UNSTACKING OF TABAR.                        #028140
#                                                                      #
#**********************************************************************#
                                                                        028150
      PROC UNSTACK;                                                     028160
      BEGIN                                                             028170
      FOR DUMMY3=0  STEP 1  DO                                          028180
        BEGIN                                                           028190
        STBAR1=TBAR1[0];           # SAVE THE POINTER.                 #028200
        IF STBAR1  EQ  0  THEN     # IF STBAR1 IS ZERO THE             #028210
          RETURN;                  # STACK IS EMPTY.  RETURN.          #028220
                                                                        028230
                                   # PUSH DOWN THE STACK.              #028240
        FOR L=1  STEP 1  UNTIL TBLG  DO 
          BEGIN                                                         028260
          TBAR1[L-1]=TBAR1[L];                                          028270
          END                                                           028280
        TBAR1[L]=0;                # ZERO OUT LAST WORD.               #028290
        TBLG=TBLG-1;               # DECREASE TABLE POINTER.           #028300
                                                                        028310
                                   # NOW PROCESS THIS EXPRESSION STACK.#028320
        P<GIVE>=STBAR1;                                                 028330
        LINKEXPST;                 # RE LINK THIS STACK.               #028340
        END                                                             028350
      END                                                               028360
                                                         CONTROL EJECT; 028370
#**********************************************************************#028380
#                                                                      #
# PROCEDURE TO BE THE MAIN CONTROL OF RE-LINKING                       #028390
# THE VARIOUS HEADING , FOOTING, ECT.  ARRARYS.                        #028400
# THESE ARRARYS CAN POINT TO EATHER AN EXPRESSION                      #028410
# STACK OR A MOVE TABLE.                                               #028420
#                                                                      #
#**********************************************************************#
                                                                        028430
      PROC LINKREPT;                                                    028440
      BEGIN                                                             028450
      FOR I=0  STEP 1  UNTIL  LOOPDONE-1  DO
        BEGIN                                                           028470
        IF B<24,18>GIVAR[0]  NQ  0  THEN  EEV24;   # CHECK FOR         #028480
        IF B<42,18>GIVAR[0]  NQ  0  THEN  EEV42;   # EXPRESSIONS.      #028490
        P<GIVE>=P<GIVE>+1;                                              028500
        IF B<24,18>GIVAR[0]  NQ  0  THEN  EMV24;   # CHECK FOR         #028510
        IF B<42,18>GIVAR[0]  NQ  0  THEN  EMV42;   # MOVE TABLES       #028520
        P<GIVE>=P<GIVE>+1;                                              028530
        END                                                             028540
      END                                                               028550
                                                          CONTROL EJECT;028560
#**********************************************************************#
#                                                                      #
# COLLECTION OF PROCEDURES TO BE THE CONTROL OF LINKING                #
# THE LIST OF CONVERSION PRAMETERS,  EXPRESSION STACKS                 #
# AND ATTRIBUTE TABLES POINTER TO IN THE EVALUATE BEFOR/AFTER ARRARY   #
#                                                                      #
#**********************************************************************#
  
  
  
# STRING POINTER IN BITS  24-41                                        #
  
      PROC  EEV24;
      BEGIN 
      F1=24;                       # SET 1 ST BIT POSITION             #
      EEVCOM;                      # CONNOM CONTROL ROUTINE            #
      END 
  
  
# STRING POINTER IN BITS  42-59                                        #
  
      PROC  EEV42;
      BEGIN 
      F1=42;                       # SET 1 ST BIT POSITION             #
      EEVCOM;                      # COMMON CONTROL ROUTINE            #
      END 
  
  
# COMMON ROUTINE TO PROCESS BEFOR/AFTER STRINGS                        #
# ON ENTRY  F1 = BIT POSITION                                          #
#         GIVE = POSITION OF REFERENCE                                 #
  
      PROC  EEVCOM; 
      BEGIN 
      SAVEADD=P<GIVE>;             # SAVE POSITION OF GIVE             #
                                   # UPDATE LINK TO STRING             #
      B<F1,18>GIVAR[0]=B<F1,18>GIVAR[0]-O"400000"+BEGINTABLES;
                                   # POSITION TO THE FIRST ENTRY       #
                                   # IN THE STRING                     #
      P<GIVE>=B<F1,18>GIVAR[0]; 
  
                                   # NOW STEP THRU THE STRING LINKING  #
                                   # THE ITEMS REFERENCED.             #
                                   # THEY CAN BE CONVERSION TABLES     #
                                   #          OR EXPRESSION STACKS     #
                                   #          OR ATTRIBUTE TABLES.     #
      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. END OF POINTERS       #
            TEST DONE;             # EXIT PROC                         #
            END 
          ELSE
            BEGIN 
                                   # NOT ZERO.  NOT END OF STRING      #
                                   # CHECK FOR CONVERSION TABLE        #
            F=6;                   # SET 1 ST BIT POSITION             #
            W=K;                   # SET WORD POSITION                 #
            BITCHECK; 
                                   # NOW CHECK TO SEE IF ONE WAS LINKED#
            IF FLAG1  NQ  0  THEN 
              BEGIN 
              SAVEADD3=P<GIVE>;    # SAVE CURRENT POSITION             #
              P<GIVE>=B<F,18>GIVAR[K];  # GET ADDRESS OF CONVERT TABLE #
              LINKCONVERT;         # LINK IT IN                        #
              P<GIVE>=SAVEADD3;    # RESTORE POSITION OF GIVE          #
              END 
  
                                   # CHECK FOR EXPRESSION STACK        #
            F1=24;                 # SET 1 ST BIT POSITION             #
            W=K;                   # SET WORD POSITION                 #
            EXPROC;                # PROCESS THE STACK IF ONE PRESENT  #
  
                                   # CHECK FOR ATTRIBUTE TABLE         #
            IF B<42,18>GIVAR[K]  NQ  0  THEN
              BEGIN 
              F=42;                # SET 1 ST BIT POSITION             #
              W=K;                 # SET WORD POSITION                 #
              ATTCONTROL;          # PROCESS ATTRIBUTE ENTRY           #
              END 
            END 
          END 
        IF GIVAR[6]  NQ  0  THEN
          BEGIN 
                                   # MORE TO WORD ON                   #
                                   # ANOTHER GROUP OF 7 WORDS          #
                                   # LINK TO NEXT BLOCK OF 7           #
          GIVAR[6]=GIVAR[6]-O"400000"+BEGINTABLES;
          P<GIVE>=GIVAR[6];        # POSITION TO NEXT BLOCK            #
          TEST DONE;               # WORD ON THIS BLOCK                #
          END 
        ELSE
          BEGIN 
          DONE = 1;                # NO CONTINUATION BLOCK SO QUIT     #
          TEST DONE;
          END 
        END 
      P<GIVE> = SAVEADD;           # RESTORE POSITION OF GIVE          #
      END 
                                                          CONTROL EJECT;
#**********************************************************************#
#                                                                      #
# COLLECTION OF PROCEDURES TO BE THE CONTROL OF LINKING                #
# THE LIST OF MOVE TABLES POINTED TO IN THE MOVE BEFOR/AFTER ARRARY    #
#                                                                      #
#**********************************************************************#
  
  
# STRING POINTER IN BITS  24-41                                        #
  
      PROC  EMV24;
      BEGIN 
      F1=24;                       # SET 1 ST 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 CONTROL ROUTINE TO PROCESS BEFOR/AFTER STRINGS                #
# ON ENTRY  F1= BIT POSITION                                           #
#         GIVE = POSITION (WORD) OF REFERENCE                          #
  
      PROC  EMVCOM; 
      BEGIN 
      SAVEADD3=P<GIVE>;            # SAVE POSITION OF GIVE             #
                                   # UPDATE LINK TO STRING             #
      B<F1,18>GIVAR[0]=B<F1,18>GIVAR[0]-O"400000"+BEGINTABLES;
                                   # POSITION TO THE FIRST ENTRY       #
                                   # IN THE STRING                     #
      P<GIVE>=B<F1,18>GIVAR[0]; 
  
                                   # NOW STEP THRU THE STRING LINKING  #
                                   # THE ITEMS REFERENCED              #
      FOR DONE=0  WHILE DONE  EQ  0   DO
        BEGIN 
        FOR K=0  STEP 2  UNTIL  12  DO
          BEGIN 
          IF GIVAR[K]  EQ  0  THEN
            BEGIN 
            DONE=1;                # FOUND A ZERO.  END OF POINTERS    #
            TEST DONE;             # EXIT PROC                         #
            END 
          ELSE
            BEGIN 
                                   # NOT ZERO.  NOT END OF STRING      #
                                   # HAVE TABLE TO PROCESS             #
            SAVEADD4=P<GIVE>;      # SAVE POINTER TO THE TABLE         #
            P<GIVE>=P<GIVE>+K;     # POINT TO ENTRY                    #
            LINKCONVERT;           # LINK UP THE TABLE                 #
            P<GIVE>=SAVEADD4;      # RESTORE POSITION OF GIVE          #
            END 
          END 
                                   # TEST FOR NEXT BLOCK OF 15 WORDS   #
        IF GIVAR[14]  NQ  0  THEN 
          BEGIN 
                                   # MORE TO WORK ON                   #
                                   # LINK TO NEXT BLOCK OF 15 WORDS    #
          GIVAR[14]=GIVAR[14]-O"400000"+BEGINTABLES;
          P<GIVE>=GIVAR[14];
          TEST DONE;               # WORD ON THIS STACK OF 15 WORDS    #
          END 
        ELSE                       # END OF MOVE TABLE                 #
          BEGIN 
          DONE = 1;                # INDICATE END OF *FOR* LOOP        #
          TEST DONE;
          END 
        END 
      P<GIVE> = SAVEADD3;          # RESTORE POSITION OF GIVE          #
      END 
                                                         CONTROL EJECT; 029430
#**********************************************************************#029440
#                                                                      #
# PROCEDURE TO CHECK BIT FIELDS FOR ADDRESSES.                         #029450
# UPDATING OF THE RELATIVE TO CORE ADDRESS WILL BE DONE.               #029460
# ON ENTRY  F = FIRST BIT POSITION.                                    #029470
#           W = WORD NUMBER.                                           #029480
# ON EXIT FLAG1 " 0 IF ADDRESS WAS RELOCATED.                          #
#                                                                      #
#**********************************************************************#
                                                                        029490
      PROC BITCHECK;                                                    029500
      BEGIN                                                             029510
      FLAG1 = B<F,1>GIVAR[W];      # LOOK AT HIGH ORDER BIT            #
                                   # IF THE BIT IS ZERO NOT AN         #029540
      IF FLAG1  EQ  0  THEN        # ADDRESS RELATIVE IN THE RECORD    #029550
        BEGIN                                                           029560
                                   # TEST TO SEE IF IT IS ONE OF       #029570
                                   # THE SPECIAL POINTERS.             #029580
        TEMP=B<F,18>GIVAR[W];      # FETCH 18 BIT FIELD                #029590
        IF TEMP  EQ  0  THEN                                            029600
          RETURN;                  # IF ZERO RETURN. NO POINTER.       #029610
                                                                        029620
        IF TEMP  EQ  OLDCURSOURCE  THEN                                 029630
          BEGIN                                                         029640
          B<F,18>GIVAR[W]=LOC(CURRENTSOURC);                            029650
          RETURN;                                                       029660
          END                                                           029670
                                                                        029680
        IF TEMP  EQ  OLDFORMADD  THEN                                   029690
          BEGIN                                                         029700
          B<F,18>GIVAR[W]=LOC(FORMDLADDR);                              029710
          RETURN;                                                       029720
          END                                                           029730
                                                                        029740
        RETURN;                    # NOT ANY OF THE SPECIAL POINTERS   #029750
        END                                                             029760
  
                                   # BIT WAS SET.  CHANGE RELATIVE     #029780
                                   # ADDRESS TO CORE ADDRESS.          #029790
      B<F,18>GIVAR[W]=B<F,18>GIVAR[W]-O"400000"+BEGINTABLES;            029800
      RETURN;                                                           029810
      END                                                               029820
      END     TERM                                                      029830
