*DECK MOVEVAL 
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TPSTACK 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC MOVEVAL; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     MOVEXEC                                                          #
#     MVEXP                        MOVE AN EXPRESSION                  #
#     SAVEVA                       SAVE AN EVALUATE ENTRY              #
#     SETCOD9                      SET BASC CODE OF 9                  #
#     SETCO10                      SET BASC CODE OF 10                 #
#     SETMOVE                      ALLOCATE MOVE TABLE                 #
#     SETPOIN                                                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
     BASED ARRAY ADDR; ITEM ADDRE I(0,18,18), 
              ADDREW I(0,0,60), 
                            ADDRLG I(0,42,18);
      XREF ITEM AREATBLPTR   I;    # POINTS TO HEAD OF AREATBL CHAIN   #
      ARRAY BB S(EESIZE); 
              ITEM BFCHAR U(0,4,4), 
                   BFADDR I(0,24,18), 
                   BADDRF I(1,24,18), 
                   BCHARLG U(0,12,12),  # LENGTH OF FIELD IN CHARS     #
                   BSTACK I(1,6,18),
                   BEDIT B(0,3,1),
                   BPRKEY B(2,0,1),  # TRUE IF PRIMARY KEY             #
                   BKEYEXCL B(2,1,1),  # TRUE PART/ALL OF EXCLUDED KEY #
                   BRECDORD U(2,27,12),  # REC ORD IF CDCS AREA ITEM   #
                                         # 1 IF CRM AREA ITEM, ELSE 0  #
                   BITEMORD U(2,39,15),  # ITEM ORD IF CDCS DBI, ELSE 0#
                   BW1 U(0,0,60), 
                   BW2 U(1,0,60), 
                   BW3 I(2,0,60); 
      BASED ARRAY DESATT1NAME;     # DESATT1 NAME FIELD                #
        BEGIN 
        ITEM NAME$CHAR  C(0,0,1);  # FIRST CHARACTER OF NAME           #
                                   # IF THE FIRST CHARACTER OF THE NAME#
                                   # IS A COMMA, THEN IT WILL BE       #
                                   # FOLLOWED BY THE CUMMULATIVE       #
                                   # FUNCTION CODE.                    #
        ITEM NAME$CODE  U(0,6,9);  # FUNCTION CODE                     #
        END 
      XREF ITEM ANYAREAITEM B;     # TRUE IF *SETTING* OR *SMMOVE* LIST#
                                   # CONTAINS AN AREA ITEM             #
      XREF ITEM CURREG B;          # TRUE IF CURRENT-REGISTER          # QU3A334
      XREF ITEM ENDPTR;            # INDEX INTO EVALUATE TABLE         #
      XREF ITEM EVALFWA;           # FWA OF FIRST EVALUATE TABLE       #
      XREF ITEM IMFDBM B;          # TRUE IF IN IMF DATABASE MODE      #
      XREF ITEM CDCSDBM B;         # TRUE IF IN CDCS DATABASE MODE     #
      XREF ITEM SEARCHKEY B;       # TRUE IF SEARCH KEY FOUND          #
          XREF BASED ARRAY EVALDATA;
          BEGIN ITEM EVALWD I(0,0,60);
              ITEM DATADEFADDR I(0,42,18),
              LOGRST B(0,0,1),                                          022530
                   DATASTACK I(0,24,18),
                   DATACNVT I(0,6,18);
          END 
      ITEM FIGS         B;
      ITEM IJK          I;         # SCRATCH TEMPORARY                 #
      ITEM J            I;         # SCRATCH TEMPORARY                 #
      ITEM K            I;         # SCRATCH TEMPORARY                 #
      ITEM KJI          I;         # SCRATCH TEMPORARY                 #
      ITEM MOVEDBEFORE B;          # TRUE IF A PROGRAMSTACK FOR A MOVE #
                                   # IS ALREADY POINTED TO BY MOVE TBL #
      ITEM MOVEFILEPASS B;         # TEMPORARY VALUE OF FILEPASS.      #
                                   # IF *MOVE* DIRECTIVE, MOVEFILEPASS #
                                   # TRUE SETS FILEPASS TRUE.          #
                                   # MOVE CLAUSE OF STORE, MODIFY      #
                                   # REMOVE NEVER SETS FILEPASS.       #
      ITEM SAVEATTRIB B;           # TRUE IF SAVED RESULT REQUIRES     #
                                   # ATTRIB TABLE                      #
      ITEM SAVEDRESULT I;          # RESULT ADDRESS OF PROGRAMSTACK    #
      ITEM SAVEDPTLOC I;           # SAVE DPTLOC                       #
  
      XDEF BASED ARRAY MOVETBL S(EESIZE);  # MOVE TABLE                #
              ITEM MENTRY    U(0,00,03),
                   MFCHAR    U(0,04,04),
                   MTCHAR    U(0,08,04),
                   MCHARLG   U(0,12,12),  # LENGTH OF FIELD IN CHARS   #
                   MFROMADDR I(0,24,18),
                   MTOADDR   I(0,42,18),
                   MCNVT     U(1,00,06),
                   MSTACKADD I(1,06,18),
                   MADDRFR   I(1,24,18),
                   MADDRTO   I(1,42,18),
                   MRECDORD  U(2,27,12),  # REC ORD IF CDCS AREA ITEM  #
                                          # 1 IF CRM AREA ITEM, ELSE 0 #
                   MWORD1    I(0,00,60),
                   MWORD2    I(1,00,60),
                   MWORD3    I(2,00,60);
      BASED ARRAY RESULT$FIELD;    # FOR LOOKING AT RESULT FIELD       #
        BEGIN 
        ITEM RESULT U(0,0,60);     # ONE WORD OF RESULT FIELD          #
        END 
      XREF ITEM RO           B;    # TRUE IF *QU,RO*                   #
      XREF ITEM SM$GROUPID   I;    # GROUP ID OF CURRENT SYNTAX STUFF  #
      XREF ITEM TARGETAREA   I;    # POINTER TO AREA TO BE UPDATED     #
      XREF ITEM TEMPTBLPTR   I; 
      ITEM TYPE         I;
      XREF ITEM UPDATING     B;    # TRUE IF SOME KIND OF UPDATE       #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC RECYES; 
      XREF PROC RECNO;
      XREF FUNC SAVATTR I;
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC MVEXP;
          PROC MVEXP; 
          BEGIN 
          IF FNEXT THEN BEGIN DIAG(943); STDNO; END 
          IF RECORDFLAG THEN
          STDYES;                                                       001910
          MOVEDBEFORE = FALSE;     # INITIALIZE FOR 1ST USE OF PROG STK#
          SAVEDRESULT = 0;
          SAVEATTRIB = FALSE;      # CONVERT DOES NOT NEED ATTRIB TBL  #
              BW1[0] = 0; 
              BW2[0] = 0; 
              BW3[0] = 0; 
              FIGS = FALSE; 
              IF PROGSTACKLEN GR 0 THEN 
              BEGIN 
                  BADDRF[0] = RESULTSLOC; 
                  BSTACK[0] = PROGSTACKLOC; 
                  TYPE = RESULTUSAGE; 
          DATALENG = RESULTSIZE;
          IF TYPE GQ 1             # IF NUMERIC, INTEGER, FIXED        #
            AND TYPE LQ 3 
          THEN
          BEGIN DATAWORDADDR = 0; 
          SAVEATTRIB = TRUE;       # CONVERT NEEDS ATTRIB TABLE        #
               GOTO MKATT;                                              020520
         END                                                            020530
              END 
              ELSE
              BEGIN 
          BPRKEY = AKEYITEM;       # TRUE IF PRIMARY KEY               #
          BKEYEXCL = EXCLKEYITEM;  # TRUE IF PART/ALL OF EXCLUDED KEY  #
          BRECDORD = DATARECDORD; 
          BITEMORD = DATAITEMORD; 
          IF INDICED THEN BEGIN FIGS = TRUE;
          BSTACK[0] = INDCTBLOC; END
                  TYPE = DATATYPE;
                  IF NOT ABSADDRESS THEN BADDRF[0] = DATANAMEBASE;
                                                                        020440
          IF (TYPE LQ 3            # IF NUMERIC, INTEGER, OR UNNORM    #
              AND TYPE GQ 1)
            OR INDICED             # IF INDEXED                        #
          THEN
         BEGIN IF FIGLITDATA NQ 1 THEN                                  020460
          BEGIN P<DESATT1> = DATANAMEPTR; 
              IF DECLASS[0] GR 7 THEN BEDIT[0] = TRUE;
          IF AREAITM THEN DATANAMEPTR = SAVATTR;
                BFADDR[0] = DATANAMEPTR;                                020470
          END 
               ELSE 
         BEGIN MKATT: # #                                               020550
                P<ADDR> = CMM$ALF(2, 0, SM$GROUPID);
                     ADDRE[0] = DATAWORDADDR; 
          ADDRLG[0] = DATALENG; 
         BFADDR[0] = P<ADDR> - 1;                                       020580
               END
          END 
          ELSE
                  BFADDR[0] = DATAWORDADDR; 
              END 
              BFCHAR[0] = DATACHARPOS;
      IF AREAITM  THEN
        BEGIN 
        MOVEFILEPASS = TRUE;
        IF REFERFILE NQ O"77"  THEN REFERFILE = 1;
        IF BASCODE[BASTABIND] EQ MODCODE  # IF *MODIFY*                #
        THEN
          BEGIN 
          ANYAREAITEM = TRUE;      # FLAG DATABASE ITEM WILL BE MOVED  #
          END 
        END 
          BCHARLG[0] = DATALENG;
          STDYES;                                                       001930
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC MOVEXEC;
      PROC MOVEXEC; 
      BEGIN 
      RECYES;                      # RETURN STDYES IF RECORDING        #
        IF AREAITM                 # IF TARGET IS AN AREA ITEM         #
        THEN
          BEGIN 
          IF RO                    # IF IN READ ONLY MODE              #
          THEN
            BEGIN 
            DIAG ( 308 );          # ERROR, TYPE OF MOVE NOT ALLOWED   #
            STDNO;
            END 
  
          IF NOT IMFDBM            # IF CRM OR CDCS MODES, ONLY        #
          THEN
            BEGIN 
            IF TARGETAREA EQ 0 THEN 
                                   # TRY TO FIND THE CORRECT AREA.     #
              BEGIN 
              P<AREA$TABLE> = AREATBLPTR; 
              IF TEMPTBLPTR NQ 0 THEN 
                BEGIN 
                TARGETAREA = TEMPTBLPTR;
                END 
              ELSE
                BEGIN 
              P<AREA$TABLE> = AT$FORWARD; 
              IF AT$FORWARD EQ 0 THEN 
                BEGIN 
                                   # ONLY ONE AREA.                    #
                TARGETAREA = P<AREA$TABLE>; 
                END 
              ELSE
                BEGIN 
                                   # CANNOT ISOLATE AREA               #
                DIAG (345); 
                STDNO;
                END 
                END 
              END 
            P<AREA$TABLE> = TARGETAREA;  #POSITION TO AREA TABLE       #
            END                    # COMPLETE - IF NOT IMFDBM-         #
  
                                               # IF THIS *MOVE* IS IN A#
            IF BASCODE[BASTABIND] GQ STORCODE  # *STORE* OR *MODIFY*   #
            THEN
              BEGIN 
              ANYAREAITEM = TRUE;  # FLAG THAT *MOVE* REFS AN AREA     #
              IF AKEYITEM          # IF THIS ITEM IS A PRIMARY KEY,    #
                AND (BASCODE[BASTABIND] EQ STORCODE  # AND DIRECTIVE IS#
                  OR BASCODE[BASTABIND] EQ STRSCODE) # *STORE*         #
              THEN
                BEGIN 
                SEARCHKEY = TRUE;  # FLAG THAT KEY IS FOUND            #
                END 
              END 
  
            IF NOT IMFDBM          # IF NOT IN IMF MODE                #
              AND NOT AT$KEYEXCL   # AND KEY INSIDE RECORD             #
            THEN
              BEGIN 
              J = DATAWORDADDR * 10 + DATACHARPOS;
            KJI = J + DATALENG - 1; 
            P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE    #
            K = KT$WPOS[DATARECDORD] * 10 + KT$CPOS[DATARECDORD]; 
                                   # FIRST CHAR POSITION OF THE KEY    #
            IJK = K + KT$LENGTH[DATARECDORD] - 1; 
  
                                   # IN THE FOLLOWING IF STATEMENT...  #
                                   # J = FIRST CHAR POS OF THE ITEM    #
                                   # KJI = LAST CHAR POS OF THE ITEM   #
                                   # K = FIRST CHAR POS OF THE KEY     #
                                   # IJK = LAST CHAR POS OF THE KEY    #
                                   #                                   #
                                   # THE IF TRIES TO CATCH ANY ITEM    #
                                   # THAT WOULD CLOBBER ANY PART OF THE#
                                   # KEY. WE TRAP THE CONDITION OF     #
                                   # EITHER OF THE TWO FIELDS STARTING #
                                   # FROM WITHIN THE OTHER.            #
  
            IF (J GQ K   AND   J LQ IJK) OR 
               (K GQ J   AND   K LQ KJI) THEN  # IF THEY OVERLAP       #
              BEGIN 
              GOTO KEYERR;         # DIAGNOSE ITEM/KEY OVERLAP         #
              END 
            END 
          ELSE                     # IF KEY OUTSIDE OF RECORD          #
            BEGIN 
            IF AKEYITEM            # AND IF THIS ITEM IS THE KEY       #
            THEN
              BEGIN 
KEYERR: 
                                   # NOT AN ERROR FOR *STORE* OR *MOD* #
              IF BASCODE[BASTABIND] GQ STORCODE 
              THEN
                BEGIN              # FLAG THAT KEY WILL BE MODIFIED    #
                BASCMODKEY[BASTABIND] = TRUE; 
                END 
              ELSE                 # ERROR FOR EVERYONE ELSE           #
                BEGIN 
                DIAG (208);        # ITEM/KEY OVERLAP                  #
                STDNO;             # ERROR EXIT                        #
                END 
              END 
            END 
  
      IF NOT RECORDFLAG  THEN REFERFILE = O"77";
          END                                                           000270
          IF FIGLITDATA EQ 1       # IF LITERAL                        # QU3A334
            OR FIGLITDATA EQ 3     # IF DESCRIBED ITEM                 # QU3A334
            OR CURREG              # IF CURRENT-REGISTER               # QU3A334
          THEN                                                           QU3A334
          BEGIN DIAG(21); STDNO; END                                    000380
      IF AREAITM THEN              # AREA ITEM IS TARGET OF A MOVE, SO #
                                   # MUST BE UPDATING.                 #
        BEGIN 
        UPDATING = TRUE;
        END 
      IF ENDPTR EQ 10 THEN
        BEGIN 
        K = CMM$ALF(31, 0, SM$GROUPID); 
            MWORD1[10] = K; 
                P<MOVETBL> = K; 
                ENDPTR = 0; 
          END 
          IF MOVEDBEFORE           # IF NOT 1ST USE OF PROG STACK      #
          THEN
            BEGIN 
            BSTACK[0] = 0;
            BADDRF[0] = 0;
            IF SAVEATTRIB          # IF CONVERT NEEDS ATTRIB TABLE     #
            THEN
              BEGIN 
              P<ADDR> = CMM$ALF(2, 0, SM$GROUPID);  # REQUEST ATTRIB TB#
              ADDRE[0] = SAVEDRESULT;  # ADDRESS OF VALUE              #
              BFADDR[0] = LOC(ADDR) - 1;  # ADDRESS OF ATTRIB TABLE    #
              END 
            ELSE                   # NO ATTRIB TABLE REQUIRED          #
              BEGIN 
              BFADDR[0] = SAVEDRESULT;  # ADDRESS OF VALUE             #
              END 
            END 
          IF AREAITM THEN 
                DATANAMEPTR = SAVATTR;
              MWORD1[ENDPTR] = BW1[0];
              MWORD2[ENDPTR] = BW2[0];
              MWORD3[ENDPTR] = BW3[0];
              MTCHAR[ENDPTR] = DATACHARPOS; 
          IF NOT FIGS THEN BEGIN
            IF BSTACK[0] EQ 0      # IF NO PROGRAMSTACK                #
            THEN
              BEGIN 
              MENTRY[ENDPTR] = 2;  # CALL CONVERT                      #
              END 
            ELSE
              BEGIN 
              MENTRY[ENDPTR] = 3;  # CALL EXPEVALUATE                  #
              MOVEDBEFORE = TRUE;  # MOVE TBL POINTS TO PROG STACK     #
              SAVEDRESULT = BADDRF[0];  # RESULT OF PROG STACK         #
              END 
          END 
          ELSE MENTRY[ENDPTR] = 4;
          IF DATATYPE LS 4
          THEN
          BEGIN 
                P<DESATT1> = DATANAMEPTR; 
                SAVEDPTLOC = DPTLOC[0]; 
               IJK = DATACHARPOS * 6; 
                 IF NOT INDICED AND (IJK NQ DBITPOS[0] OR 
                    DATAWORDADDR NQ DEWPOS[0]) THEN 
                     BEGIN P<ADDR> = P<DESATT1>;
                           P<DESATT1> = CMM$ALF(7, 0, SM$GROUPID);
                           DEWPOS[0] = DATAWORDADDR;
                           DBITPOS[0] = IJK;
                           DECLSLG[0] = DATALENG; 
                           DPTLOC[0] = SAVEDPTLOC;
                     END
          MTOADDR[ENDPTR] = P<DESATT1>; 
          END 
                      ELSE MTOADDR[ENDPTR] = DATAWORDADDR;
                  IF ABSADDRESS THEN MADDRTO[ENDPTR] = 0; 
                      ELSE MADDRTO[ENDPTR] = DATANAMEBASE;
         IF TYPE EQ 0 AND DATATYPE GR 0 AND DATATYPE LS 7 THEN          020630
          BEGIN DIAG(169);
                STDNO;
          END 
          IF MRECDORD[ENDPTR] EQ 0  # IF NO RECORD ORDINAL YET         #
          THEN
            BEGIN 
            MRECDORD[ENDPTR] = DATARECDORD;  # INITIALIZE IT           #
            END 
          ELSE                     # IF RECORD ORD ALREADY SPECIFIED   #
            BEGIN 
            IF MRECDORD[ENDPTR] NQ DATARECDORD  # IF DIFFERENT         #
              AND DATARECDORD NQ 0
            THEN
              BEGIN 
              DIAG(377);           # DATA-NAMES REFERENCE > 1 RECORD   #
              STDNO;               # ERROR EXIT                        #
              END 
            END 
         MCNVT[ENDPTR] = B<DATATYPE*6,6>CCODE[TYPE];                    020650
  
         IF NOT (CDCSDBM AND IMFDBM) # NEITHER CDCS NOR IMF MODE       #
         THEN 
           BEGIN
           IF (AT$KEYEXCL) AND
              (AKEYITEM)   AND
              ((BASCODE[BASTABIND] EQ STORCODE) OR
               (BASCODE[BASTABIND] EQ STRSCODE))
           THEN 
             BEGIN
             P<FIT> = LOC(AT$AFITPOS);
             FITKA  = AT$CURRKEY + P<AREA$TABLE>; 
             MADDRTO[ENDPTR] = LOC(FITKA);
             END  # FOR NON-EMK, KEY SHOULD BE IN KA INSTEAD OF WSA # 
           END
  
          IF INDICED THEN 
          BEGIN 
          IF BSTACK[0] NQ 0 THEN
         BEGIN IF FIGS THEN IJK = 5; ELSE IJK = 7;
          END ELSE IJK = 6; 
          MENTRY[ENDPTR] = IJK; 
          P<DESATT1> = INDCTBLOC;                                       000290
          IJK = B<6,4>DDWORD0[0]; 
         IF B<0,1>DDWORD0[0] EQ 0 THEN                                  001300
          IJK = IJK + 1;                                                000360
          P<ADDR> = CMM$ALF(IJK + 1, 0, SM$GROUPID);
          ADDRLG[IJK] = BSTACK[0];
          ADDRE[IJK] = DATANAMEPTR; 
          IJK = IJK - 1;
          FOR KJI = 0 STEP 1 UNTIL IJK DO ADDREW[KJI]=DDWORD0[KJI]; 
          MSTACKADD[ENDPTR] = P<ADDR>;
          CMM$FRF(INDCTBLOC); 
           END                                                          002530
              ENDPTR = ENDPTR + 1;
              STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC SAVEVA; PROC SAVEVA;
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
         IF FIGLITDATA NQ 2 AND FIGLITDATA NQ 4 THEN STDNO;             020690
     IF ENDPTR EQ 6 THEN
          BEGIN 
                K = CMM$ALF(7, 0, SM$GROUPID);
                EVALWD[6] = K;
                P<EVALDATA> = K;
                ENDPTR = 0; 
          END 
              DATADEFADDR[ENDPTR] = DATANAMEPTR;
              P<DESATT1> = DATANAMEPTR; 
                                   # WHEN EVALUATING A CUMULATIVE      #
                                   # FUNCTION, RESET ITS VALUE.        #
                                   # LOOK AT ITEM NAME ENTRY.          #
          IF DIMOCC[0] THEN        # IF DIMENSIONED OCCURANCE...       #
            BEGIN 
            P<DESATT1NAME> = P<DESATT1> + 4;  # ITEM NAME IS HERE      #
            END 
          ELSE
            BEGIN 
            P<DESATT1NAME> = P<DESATT1> + 3;  # ITEM NAME IS HERE      #
            END 
          IF NAME$CHAR EQ "," OR NAME$CHAR EQ "."       # IF CUM FUNC  #
          THEN
            BEGIN 
            P<PROGRAMSTACK> = DEXPPTR[0];  # PICK UP STACK ADDRESS     #
                                   # IF COUNT, SUM, OR MEAN...         #
                                   # (CODE = 307, 310, OR 311)         #
            IF NAME$CODE LS O"312" THEN 
              BEGIN 
                                   # PICK UP RESULT ADDRESS            #
              P<RESULT$FIELD> = TOWORDADDR[2];
              RESULT[0] = 0;       # RESET COUNT, SUM, OR MEAN         #
              RESULT[1] = 0;
              END 
            ELSE
              BEGIN 
              J = OPCODE[2];       # PICK UP OP CODE IN STACK          #
              IF J LS O"120" THEN  # IF MAX OR MIN...                  #
                BEGIN 
                OPCODE[2] = J + O"50";  # RESET OP CODE                #
                END 
              END 
            END 
              DATASTACK[ENDPTR] = DEXPPTR[0]; 
      IF AREAITM  THEN
        BEGIN 
        MOVEFILEPASS = TRUE;
        IF REFERFILE NQ O"77"  THEN  REFERFILE = 1; 
          END 
              DATACNVT[ENDPTR] = DCNVTBL[0];
              ENDPTR = ENDPTR + 1;
         IF LOGICALRESLT THEN LOGRST[ENDPTR]=TRUE;                      020710
         ELSE LOGRST[ENDPTR] = FALSE;                                   020720
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC SETCOD9;
          PROC SETCOD9; 
          BEGIN IF RECORDFLAG THEN STDNO; 
                ENDPTR = 0; 
          SM$GROUPID = CMM$AGR(0);  # ALLOCATE GROUP ID FOR MOVE       #
          P<MOVETBL> = CMM$ALF(31, 0, SM$GROUPID);
          P<BASICTABLE> = BASCPTR;
          BASC$GROUPID[BASTABIND] = SM$GROUPID; 
          BASCADDR[BASTABIND] = P<MOVETBL>; 
               STDNO; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC SETCO10;
          PROC SETCO10; 
          BEGIN IF RECORDFLAG THEN STDYES;
                ENDPTR = 0; 
                SM$GROUPID = CMM$AGR(0);  # ALLOCATE GROUP ID          #
                P<EVALDATA> = CMM$ALF(7, 0, SM$GROUPID);
          P<BASICTABLE> = BASCPTR;
                BASCADDR[BASTABIND] = P<EVALDATA>;
                BASC$GROUPID[BASTABIND] = SM$GROUPID; 
                EVALFWA = P<EVALDATA>;  # SAVE FWA OF 1ST EVALUATE TABL#
                STDYES; 
          END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T M O V E                                                    #
#                                                                      #
#     *SETMOVE* IS CALLED FROM SYNGEN IF A *MOVE* CLAUSE HAS BEEN      #
#     ENCOUNTERED IN A *STORE* OR *MODIFY* DIRECTIVE.  IT CHECKS TO    #
#     MAKE SURE IT"S THE FIRST *MOVE* IN THE DIRECTIVE AND ALLOCATES   #
#     SPACE FOR A *MOVE* TABLE, SAVING ITS ADDRESS IN THE CURRENT      #
#     BASIC TABLE ENTRY.                                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETMOVE;
      PROC SETMOVE; 
      BEGIN 
      RECYES;                      # DON"T DO ANYTHING IF RECORDING    #
      P<BASICTABLE> = BASCPTR;     # POSITION TO BASIC TABLE ENTRY     #
      IF BASCMOVADDR[BASTABIND] NQ 0   # IF NOT FIRST *MOVE* CLAUSE    #
      THEN
        BEGIN 
        DIAG (391);                # ONLY ONE *MOVE* CLAUSE ALLOWED    #
        STDNO;                     # ERROR EXIT                        #
        END 
  
      P<MOVETBL> = CMM$ALF (31, 0, SM$GROUPID);  # ALLOC *MOVE* TABLE  #
      BASCMOVADDR[BASTABIND] = P<MOVETBL>;   # SAVE ITS ADDR IN BASICTB#
      ENDPTR = 0;                  # INDEX TO *MOVETBL* ENTRY          #
      STDYES;                      # SUCCESSFUL RETURN                 #
      END                          # PROC *SETMOVE*                    #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC SETPOIN;
      PROC SETPOIN; 
      BEGIN 
          IF RECORDFLAG  THEN STDNO;
          IF MOVEFILEPASS          # IF MOVE CAUSES A FILEPASS         #
          THEN
            BEGIN 
            FILEPASS = TRUE;
            END 
  
               SM$GROUPID = 0;     # INDICATE NO CMM GROUP ID ALLOCATED#
                STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
