*DECK DELUPSYN
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC DELUPSYN;
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     CHKDIU                       VALIDITY CHECKS FOR DEL/INS/UPD     #
#     CHKSMR                       VALIDITY CHECKS FOR STORE/MOD/REM   #
#     FLGERR                       SETS *KEYERRFLG* TRUE               #
#     FONDKEY                      CHECKS TAHT SOME KEY WAS FOUND      #
#     FRECNAM                      FLAGS RECORDNAME                    #
#     PERM                         SET FLAGS FOR INS/UPD/DEL SYNTAX    #
#     SAVDATA                      BUILD ATTRIBUTE TABLE FOR AREA ITEM #
#     SAVEKEY                      FLAG SET FOR KEY LITERAL            #
#     SAVEUSI                      SAVES *USING* SEARCH KEY            #
#     SETFROM                      SETS THE *FROM* OPTION              #
#     SETPV                        SET PASS/VETO FLAGS                 #
#     SETUSING                     SET FLAGS FOR *USING*               #
#     SETUSISET                    SET FLAGS FOR *SETTING* WITH *USING*#
#     SETUSI                       SET FLAGS FOR *USING*               #
#     STKEY                        STORE ATTRIBUTES FOR KEY IN BASICTBL#
#     TEMPONLY                     SETS TYPEALOW FOR DEFINED ITEMS ONLY#
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      XREF ITEM ANYAREAITEM B;     # TRUE IF *SETTING* OR *SMMOVE* LIST#
                                   # CONTAINS AN AREA ITEM             #
      XREF ITEM SEARCHKEY B;       # TRUE IF SEARCH KEY FOUND          #
  
      XREF ITEM AREATBLPTR   I;    # PTR TO HEAD OF CHAIN OF AREATABLES#
      DEF TABLESIZE#30#;   # SIZE OF ATTRIBTABLE - 1 #
      ITEM CURTABLE I = 0, # USED FOR ATTRIB ARRAY LOC #
           AINDEX   I = TABLESIZE;
      BASED ARRAY ATTRIBTABLE [TABLESIZE];
                BEGIN 
                    ITEM  ATTRIB; 
                    ITEM  ATYPE     U(0,0,3); 
                    ITEM  AEDIT     B(0,3,1); 
                    ITEM  AFCHAR    U(0,4,4); 
                    ITEM  ATCHAR    U(0,8,4); 
                    ITEM  ACHARLG   U(0,12,12);  # LENGTH IN CHARS     #
                    ITEM  AFROMADDR I(0,24,18); 
                    ITEM  ATOADDR   I(0,42,18); 
                          ITEM ACVTCD     I(0,0,6);     # SECOND WORD # 
                          ITEM ASTACKADD  I(0,6,18);
                          ITEM AADDFROM   I(0,24,18); 
                          ITEM AADDRTO    I(0,42,18); 
          ITEM AAKEY B(0,0,1); #THIRD WORD# 
          ITEM AKEYEXCL B(0,1,1);  # TRUE IF PART/ALL OF EXCLUDED KEY  #
          ITEM AALTKEY B(0,2,1);
          ITEM APRMAJKEY B(0,4,1);   # TRUE IF PRIMARY MAJOR KEY       #
          ITEM AALTMAJKEY B(0,5,1);  # TRUE IF ALTERNATE MAJOR KEY     #
          ITEM ATOLNG I(0,12,12); 
          ITEM AATTRIB I(0,6,18);                                       000870
          ITEM ARECDORD U(0,27,12);  # RECORD ORDINAL IF CDCS AREA ITEM#
                                     # 1 IF CRM AREA ITEM, ELSE 0      #
          ITEM AITEMORD U(0,39,15);  # ITEM ORD IF CDCS DBI, ELSE 0    #
          ITEM DAREAORD U(0,54, 6);  # ORDINAL TO ADDRESS OF AREA TABLE#
                                     # IN ARRAY -SAVDAREA-             #
                END 
      BASED ARRAY ATTRIB2;         # ATTRIBUTES USED FOR CONVERT       #
        BEGIN 
        ITEM TWPOS I(0,18,18);     # ADDRESS OF VALUE                  #
        END 
      XREF ITEM CURREG B;          # TRUE IF CURRENT-REGISTER          # QU3A334
      XREF ITEM CURRENTLFPTR I;    # POINTER TO ENTRY OF CURRENT LF    #
      XREF ITEM DESLIST I;         # DESCRIBE LIST PTR FOR CURRENT LF  #
      ITEM DIUKEY       B;         # TRUE IF DEL,INS,OR UPD KEY        #
      ITEM FOUNDALT     I;         # COUNT OF NUMBER OF ALT KEYS FOUND #
      ITEM FOUNDKEY     B;         # TRUE IF SOME KEY WAS FOUND        #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* OR *KEY IN* FIT #
      XREF ITEM FRMLFN C(7);       # LFN OF -FROM- OR -KEY IN- FILE    #
      ITEM I            I;         # SCRATCH TEMPORARY                 #
      ITEM KEYERRFLG    B;
      ITEM OVERLAPKEY B;           # TRUE IF DESTINATION OVERLAPS KEY  #
      XREF ITEM OLDSEARCH    B;    # TRUE IF PREVIOUS BASIC TBL DIRECTI#
      XREF ITEM RECNAM I;          # RECORD DIRECTORY WORD ADDRESS     #
      XREF ITEM RO           B;    # TRUE IF *QU,RO.*  ELSE FALSE      #
      XREF ITEM SAVEDTYPE I;       # DATA TYPE ON *KEY* DIRECTIVE      #
      XREF ITEM SAVELFNAME   I; 
      XREF ITEM SM$GROUPID   I;    # GROUP ID FOR CURRENT SYNTAX STUFF #
      XREF ITEM TARGETAREA   I;    # PTR TO AREA TO UPDATE             #
      ITEM TEMP         I;
      XREF ITEM TEMPTBLPTR   I; 
      XREF ITEM UPDATEAREA   B;    # TRUE IF UPDATING AN AREA          #
      XREF ITEM UPDATING     B;    # TRUE IF DOING ANY UPDATING        #
      XREF ITEM UPDKEYOP     B; 
      XREF ITEM UPDTEMP      B;    # TRUE IF UPDATING A TEMPORARY ITEM #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC LFNLOOKUP;         # CHECK IF THIS LFN IS KNOWN        #
      XREF PROC LINKNEWLFN;        # LINK A NEW ENTRY INTO LFNLIST     #
      XREF FUNC SAVATTR I;
      XREF PROC RECNO;
      XREF PROC RECYES; 
      XREF PROC SETSRCH;
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
 # THIS PROC GOES TO STDNO IF BASCADDR = 0 FOR INSERT OR DELETE # 
      XDEF PROC CHKDIU; 
 PROC CHKDIU;  BEGIN
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
      P<BASICTABLE> = BASCPTR;     # LCURRENT BLOCK OF BASIC TABLE     #
      IF BASCFROM[BASTABIND]       # IF FROM FILE                      #
        AND NOT BASCUSING[BASTABIND]  # AND NOT *USING*                #
      THEN
        BEGIN 
        DIAG(801);       # FROM FILE ALLOWED ONLY WITH USING CLAUSE    #
        STDNO;
        END 
       IF UPDATING THEN            # UPDATE OPERATION                  #
        BEGIN 
        IF TEMPTBLPTR NQ 0 THEN    # SET AREA TABLE TO AREA TO BE      #
                                   # UPDATED.                          #
          BEGIN 
          P<AREA$TABLE> = TEMPTBLPTR; 
          END 
        ELSE
          BEGIN 
          SPAREATABLE;
          END 
        END 
      IF DIUKEY                    # IF DEL,INS,OR UPD A KEY           #
      THEN
        BEGIN 
        IF AT$FITFO EQ FOAK 
          AND BASCODE[BASTABIND] EQ INSTCODE  # INSERT KEY             #
        THEN
          BEGIN 
          DIAG(223);               # AK FILE CANNOT HAVE KEY SPECIFY   #
          STDNO;
          END 
        DAREAORD[2] = DATANAMEBASE;  # ORDINAL TO ADDR OF AREA TABLE   #
        ARECDORD[2] = DATARECDORD; # RECORD ORDINAL IF *OF RECORD*     #
      END 
      IF KEYERRFLG  THEN STDNO; 
      IF NOT BASCTEMP [BASTABIND]  THEN 
      REFERFILE = O"77";   #SET WRITE FLAG FOR AREA FILE #
                                   # SAVE CMM GROUP ID FOR DIRECTIVE   #
      SM$GROUPID = 0;              # INDICATE NO CMM GROUP ID ALLOCATED#
      IF NOT UPDTEMP THEN          # AREA FILE UPDATE                  #
        BEGIN 
        UPDATING = TRUE;
        END 
      I = BASCODE [BASTABIND];
      IF NOT ( I EQ INSUCODE  OR   I EQ INSTCODE ) THEN                 008550
        BEGIN 
        RECNAM = 0;                # BGINIT USE 1ST RECORD DESCR       #
        END 
      # ALLOW INSERT ONLY ON SEQUENTIAL FILE #
      IF NOT BASCTEMP [BASTABIND]  THEN BEGIN 
      IF TEMPTBLPTR NQ 0 THEN      # NOT A LITERAL ITEM                #
        BEGIN 
        IF AT$FITFO EQ FOSQ                                              BASICSY
          AND (I NQ INSTCODE                                             BASICSY
            AND I NQ INSUCODE)
        THEN                                                             BASICSY
          BEGIN 
          DIAG (202); 
          UPDATING = FALSE; 
          STDNO;
          END 
        END 
      END 
      IF I EQ UPDCODE   THEN  NEXTXMISSN = TRUE;
      IF BASCADDR [BASTABIND] NQ 0  THEN STDYES;                        006160
      IF (I EQ UPDCODE)  OR  (I EQ DELTCODE)  AND IFFLAG  THEN          006180
         BEGIN
        FILEPASS = TRUE;
        STDYES;               END                                       006220
      IF AT$FITFO EQ FOAK                                                BASICSY
        AND (I EQ INSTCODE                                               BASICSY
          OR I EQ INSUCODE)                                              BASICSY
      THEN                                                               BASICSY
        BEGIN 
        STDYES; 
        END 
      UPDATING = FALSE; 
      DIAG (192); 
      STDNO;  # ERROR FOR ANY OTHER WITH NO PARAMS #                    006230
 END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C H K S M R                                                      #
#                                                                      #
#     *CHKSMR* IS CALLED FROM SYNGEN TO MAKE THE FINAL VALIDITY CHECKS #
#     ON THE *STORE*, *MODIFY*, AND *REMOVE* DIRECTIVES.  THESE INCLUDE#
#     CHECKS FOR AREA IN USE, SEARCH KEY FOUND, SUFFICIENT PARAMETERS, #
#     AND LEGAL USE OF SEQUENTIAL FILES.                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC CHKSMR; 
      PROC CHKSMR;
      BEGIN 
      RECYES;                      # NO ACTION IF RECORDING            #
  
      P<BASICTABLE> = BASCPTR;     # CURRENT BASIC TABLE ENTRY         #
      I = BASCODE[BASTABIND];      # FOR EASY REF TO DIRECTIVE CODE    #
      IF TEMPTBLPTR EQ 0           # IF NO AREA ISOLATED               #
      THEN
        BEGIN 
        IF ANYAREAITEM             # IF DIRECTIVE MENTIONS AREA ITEM   #
        THEN
          BEGIN 
          DIAG (341);              # NO TARGET AREA                    #
          UPDATING = FALSE; 
          STDNO;                   # ERROR EXIT                        #
          END 
        END 
      ELSE                         # IF AREA IN USE                    #
        BEGIN 
        P<AREA$TABLE> = TEMPTBLPTR;  # POSITION TO ITS TABLE           #
        END 
  
      IF NOT SEARCHKEY             # IF A SEARCH KEY WAS NOT FOUND     #
      THEN
        BEGIN 
        IF I EQ STORCODE           # IF DIRECTIVE IS *STORE*           #
          OR I EQ STRSCODE         # OR *STORE SETTING*                #
        THEN
          BEGIN 
          IF NOT (AT$FITFO EQ FOAK # IF NEITHER AK                     #
            OR (AT$FITFO EQ FOSQ   # NOR UNSORTED SEQUENTIAL           #
              AND NOT AT$SORTSEQ))
          THEN
            BEGIN 
            DIAG (394);            # SEARCH KEY MISSING                #
            STDNO;                 # ERROR EXIT                        #
            END 
          IF BASCMOVADDR[BASTABIND] EQ 0   # IF NEITHER *MOVE* CLAUSE  #
            AND NOT BASCSET[BASTABIND]     # NOR *SETTING* CLAUSE      #
                                           # PRESENT                   #
            AND AT$FITFO NQ FOAK   # AND NOT AN AK FILE                #
          THEN
            BEGIN 
            DIAG (398);            # INSUFFICIENT PARAMETERS           #
            STDNO;                 # ERROR EXIT                        #
            END 
          END                      # *STORE (SETTING)* IF              #
  
        ELSE
          BEGIN 
          IF I EQ MODCODE          # IF DIRECTIVE IS *MODIFY*          #
          THEN
            BEGIN 
            IF ANYAREAITEM         # AND IF IT CONTAINS AREA ITEMS     #
            THEN
              BEGIN 
              IF NOT IFFLAG        # IF NOT PRECEDED BY *IF*           #
              THEN
                BEGIN 
                DIAG (394);        # SEARCH KEY MISSING                #
                STDNO;             # ERROR EXIT                        #
                END 
              END 
            ELSE                   # IF TEMPORARIES ONLY               #
              BEGIN 
              UPDTEMP = TRUE;      # FLAG FOR UPDATE OF TEMPS          #
              UPDATING = FALSE; 
              BASCTEMP[BASTABIND] = TRUE;  # FLAG FOR *USINGEX*        #
              END 
            IF NOT BASCSET[BASTABIND]  # IF NEITHER *SETTING*          #
              AND BASCMOVADDR[BASTABIND] EQ 0  # NOR *MOVE* CLAUSE     #
            THEN
              BEGIN 
              DIAG (398);          # INSUFFICIENT PARAMETERS           #
              STDNO;               # ERROR EXIT                        #
              END 
            END                    # *MODIFY* IF                       #
  
          ELSE
            BEGIN 
            IF I EQ REMCODE        # IF DIRECTIVE IS *REMOVE*          #
              AND NOT IFFLAG       # AND NOT PRECEDED BY *IF*          #
            THEN
              BEGIN 
              DIAG (394);          # SEARCH KEY MISSING                #
              STDNO;               # ERROR EXIT                        #
              END 
            END                    # *REMOVE* IF                       #
          END 
        END                        # NOT *SEARCHKEY*                   #
  
      ELSE                         # IF SEARCH KEY FOUND               #
        BEGIN 
        IF BASCODE[BASTABIND] EQ MODUCODE  # IF *MODIFY USING*         #
          AND NOT BASCSET[BASTABIND]       # WITH NO *SETTING*         #
          AND BASCMOVADDR[BASTABIND] EQ 0  # AND NO *MOVE* CLAUSE      #
        THEN
          BEGIN 
          DIAG (398);              # INSUFFICIENT PARAMETERS           #
          STDNO;                   # ERROR EXIT                        #
          END 
        END                        # *SEARCHKEY* TRUE                  #
      IF ( BASCODE[BASTABIND] EQ STORCODE      # IF *STORE*            #
         OR BASCODE[BASTABIND] EQ STRSCODE)    # OR *STORE SETTING*    #
         AND (BASCMOVADDR [BASTABIND] EQ 0)    # NO *MOVE* CLAUSE      #
      THEN
        BEGIN 
        BASCTEMP[BASTABIND] = FALSE;      # FLAG FOR CTL40  *S/M/R*    #
        END 
  
      SM$GROUPID = 0;              # CLEAR CMM GROUP ID                #
      IF NOT BASCTEMP[BASTABIND]   # IF NOT ONLY TEMPS                 #
      THEN
        BEGIN 
        REFERFILE = O"77";         # SET WRITE FLAG FOR AREA FILE      #
        P<FIT> = LOC(AT$AFITPOS); 
        IF AT$FITFO EQ FOSQ        # IF ON A SEQUENTIAL FILE           #
          AND TEMPTBLPTR NQ 0      # AND NOT A LITERAL ITEM            #
          AND (I EQ REMCODE        # AND EITHER A *REMOVE*             #
            OR I EQ REMUCODE
            OR ((I EQ MODCODE      # OR A *MODIFY*                     #
              OR I EQ MODUCODE) 
              AND (FITRT NQ RTF    # ON NON-FIXED-LENGTH               #
                AND FITRT NQ RTW)))  # AND NON-W-TYPE RECORDS          #
        THEN
          BEGIN 
          DIAG (399);              # MODS BY KEY ILLEGAL ON SEQ FILE   #
          UPDATING = FALSE; 
          STDNO;                   # ERROR EXIT                        #
          END 
        END 
      STDYES;                      # SUCCESSFUL EXIT                   #
      END                          # PROC *CHKSMR*                     #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC FLGERR; 
 PROC FLGERR;   BEGIN 
 # THIS PROC SETS KEYERRFLG TO INDICATE THAT THE WORD FOLLOWING THE  #
 # VERB MUST BE PART OF THE DIRECTIVE,NOT A NEW DIRECTIVE            #
      KEYERRFLG = TRUE; 
      STDNO;
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
 # CHECK THAT KEY FLAG IS SET FOR DATA ATTRIB  #
      XDEF PROC FONDKEY;
 PROC FONDKEY;  BEGIN 
      IF RECORDFLAG THEN
        BEGIN 
        STDYES; 
        END 
      IF ANYAREAITEM               # IF LIST CONTAINS AREA ITEM        #
      THEN
        BEGIN 
        IF TEMPTBLPTR NQ 0 THEN    # SET AREA TABLE TO AREA TO BE      #
                                   # UPDATED.                          #
          BEGIN 
          P<AREA$TABLE> = TEMPTBLPTR; 
          END 
        ELSE                       # NO TARGET AREA--ERROR             #
          BEGIN 
          DIAG (341); 
          UPDATING = FALSE; 
          STDNO;
          END 
        END 
        P<BASICTABLE> = BASCPTR;   # LCURRENT BLOCK OF BASIC TABLE     #
                                   # SAVE CMM GROUP ID FOR DIRECTIVE   #
        IF NOT FOUNDKEY THEN
        BEGIN                                                            XXXX 
          IF BASCODE[BASTABIND] NQ INSUCODE THEN
          BEGIN 
          IF FOUNDALT GR 1         # IF MORE THAN 1 ALT KEY SPECIFIED  #
          THEN
            BEGIN 
            UPDATING = FALSE; 
            STDNO;                 # TAKE ERROR EXIT                   #
            END 
          IF BASCUSING[BASTABIND] AND FOUNDALT EQ 1 THEN
          BEGIN BASCUPDALT[BASTABIND] = TRUE; 
                STDYES; 
          END 
          END 
        IF NOT ANYAREAITEM         # IF ONLY TEMPORARY ITEMS           #
        THEN
          BEGIN 
          BASCTEMP[BASTABIND] = TRUE; 
          UPDTEMP = TRUE; 
          UPDATING = FALSE; 
          END 
        ELSE
          BEGIN 
          IF (AT$FITFO NQ FOSQ                                           BASICSY
              OR AT$SORTSEQ)       #SORTED SEQUENTIAL                  # BASICSY
            AND (AT$FITFO NQ FOAK                                        BASICSY
              OR BASCODE[BASTABIND] NQ INSUCODE)  #INSERT USING        # BASICSY
          THEN                                                           BASICSY
            BEGIN 
            UPDATING = FALSE; 
            STDNO;
            END 
          END 
          STDYES; 
        END                                                              XXXX 
      ELSE
        BEGIN 
        IF OVERLAPKEY              # IF DESTINATION OVERLAPS KEY       #
        THEN
          BEGIN 
          DIAG(208);               # DESTINATION OVERLAPS KEY FIELD    #
          STDNO;                   # ERROR EXIT                        #
          END 
        STDYES; 
        END 
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC FRECNAM;                                                005620
 PROC FRECNAM;    BEGIN                                                 005630
 # THIS PROC CHECKS FOR A LEGAL RECORDNAME AND SAVES ITS ADDRESS #      005640
      RECYES; 
      IF RCTYPE [0] NQ 7  THEN STDNO; 
      KEYERRFLG = FALSE;
      P<BASICTABLE> = BASCPTR;     # LCURRENT BLOCK OF BASIC TABLE     #
      BASCREC [BASTABIND] = TRUE; 
      RECNAM = DIRWORDADDR; 
      STDYES;                                                           005670
 END                                                                    005680
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC PERM; 
 PROC PERM;       # CHECK MODIFY PERMISSN,SET SEARCHFLAG #
         BEGIN
      DIUKEY = FALSE;              # NEW DEL,INS,OR UPD DIRECTIVE      #
      KEYERRFLG = FALSE;
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      ANYAREAITEM = FALSE;         # INITIAL ASSUMPTION THAT NO AREA   #
                                   # ITEMS IN USING LIST               #
      UPDATING = TRUE;
      FOUNDKEY = FALSE;            # INITIALIZE TO -NO KEY FOUND YET-  #
      FOUNDALT = 0;                                                      XXXX 
      OVERLAPKEY = FALSE; 
      SEARCHKEY = FALSE;           # SEARCH KEY NOT FOUND YET          #
      AINDEX = TABLESIZE;          # IDX INTO LIST OF *SETTING/USING*  #
                                   # ELEMENTARY ENTRIES                #
      IF CLXWRD[0] EQ O"1126" THEN  #IF UPDATE                         #
        BEGIN 
        STDYES;                    #UPDATE GOT BASICTAB IN SET40       #
        END 
      OLDSEARCH = SEARCHFLAG;      # FALSE IF FIRST 4X CMD IN XMISSN   #
      SETSRCH;
                   STDYES;
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
 # SET UP TABLE FOR DATANAME ATTRIBUTES        #
      XDEF PROC SAVDATA;
          BASED ARRAY ADDR; ITEM ADDRE U(,,60); 
 PROC SAVDATA;  BEGIN 
      ITEM K;                      # FIRST CHAR POS OF THE KEY         #
      ITEM IJK;                    # LAST  CHAR POS OF THE KEY         #
      ITEM J;                      # FIRST CHAR POS OF THE ITEM        #
      ITEM KJI;                    # LAST  CHAR POS OF THE ITEM        #
  
# IN READ-ONLY MODE, AN UPDATE IS ALLOWED ON AN AREA-ITEM ONLY WHILE   #
# RECORDING. ALL OTHER UPDATES ARE ALLOWED IN READ-ONLY MODE.          #
  
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
  
        IF DESITM                  # IF DATANAME IS DESCRIBED ITEM     #
        THEN
          BEGIN 
          DIAG (418);              # ILLEGAL TO MODIFY DESCRIBED ITEM  #
          STDNO;
          END 
  
        P<BASICTABLE> = BASCPTR;   # CURRENT BASIC TABLE ENTRY         #
        IF (BASCODE[BASTABIND] EQ STORCODE     # IF *STORE*            #
          OR BASCODE[BASTABIND] EQ STRSCODE)   # OR *STORE SETTING*    #
          AND (  SEARCHKEY                     # AND KEY WAS FOUND     #
               OR  NOT AKEYITEM  )             # OR A NON-KEY ITEM     #
        THEN
          BEGIN 
          BASCTEMP[BASTABIND] = TRUE;          # ASSUME IT IS TEMP ITEM#
          END 
        IF AREAITM                 # UPDATE OF AREA FILE               #
        THEN
          BEGIN 
          IF RO                    # IF IN READ-ONLY MODE              #
          THEN
            BEGIN 
            DIAG (308);            # AN AREA ITEM CAN"T BE THE TARGET  #
                                   # OF A *SETTING* IN READ-ONLY MODE  #
            STDNO;
            END 
          ANYAREAITEM = TRUE;      # USING LIST CONTAINS AREA ITEM     #
          IF TEMPTBLPTR NQ 0 THEN  # SET UP AREA TABLE TO BE USED.     #
            BEGIN 
            P<AREA$TABLE> = TEMPTBLPTR; 
            END 
          ELSE
            BEGIN 
            DIAG (341);            # NO AREA IS IN USE--ERROR          #
            UPDATING = FALSE; 
            STDNO;
            END 
          END 
      IF AKEYITEM THEN             # IF THIS ITEM IS THE KEY           #
        BEGIN 
        IF BASCODE[BASTABIND] GQ STORCODE  # IF *STORE/MOD/REM*        #
        THEN
          BEGIN 
          IF BASCODE[BASTABIND] EQ STRSCODE  # IF *STORE SETTING*      #
          THEN
            BEGIN 
            SEARCHKEY = TRUE;      # FLAG THAT STORAGE KEY FOUND       #
            END 
          ELSE                     # EITHER *MODIFY* OR *REMOVE*       #
            BEGIN 
            BASCMODKEY[BASTABIND] = TRUE;  # PRIM KEY IS TO BE MODIF   #
            END 
          END 
        ELSE
          BEGIN 
        IF FOUNDKEY AND            # IF ANOTHER KEY ALREADY FOUND      #
           DIRLEXID NQ O"102" THEN  # NOT DELETE, HENCE INSERT OR UPDAT#
          BEGIN 
          DIAG(208);               # DESTINATION OVERLAPS KEY          #
          STDNO;                   # ERROR EXIT                        #
          END 
        ELSE                       # IF FIRST KEY ENCOUNTERED          #
          BEGIN 
          FOUNDKEY = TRUE;         # SET FLAG SAYING KEY FOUND         #
          END 
          END 
        END 
      IF ALTKEYITEM THEN FOUNDALT=FOUNDALT+1; 
      IF CURREG                    # IF CURRENT-REGISTER               # QU3A334
        OR DESITM                  # IF DESCRIBED ITEM                 # QU3A334
        OR (NOT AREAITM            # IF NOT AREA ITEM                  # QU3A334
          AND BASCODE[BASTABIND] LS STORCODE   # NOT A *STORE/MOD/REM* #
          AND BASCODE[BASTABIND] NQ UPDUCODE)  # NOT UPDATE USING      # QU3A334
      THEN                                                               QU3A334
        BEGIN                                                            QU3A334
          DIAG (196);  STDNO;  END                                      008660
      IF AREAITM                   #IF AREA ITEM                       # BASICSY
        AND (AT$FITFO NQ FOSQ      #AND NOT SEQUENTIAL                 # BASICSY
          OR AT$SORTSEQ)           #OR SORTED SEQUENTIALLY             # BASICSY
        AND DIRLEXID NQ O"102"     #NOT DELETE -< UPDATE OR INSERT     # BASICSY
        AND NOT AT$KEYEXCL         #AND KEY IN RECORD                  # BASICSY
        AND NOT AKEYITEM           #AND NOT THE KEY ITSELF             #
      THEN                                                               BASICSY
        BEGIN 
        P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESCRIPTION TABLE #
        J = DATAWORDADDR * 10 + DATACHARPOS;  # FIRST CHAR POS OF ITEM #
        KJI = J + DATALENG - 1;               # LAST  CHAR POS OF ITEM #
        K = KT$WPOS[DATARECDORD] * 10 + KT$CPOS[DATARECDORD]; 
                                              # FIRST CHAR POS OF KEY  #
        IJK = K + KT$LENGTH[DATARECDORD] - 1; # LAST  CHAR POS OF KEY  #
        IF ((J GQ K  AND  J LQ IJK)    # IF ITEM AND KEY OVERLAY       #
          OR (K GQ J  AND  K LQ KJI)) 
          AND BASCODE[BASTABIND] NQ UPDUCODE  # AND NOT UPDATE USING   #
        THEN
          BEGIN 
          OVERLAPKEY = TRUE;       # DESTINATION OVERLAPS KEY          #
          BASCMODKEY[BASTABIND] = TRUE;  # PRIM KEY WILL BE MODIFIED   #
          END 
        END 
      IF AINDEX GQ TABLESIZE - 1   THEN BEGIN 
        CURTABLE = CMM$ALF(TABLESIZE + 1, 0, SM$GROUPID); 
          IF BASCADDR[BASTABIND] EQ 0 THEN
             BASCADDR[BASTABIND] = CURTABLE;
           ELSE ATTRIB [TABLESIZE] = CURTABLE;
        AINDEX= 0;
      END 
      P<ATTRIBTABLE> = CURTABLE;
             ATYPE[AINDEX]=2;  # USED BY CONVERT #                      001800
             ATCHAR[AINDEX]=DATACHARPOS;
             ACHARLG[AINDEX]=DATALENG;
             ARECDORD[AINDEX+2] = DATARECDORD;
             AITEMORD[AINDEX+2] = DATAITEMORD;
          IF AREAITM               # IF ITEM CAME FROM THE AREA FILE   # QU3A094
          THEN                                                           QU3A094
            BEGIN                                                        QU3A094
            DATANAMEPTR = SAVATTR;                                       QU3A094
            END                                                          QU3A094
          IF NOT INDICED THEN 
          BEGIN P<DESATT1> = DATANAMEPTR; 
                I = DATACHARPOS * 6;
                IF I NQ DBITPOS[0] OR DATAWORDADDR NQ DEWPOS[0] THEN
                BEGIN IF NOT AREAITM THEN 
                      BEGIN P<ADDR> = P<DESATT1>; 
                            P<DESATT1> = CMM$ALF(7, 0, SM$GROUPID); 
                            DATANAMEPTR = P<DESATT1>; 
                            FOR TEMP = 0 STEP 1 UNTIL 6 DO
                              DDWORD0[TEMP]=ADDRE[TEMP];
                      END 
                      DEWPOS[0] = DATAWORDADDR; 
                      DBITPOS[0] = I; 
                END 
          END 
          ATOADDR [AINDEX] = DATANAMEPTR; 
           CVCODE:   # STORE CONVERT CODE #                             001870
           ACVTCD [AINDEX + 1] = DATATYPE + 1;
          AAKEY[AINDEX+2] = AKEYITEM; 
          IF ALTKEYITEM THEN
          BEGIN AALTKEY[AINDEX+2] = TRUE; 
                ATOLNG[AINDEX+2] = DATALENG;
          END 
      IF INDICED  THEN BEGIN
      ASTACKADD [AINDEX + 1] = INDCTBLOC; 
          AATTRIB[AINDEX+2] = DATANAMEPTR;                              000910
          ATYPE[AINDEX]=6; END
      AADDRTO [AINDEX + 1] = DATANAMEBASE;
      IF AT$FITFO EQ FOAK                                                BASICSY
        AND AKEYITEM               # IF THIS IS THE PRIMARY KEY        #
        AND BASCODE[BASTABIND] EQ INSUCODE   # AND *INSERT USING*      #
      THEN                                                               BASICSY
          BEGIN DIAG(223); #AK FILE CANNOT HAVE KEY SPECIFY#             XXXX 
                STDNO;                                                   XXXX 
          END                                                            XXXX 
SAVD50: 
      AKEYEXCL[AINDEX + 2] = EXCLKEYITEM; 
      AINDEX = AINDEX + 3;
      IF AKEYITEM                  # KEY DOES NOT SET RECNAM           #
        OR (BASCODE[BASTABIND] NQ INSUCODE     # ONLY *INSERT* OR      #
          AND BASCODE[BASTABIND] NQ STRSCODE)  # *STORE* SETS *RECNAM* #
      THEN
        BEGIN 
        STDYES; 
        END 
      IF RECNAM NQ 0               # IF RECORD DESCRIPTION ALREADY SET #
      THEN
        BEGIN 
        IF RECNAM NQ DOMRECORDWA   # IF DATANAME NOT PART OF RECORD    #
        THEN
          BEGIN 
          DIAG (210);              # MULTIPLE RECORD DESCRIPTIONS      #
          STDNO;
          END 
        END 
      ELSE
        BEGIN 
        RECNAM = DOMRECORDWA;      # SAVE RECORD WORD ADDRESS          #
        END 
      STDYES; 
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC SAVEKEY;
 PROC SAVEKEY;    # SAVE KEY LITERAL IN ATTRIB TABLE   #
         BEGIN
      RECYES; 
      KEYERRFLG = FALSE;
      IF FIGLITDATA NQ 1  THEN STDNO;                                   006080
                STDYES; 
         END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V E U S I                                                    #
#                                                                      #
#     *SAVEUSI* IS CALLED DURING SYNGEN PROCESSING OF THE *USING*      #
#     CLAUSE WHEN IT HAS PICKED UP THE DATANAME SPECIFIED BY *USING* AS#
#     THE SEARCH KEY FOR THE *MODIFY* OR *REMOVE* DIRECTIVE. ITS JOB IS#
#     TO BUILD AN ELEMENTARY ENTRY FOR THE DATANAME IF IT IS A VALID   #
#     PRIMARY, ALTERNATE, OR MAJOR KEY, AND ADD IT TO THE              #
#     *USING/SETTING* LIST POINTED TO BY THE BASICTABLE.  UPON         #
#     SUCCESSFUL RETURN, *USIPTR* WILL POINT TO THE POSITION OF THE    #
#     SEARCH KEY WITHIN THE LIST, AND *SEARCHKEY* WILL BE SET TRUE TO  #
#     INDICATE THAT THE KEY HAS BEEN FOUND.                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVEUSI;
      PROC SAVEUSI; 
      BEGIN 
      RECYES;                      # DON"T DO ANYTHING IF RECORDING    #
      IF RO                        # IF IN READ-ONLY MODE              #
      THEN
        BEGIN 
        DIAG (308);                # RO MODE LIMITS TARGETS TO TEMPS   #
        STDNO;
        END 
  
      IF NOT AREAITM               # SEE IF TEMPORARY ITEM             #000190
      THEN                                                              000200
        BEGIN                                                           000210
        DIAG (393);                # MUST BE AREA KEY                  #000220
        STDNO;                                                          000230
        END                                                             000240
      IF TEMPTBLPTR NQ 0           # IF AREA IN USE                    #
      THEN
        BEGIN 
        P<AREA$TABLE> = TEMPTBLPTR;  # POSITION TO IT                  #
        END 
      ELSE                         # IF NO AREA IN USE,                #
        BEGIN 
        DIAG (341);                # INVALID AREA NAME SPECIFIED.      #
        UPDATING = FALSE; 
        STDNO;
        END 
  
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASICTBL ENTRY#
      IF AINDEX GQ TABLESIZE - 1   # IF INDEX PAST END OF              #
                                   # *USING/SETTING* LIST              #
      THEN
        BEGIN                      # ALLOCATE ANOTHER BLOCK TO LIST    #
        CURTABLE = CMM$ALF (TABLESIZE+1, 0, SM$GROUPID);
        IF BASCADDR[BASTABIND] EQ 0  # IF THIS IS FIRST ENTRY IN LIST, #
        THEN
          BEGIN 
          BASCADDR[BASTABIND] = CURTABLE;  # POINT BASICTABLE TO IT.   #
          END 
        ELSE                       # IF THIS IS EXTENSION OF LIST,     #
          BEGIN 
          ATTRIB[TABLESIZE] = CURTABLE;  # POINT CURRENT LAST WORD OF  #
                                         # LIST TO IT.                 #
          END 
        AINDEX = 0;                # RESET LIST INDEX.                 #
        END 
      P<ATTRIBTABLE> = CURTABLE;   # POSITION TO NEW BLOCK OF          #
                                   # *USING/SETTING* LIST              #
      USIPTR = CURTABLE + AINDEX;  # SAVE POSN OF KEY WITHIN LIST.     #
  
      IF AKEYITEM                  # IF THIS IS THE PRIMARY KEY,       #
      THEN
        BEGIN 
        AAKEY[AINDEX+2] = TRUE;    # OK, SET ITS FLAG.                 #
        END 
      ELSE
        BEGIN 
        IF ALTKEYITEM              # IF ALTERNATE KEY,                 #
        THEN
          BEGIN 
          AALTKEY[AINDEX+2] = TRUE;  # SET ITS FLAG,                   #
          ATOLNG[AINDEX+2] = DATALENG;   # AND SAVE ITS LENGTH AGAIN.  #
          BASCUPDALT[BASTABIND] = TRUE; 
          END 
        ELSE
          BEGIN 
          IF PMAJKEYITEM           # IF PRIMARY MAJOR KEY,             #
          THEN
            BEGIN 
            APRMAJKEY[AINDEX+2] = TRUE;  # SET ITS FLAG.               #
            END 
          ELSE
            BEGIN 
            IF AMAJKEYITEM         # IF ALTERNATE MAJOR KEY,           #
            THEN
              BEGIN 
              AALTMAJKEY[AINDEX+2] = TRUE;   # SET ITS FLAG,           #
              ATOLNG[AINDEX+2] = SIZEALTKEY; # AND SAVE SIZE OF ALTERN #
              BASCUPDALT[BASTABIND] = TRUE; 
              END 
            ELSE                   # IF NOT A KEY AT ALL               #
              BEGIN 
              DIAG (393);          # *USING* MUST SPECIFY A KEY        #
              STDNO;
              END 
            END 
          END 
        END 
      SEARCHKEY = TRUE;            # VALID SEARCH KEY HAS BEEN FOUND   #
  
      ATCHAR[AINDEX] = DATACHARPOS;  # BEGINNING CHAR POSN OF ITEM     #
      ACHARLG[AINDEX] = DATALENG;  # ITEM LENGTH IN CHARACTERS         #
      DATANAMEPTR = SAVATTR;       # MAKE COPY OF ITEM"S ATTRIB TABLE  #
                                   # AND RETURN PTR TO IT.             #
      ATOADDR[AINDEX] = DATANAMEPTR;   # ADDRESS OF ATTRIB TABLE       #
      ACVTCD[AINDEX+1] = DATATYPE+1;   # ITEM TYPE FOR CONV PURPOSES   #
      AADDRTO[AINDEX+1] = DATANAMEBASE;  # ADDR OF BASE IF *ATOADDR*   #
                                         # IS RELATIVE                 #
      AKEYEXCL[AINDEX+2] = EXCLKEYITEM;  # TRUE IF PART/ALL OF EXCLUDED#
                                         # KEY                         #
      ARECDORD[AINDEX+2] = DATARECDORD;  # ITEM"S CDCS RECORD ORDINAL  #
      AITEMORD[AINDEX+2] = DATAITEMORD;  # ITEM"S CDCS ITEM ORDINAL    #
  
      IF INDICED                   # IF SUBSCRIPTED ITEM,              #
      THEN
        BEGIN 
        ATYPE[AINDEX] = 6;         # SIGNAL SINGLE TO SUBSCRIPTED CONV #
        ASTACKADD[AINDEX+1] = INDCTBLOC;   # ADDR OF INDEX TABLE       #
        AATTRIB[AINDEX+2] = DATANAMEPTR;   # ADDR OF ATTRIB TABLE      #
        END 
      ELSE                         # IF NOT SUBSCRIPTED                #
        BEGIN 
        ATYPE[AINDEX] = 2;         # SINGLE TO SINGLE ITEM CONVERSION  #
        P<DESATT1> = DATANAMEPTR;  # TO REFERENCE ATTRIB TABLE ITEMS   #
        DEWPOS[0] = DATAWORDADDR;  # ITEM"S RELATIVE WORD POSITION     #
        DBITPOS[0] = DATACHARPOS * 6;  # AND BIT POSN WITHIN THAT WORD #
        END 
      ANYAREAITEM = TRUE;          # AREA ITEM MENTIONED IN DIRECTIVE  #
      AINDEX = AINDEX + 3;         # INCREMENT TO NEXT ATTRIB ENTRY    #
      STDYES;                      # SUCCESSFUL RETURN TO SYNGEN       #
      END                          # PROC *SAVEUSI*                    #
      CONTROL EJECT;
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC SETFROM;
 PROC SETFROM;  BEGIN 
      ITEM EC;
      ITEM RC;
      KEYERRFLG = FALSE;
      RECYES;                      # -STDYES- IF RECORDING             #
  
      IF FROMKEYINFIT NQ 0         # IF ANOTHER FROM FILE              #
      THEN
        BEGIN 
        DIAG ( 370 );              # MULTIPLE *FROM* FILES NOT ALLOWED #
        STDNO;
        END 
      P<BASICTABLE> = BASCPTR;     # LCURRENT BLOCK OF BASIC TABLE     #
 # SAVES FILE NAME SPECIFIED IN FROM CLAUSE # 
      BASCFROM [BASTABIND] = TRUE;
      SAVELFNAME = 0; 
      B<0,ILFNLG[IFRO] * 6>SAVELFNAME = B<0,ILFNLG[IFRO] * 6>ILFN[IFRO];
      FRMLFN = ILFN[IFRO];         # KEEP LFN OF -FROM- FILE           #
      RC = 0; 
      LFNLOOKUP (RC);              # SEE IF LFN EXISTS. # 
      IF RC EQ 1 THEN              # NO MATCH FOUND. #
        BEGIN                      # LINK LFN INTO LFN LIST. #
        EC = 0;                    # EC = 0 MEANS THIS IS NOT # 
                                   # A CALL FROM SORT.                 #
        DESLIST = 0;               # FILE HAS NO DESCRIBE LIST         #
        LINKNEWLFN (EC);           # LINK LFN INTO LFN LIST            #
        END 
      P<LFNINFO> = CURRENTLFPTR;
      BASFITFROM[BASTABIND] = LOC(L$FITLOC);                             BASICSY
      FROMKEYINFIT = LOC(L$FITLOC); 
      STDYES; 
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC SETPV;
 PROC SETPV;     # SET PASS - VETO FLAGS #
         BEGIN
      P<BASICTABLE> = BASCPTR;     # LCURRENT BLOCK OF BASIC TABLE     #
    # IGNORE VETO - PASS IN BATCH MODE #
      IF RECORDFLAG OR (TERMINAL EQ 0)  THEN STDNO; 
             IF CLXWRD[0] EQ O"621" THEN   # LXID FOR PASS  # 
      BASCPASS [BASTABIND] = TRUE;
       ELSE BASCVETO [BASTABIND] = TRUE;
             STDNO; 
         END
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T S E T                                                      #
#                                                                      #
#     WHEN *SETTING* IS ENCOUNTERED DURING THE SYNGEN PROCESSING OF    #
#     A *STORE* DIRECTIVE, *SETSET* IS CALLED TO SET THE FLAGS         #
#     INDICATING A *SETTING* CLAUSE IS PRESENT.  THE CODE FOR THE      #
#     DIRECTIVE IS INCREMENTED TO INDICATE THAT *SETTING* WAS          #
#     SPECIFIED.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETSET; 
      PROC SETSET;
      BEGIN 
      RECYES;                      # DON-T DO ANYTHING IF RECORDING    #
      USINGFLAG = TRUE; 
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
      BASCSET[BASTABIND] = TRUE;   # INDICATE *SETTING* WAS SPECIFIED  #
                                   # REFLECT THE *SETTING* IN THE      #
                                   # DIRECTIVE CODE.                   #
      BASCODE[BASTABIND] = BASCODE[BASTABIND] + 1;
      IF DIRCODE NQ "Z" 
      THEN
        BEGIN 
        DIRCODE = DIRCODE + 1;
        END 
  
      STDYES;                      # SUCCESSFUL RETURN TO SYNGEN       #
      END                          # PROC *SETSET                      #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC  SETUSING;
 PROC SETUSING;   # SET FLAG FOR -USING- #
         BEGIN
      KEYERRFLG = FALSE;
      IF RECORDFLAG  THEN STDNO;
      P<BASICTABLE> = BASCPTR;     # LCURRENT BLOCK OF BASIC TABLE     #
      BASCUSING[BASTABIND] = TRUE;
      USINGFLAG = TRUE;                                                 007270
  # ADD 1 TO INDICATE USING # 
      BASCODE [BASTABIND] = BASCODE [BASTABIND] + 1;
      IF DIRCODE NQ "Z" 
      THEN
        BEGIN 
        DIRCODE = DIRCODE + 1;
        END 
             STDNO; 
         END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U S I                                                      #
#                                                                      #
#     WHEN *USING* IS ENCOUNTERED DURING THE SYNGEN PROCESSING OF A    #
#     *MODIFY* OR *REMOVE* DIRECTIVE, *SETUSI* IS CALLED TO SET THE    #
#     FLAGS INDICATING A *USING* CLAUSE IS PRESENT.  THE CODE FOR THE  #
#     CURRENT DIRECTIVE IS INCREMENTED TO INDICATE THE *USING* WAS     #
#     SPECIFIED.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETUSI; 
      PROC SETUSI;
      BEGIN 
      RECYES;                      # DON"T DO ANYTHING IF RECORDING    #
      USINGFLAG = TRUE; 
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
      BASCUSING[BASTABIND] = TRUE;  # INDICATE *USING* WAS SPECIFIED   #
                                   # REFLECT THE *USING* IN THE        #
                                   # DIRECTIVE CODE                    #
      BASCODE[BASTABIND] = BASCODE[BASTABIND] + 1;
      IF DIRCODE NQ "Z" 
      THEN
        BEGIN 
        DIRCODE = DIRCODE + 1;
        END 
  
      STDYES;                      # SUCCESSFUL RETURN TO SYNGEN       #
      END                          # PROC *SETUSI*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U S I S E T                                                #
#                                                                      #
#     WHEN *SETTING* IS ENCOUNTERED IN A *USING* CLAUSE, ALL NORMAL    #
#     *SETTING* FLAGS MUST SET EXCEPT THAT THE DIRECTIVE CODE MUST NOT #
#     BE INCREMENTED.                                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETUSISET;
      PROC SETUSISET; 
      BEGIN 
      RECYES;                      # DO NOTHING IF RECORDING           #
      P<BASICTABLE> = BASCPTR;     # CURRENT BLOCK OF BASIC TABLE      #
      BASCSET[BASTABIND] = TRUE;
      STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     PROC SPAREATABLE                                                 #
#                                                                      #
#     IF UPDATE AREA IN EFFECT, SET P<AREA$TABLE> TO THAT AREA TABLE   #
#     IF ONLY ONE AREA IN USE, SET P<AREA$TABLE> TO THAT AREA TABLE    #
#     ELSE, ERROR EXIT                                                 #
#                                                                      #
#----------------------------------------------------------------------#
  
        PROC SPAREATABLE; 
        BEGIN 
        IF UPDATEAREA THEN         # -UPDATE AREANAME WAS GIVEN.       #
          BEGIN 
          TEMPTBLPTR = TARGETAREA;
          P<AREA$TABLE> = TARGETAREA; 
          END 
        ELSE
          BEGIN 
                                   # LOOK THROUGH THE AREA TABLE CHAIN.#
                                   # IF THE FORWARD POINTER OF THE     #
                                   # FIRST AREA TABLE IS NON-ZERO, QUIT#
          P<AREA$TABLE> = AREATBLPTR; 
          P<AREA$TABLE> = AT$FORWARD[0];
          IF AT$FORWARD[0] EQ 0 THEN
                                   # ONLY ONE AREA--ASSUME THIS IS IT. #
            BEGIN 
            TEMPTBLPTR = P<AREA$TABLE>; 
            END 
  
          ELSE
            BEGIN 
            DIAG (345); 
            UPDATING = FALSE; 
            STDNO;
            END 
          END 
        END 
  
#----------------------------------------------------------------------#
  
  
  
  
 # THIS PROC GETS VALUE OF KEY FROM DATANAME AND SAVES IT FOR BASICBL#
      XDEF PROC STKEY;
 PROC STKEY;   BEGIN
                                   # UPDATE-KEY-OPERATION.  IF MORE    #
                                   # THAN ONE AREA IS ACTIVE AND THERE #
                                   # WAS NO -UPDATE AREANAME- DIRECTIVE#
                                   # THEN DIAGNOSE, SINCE THE AREA     #
                                   # CANNOT BE ISOLATED.               #
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
        DIUKEY = TRUE;             # A KEY IS BEING DEL,INS,OR UPD     #
        TEMPTBLPTR = 0; 
      IF AREAITM                   # IF AREA-ITEM                      # QU3A334
        OR CURREG                  # IF CURRENT-REGISTER               # QU3A334
        OR DESITM                  # IF DESCRIBED ITEM                 #
      THEN                                                               QU3A334
        BEGIN                                                            QU3A334
        DIAG (197);   STDNO;  END 
      IF KEYLIT NQ 0  THEN BEGIN
        DIAG (204);   STDNO;  END 
      P<BASICTABLE> = BASCPTR;     # CURRENT BLOCK OF BASIC TABLE      #
      IF OLDSEARCH                 # IF NOT 1ST BASIC TBL DIRECTIVE    #
        AND BASCODE[BASTABIND] EQ INSTCODE  # INSERT KEY               #
      THEN
        BEGIN 
        DIAG (359, "INSERT KEY");  #INSRT KEY NOT FIRST SAVED DIRECTIVE#
        STDNO;
        END 
      P<ATTRIBTABLE> = CMM$ALF(3, 0, SM$GROUPID); 
      BASCADDR [BASTABIND] = P<ATTRIBTABLE>;
      AFROMADDR [0] = DATAWORDADDR; 
      IF FIGLITDATA EQ S"DATANAME" THEN 
        AADDFROM [1] = DATANAMEBASE;
      AAKEY[2] = TRUE;             # PRIMARY KEY                       #
      ACHARLG [0] = DATALENG; 
      AFCHAR [0] = DATACHARPOS; 
      IF DATATYPE GQ 1             # IF NUMERIC, INTEGER, OR FIXED     #
        AND DATATYPE LQ 3 
      THEN
        BEGIN 
        IF DATANAMEPTR EQ 0        # IF NO ATTRIB TABLE                #
                                   # FOR EXAMPLE, LITERAL INTEGER      #
        THEN
          BEGIN 
          P<ATTRIB2> = CMM$ALF(2, 0, SM$GROUPID);  # ALLOCATE ATTRIB TB#
          TWPOS[0] = DATAWORDADDR;  # STORE ADDRESS OF VALUE           #
          DATANAMEPTR = LOC(ATTRIB2) - 1; 
          END 
        AFROMADDR[0] = DATANAMEPTR; 
        END 
      SAVEDTYPE = DATATYPE; 
      ATYPE [0] = 2;
      IF INDICED  THEN BEGIN
          ASTACKADD [1] = INDCTBLOC;
          ATYPE [0] = 4;  END                                           008530
      KEYLIT = BASCPTR; 
      B<0,18>KEYLIT = BASTABIND;
      STDYES; 
  END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
XDEF PROC TEMPONLY;  #-----------------------------------------------#
          PROC TEMPONLY;  BEGIN 
      RECNO;                       # RETURN TO STDNO IF RECORDING      #
      KEYERRFLG = FALSE;
      OLDTYPE = TYPEALOW;   # SAVE OLD TYPEALOW # 
                 TYPEALOW=2;  #VALUE TELLING THE SYNTAX ANALYZER
                                   THAT A DEFINED NAME MUST FOLLOW# 
                 STDNO; 
                     END
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
