*DECK SEMSMR
USETEXT  TEXPRES
USETEXT  TENVIRN
USETEXT  TCONVRT
USETEXT  TBASCTB
USETEXT  TSBASIC
USETEXT  TCMMDEF
USETEXT  TOPTION
USETEXT  TAFIT
USETEXT  TDESATT
USETEXT  TIMF 
USETEXT  TXSTD
USETEXT  TLFNINF
USETEXT  TIMFDEF
PROC SEMSMR;     # SEMANTIC ROUTINES FOR -STORE-, -MODIFY-, -REMOVE-   #
BEGIN 
  
                                   #----------- X D E F S--------------#
                                   #                                   #
  
  
                                   #----------- X R E F S--------------#
                                   #                                   #
      XREF PROC DIAG;              # ISSUE DIAGNOSTICS                 #
      XREF PROC LFNLOOKUP;         # LOCATE THE FILE FIT               #
      XREF PROC LINKNEWLFN;        # SET UP AND LINK NEW FIT           #
      XREF PROC RECYES;            # RETURN TO STDYES IF RECORDING     #
      XREF PROC STO$KEY;           # STORE SEARCH KEY IN BIT MAP       #
  
      XREF FUNC SAVATTR U;         # SET POINTER TO ATTRIBS OF ITEM    #
  
      XREF ITEM ANYAREAITEM B;     # TRUE IF SET/USI LIST HAS DBI      #
      XREF ITEM APATHDUP I;        # 1 IF ACCESS PATH HAS DUPS         #
      XREF ITEM APATHREC U;        # RECORD ID OF ACCESS PATH          #
      XREF ITEM CURRENTLFPTR I;    # POINTS TO CURRENT LFN             #
      XREF ITEM DESLIST I;         # POINTER TO DESCRIBE LIST          #
      XREF ITEM DTP I;             # INDEX INTO DISPLAY TABLE          #
      XREF ITEM ENDPTR I;          # INDEX INTO EVALUATE/MOVE TABLE    #
      XREF ITEM EVALFWA I;         # FWA OF FIRST EVALUATE TABLE       #
      XREF ITEM FOLLOWON B;        # TRUE IF FOLLOW DIRECT IN EFFECT   #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* FIT             #
      XREF ITEM KEYMAP I;          # -USING- SEARCH KEY BIT MAP        #
      XREF ITEM OLDSEARCH B;       # TRUE IF PREV DIR ACCESSED DATABASE#
      XREF ITEM RO B;              # TRUE IF *RO* CONTRL CARD PAR GIVEN#
      XREF ITEM SEARCHKEY B;       # TRUE IF SEARCH KEY FOUND          #
      XREF ITEM SM$GROUPID I;      # ID OF BLOCKS ACQUIRED FOR DIR     #
      XREF ITEM THREADINDEX I;     # INDEX INTO ARRAY -THREAD-         #
      XREF ITEM UPDATING B;        # TRUE IF AN UPDATE TO THE DATABASE #
      XREF ITEM UPDTEMP B;         # TRUE IF UPDATING TEMPORARY ITEMS  #
  
      XREF BASED ARRAY EVALDATA;   # EVALUATE TABLE                    #
        BEGIN 
        ITEM EVALWD I(00,00,60);   # FULL WORD ENTRY                   #
        END 
      XREF BASED ARRAY MOVETBL S(EESIZE);  # MOVE TABLE                #
        BEGIN 
        ITEM MWORD1 I(00,00,60);   # FULL WORD ENTRY                   #
        END 
  
  
                                   #------------ D E F S --------------#
                                   #                                   #
      DEF DISP   # O"1104" #;      # LEX CODE FOR *DISPLAY*            #
      DEF EXTR   # O"1110" #;      # LEX CODE FOR *EXTRACT*            #
      DEF PASS  # O"621"  #;       # LEX CODE FOR *PASS*               #
  
  
                                   #----------- I T E M S -------------#
                                   #                                   #
      ITEM AINDEX I;               # INDEX INTO USING/SETTING TABLE    #
      ITEM CODE I;                 # TO HOLD DIR-S LEXICAL CODE        #
      ITEM CURTABLE I;             # PTR TO NEW BLOCK OF LINKED TABLE  #
      ITEM J I;                    # SCRATCH VARIABLE                  #
      ITEM K I;                    # SCRATCH VARIABLE                  #
      ITEM SVREFERFILE I;          # SAVES REFERFILE                   #
      ITEM USINGITEM B;            # INDICATES A USING ENTRY           #
  
  
                                   #---------- A R R A Y S ------------#
                                   #                                   #
*CALL DEFMURL 
      BASED ARRAY ADDR;            # TEMPORARY ATTRIBUTE TABLE         #
        BEGIN 
        ITEM ADDRE  I(00,00,60);   # FULL WORD ENTRY                   #
        END 
      BASED ARRAY ATTRIBTABLE S(EESIZE);  # USING/SETTING TABLE        #
        BEGIN 
        ITEM ATTRIB     I(00,00,60);  # FULL WORD ENTRY                #
        ITEM ATYPE      U(00,00,03);  # TYPE OF MOVE TO PERFORM        #
        ITEM AFCHAR     U(00,04,04);  # FROM ITEM CHAR POSITION        #
        ITEM ATCHAR     U(00,08,04);  # TO ITEM CHAR POSITION          #
        ITEM ACHARLG    U(00,12,12);  # FROM/TO ITEM LENGTH IN CHARS   #
        ITEM AFROMADDR  I(00,24,18);  # FROM ITEM ATTRIBUTES           #
        ITEM ATOADDR    I(00,42,18);  # TO ITEM ATTRIBUTES             #
        ITEM ACVTCD     I(01,00,06);  # CONVERT CODE                   #
        ITEM AADDRFROM  I(01,24,18);  # ADD OF BASE IF AFROMADDR IS REL#
        ITEM AADDRTO    I(01,42,18);  # ADDR OF BASE IF ATOADDR IS REL #
        ITEM AAKEY      B(02,00,01);  # TRUE IF ITEM IS SEARCH KEY     #
        ITEM AUSING     B(02,24,01);  # TRUE IF ITEM IS USING ENTRY    #
        ITEM DAREAORD   I(02,54,06);  # ORDINAL OF RECORD              #
        END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     B L D $ T B L                                                    #
#                                                                      #
#     *BLD$TABLE* BUILDS THE *SETTING/USING* ENTRY IN *ATTRIBTABLE*.   #
#     IF ANOTHER BLOCK IS NEEDED FOR THE TABLE, *LINKIT* IS CALLED TO  #
#     ALLOCATE MORE SPACE.  *ANYAREAITEM* IS SET TRUE IF A DATABASE    #
#     ITEM IS ENCOUNTERED AND THE TABLE INDEX IS INCREMENTED           #
#     FOR THE NEXT GO AROUND.                                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC BLD$TBL;
      PROC BLD$TBL; 
      BEGIN 
  
      P<BASICTABLE> = BASCPTR;
  
      IF AINDEX GQ MAXUS           # IF A NEW BLOCK IS NEEDED          #
      THEN
        BEGIN 
        LINKIT;                    # GO ALLOCATE MORE SPACE            #
        END 
  
      P<ATTRIBTABLE> = CURTABLE;   # SET USING/SETTING TABLE           #
  
      IF AREAITM                   # IF A DATABASE ITEM                #
      THEN
        BEGIN 
        DATANAMEPTR = SAVATTR;     # SET POINTER TO ATTRIBUTES         #
        END 
  
      P<DESATT1> = DATANAMEPTR;    # SET ATTRIBUTE TABLE               #
      J = DATACHARPOS * 6;         # STORE BIT POSITION                #
  
      IF J NQ DBITPOS[0]           # IF THE ITEMS CURRENT BIT POSITION #
         OR DATAWORDADDR NQ DEWPOS[0]  # OR WORD ADDRESS DOESN-T MATCH #
                                   # THE VALUES SET IN ITS ATTRIB TABLE#
      THEN
        BEGIN 
        IF NOT AREAITM             # IF DEALING WITH A TEMP ITEM       #
        THEN
          BEGIN 
                                   # GENERATE A NEW ATTRIB TABLE BY    #
          P<ADDR> = P<DESATT1>;    # SAVING THE OLD ATTRIBUTE TABLE    #
          P<DESATT1> = CMM$ALF( 7, 0, SM$GROUPID );  # ALLOCATING A NEW#
          DATANAMEPTR = P<DESATT1>;  # RESETTING THE POINTER           #
          FOR K = 0  STEP 1 
            UNTIL 6 
          DO
            BEGIN 
                                    # COPY THE EXISTING ATTRIBUTES     #
            DDWORD0[K] = ADDRE[K];  # INTO THE NEW TABLE               #
            END 
          END 
                                   # WHETHER TEMP OR DATABASE ITEM,    #
                                   # IF THE VALUES DON-T MATCH         #
        DEWPOS[0] = DATAWORDADDR;  # RESET WORD ADDRESS                #
        DBITPOS[0] = J;            # AND BIT POSITION IN THE ATTR TABLE#
        END 
                                       #   BUILD USING/SETTING TABLE   #
  
      AADDRTO[AINDEX] = DATANAMEBASE;  # TO ADDR IF ATOADDR RELATIVE   #
      AAKEY[AINDEX]   = AKEYITEM;      # TRUE IF SEARCH KEY            #
      ACHARLG[AINDEX] = DATALENG;      # SET LENGTH                    #
      ACVTCD[AINDEX]  = DATATYPE + 1;  # CONVERT CODE                  #
      ATCHAR[AINDEX]  = DATACHARPOS;   # BEGINING CHAR POSITION        #
      ATOADDR[AINDEX] = DATANAMEPTR;   # WORD ADDR/ATTR TABL OF RESULT #
      ATYPE[AINDEX]   = 2;             # TYPE OF CONVERSION            #
      AUSING[AINDEX]  = USINGITEM;     # SET IF ITEM IS USING ENTRY    #
  
      IF AREAITM                   # IF A DATABASE ITEM                #
      THEN
        BEGIN 
        ANYAREAITEM = TRUE;        # INDICATE AS SUCH                  #
        END 
  
      AINDEX = AINDEX + 1;         # INCREMENT INDEX FOR NEXT ENTRY    #
  
      RETURN; 
  
      END                          # PROC *BLD$TBL*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C H K S M R                                                      #
#                                                                      #
#     *CHKSMR* IS CALLED FROM SYNGEN TO MAKE THE FINAL VALIDITY        #
#     CHECKS FOR THE *STORE/MODIFY/REMOVE* DIRECTIVES.                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC CHKSMR; 
      PROC CHKSMR;
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      P<BASICTABLE> = BASCPTR;
      K = BASCODE[BASTABIND];      # STORE CODE IN TEMP-EASY REFERENCE #
  
      IF NOT SEARCHKEY             # IF A SEARCH KEY WAS NOT FOUND     #
      THEN
        BEGIN 
  
        IF K EQ STORCODE           # IF *STORE*                        #
          OR K EQ STRSCODE         # OF IF *STORE SETTING*             #
        THEN
          BEGIN 
          DIAG ( 394 );            # A SEARCH KEY IS NEEDED            #
          STDNO;                   # DIAGNOSE AND RETURN               #
          END 
  
        IF K EQ MODCODE            # IF *MODIFY*                       #
        THEN
          BEGIN 
  
          IF ANYAREAITEM           # IF DATABASE ITEMS ARE REFERENCED  #
            AND NOT IFFLAG         # BUT AN *IF* DOES NOT PRECEDE      #
          THEN
            BEGIN 
            DIAG ( 394 );          # A SEARCH KEY IS NEEDED            #
            STDNO;                 # DIAGNOSE AND RETURN               #
            END 
  
          IF NOT BASCSET[BASTABIND]  # IF *MODIFY* WITHOUT A *SETTING* #
            AND BASCMOVADDR[BASTABIND] EQ 0  # OR *MOVE* CLAUSE        #
          THEN
            BEGIN                  # THE TRANSMISSION HAS              #
            DIAG ( 398 );          # INSUFFICIENT PARAMETERS           #
            STDNO;                 # DIAGNOSE AND RETURN               #
            END 
  
          IF NOT ANYAREAITEM       # IF ONLY TEMPS ARE REFERENCED      #
          THEN
            BEGIN 
            UPDATING = FALSE;      # INDICATE NOT UPDATING THE DATABASE#
            UPDTEMP  = TRUE;       # BUT UPDATING TEMPORARY ITEMS      #
            BASCTEMP[BASTABIND] = TRUE; 
            END 
          END 
  
        IF K EQ REMCODE            # IF *REMOVE*                       #
          AND NOT IFFLAG           # AND NOT PRECEDED BY AN *IF*       #
        THEN
          BEGIN 
          DIAG ( 394 );            # A SEARCH KEY IS NEEDED            #
          STDNO;                   # DIAGNOSE AND RETURN               #
          END 
        END                        # END -SEARCH KEY NOT FOUND-        #
  
      ELSE                         # IF A SEARCH KEY WAS FOUND         #
        BEGIN 
  
        IF K EQ MODUCODE           # IF *MODIFY USING*                 #
          AND NOT BASCSET[BASTABIND]       # AND NO *SETTING*          #
          AND BASCMOVADDR[BASTABIND] EQ 0  # OR *MOVE* CLAUSE          #
        THEN
          BEGIN 
          DIAG ( 398 );            # THE TRANSMISSION HAS              #
          STDNO;                   # INSUFFICIENT PARAMETERS           #
          END                      # DIAGNOSE AND RETURN               #
  
        END 
  
      SM$GROUPID = 0;              # CLEAR CMM GROUP ID                #
  
      IF NOT BASCTEMP[BASTABIND]   # IF DATABASE ITEMS REFERENCED      #
      THEN
        BEGIN 
        REFERFILE = O"77";         # SET WRITE FLAG FOR AREA FILE      #
        END 
  
      STDYES;                      # SUCCESSFUL RETURN                 #
  
      END                          # PROC *CHKSMR*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     D E $ I N I                                                      #
#                                                                      #
#     *DE$INI* SETS *BASCODE* FOR EITHER DISPLAY OR EXTRACT AND RESETS #
#     THE NAVIGATION STRATEGY FOR THE RECORD ACCESS.                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC DE$INI; 
      PROC DE$INI;
      BEGIN 
      CODE = CLXWRD[0];            # CODE FOR DIRECTIVE                #
      IF CODE EQ DISP              # IF DIRECTIVE IS -DISPLAY-         #
      THEN
        BEGIN 
        BASCODE[BASTABIND] = DISPCODE;  # SAVE ITS CODE IN BASICTABLE  #
        END 
  
      ELSE                         # IF DIRECTIVE IS -EXTRACT-         #
        BEGIN 
        BASCODE[BASTABIND] = EXTRCODE;
        END 
  
      IF FOLLOWON                  # IF NAVIGATION STRATEGY STORED     #
      THEN
        BEGIN 
        FOR J = 1 STEP 1           # STEP THROUGH ARRAY -FOLLOWS-      #
          WHILE FOLLOWENTRY[J] NQ 0 
        DO
                                   # RESET NAVIGATION STRATEGY         #
          BEGIN                    # AND MARK THE RECORD SEEN          #
          THREADENTRY[J] = FOLLOWENTRY[J];
          RECORDSEEN[THISRECORDID[J]] = TRUE; 
          END 
  
                                   # SET ACC PATH INFO INTO -RECORDS-  #
                                   # ORDINAL OF PATH                   #
        B<0,9>PATHLIST[APATHREC] = PATHCOSETID[1];
                                   # FLAG FOR PATH DUPLICATES          #
        B<0,1>DUPLICLIST[APATHREC] = APATHDUP;
        END 
  
      STDYES; 
      END                          # PROC *DE$INI*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E V $ I N I                                                      #
#                                                                      #
#     *EV$INI* INITIALIZED THE EVALUATE DIRECTIVE BY ESTABLISHING      #
#     THE EVALUATE TABLE, STORING IT'S ADDRESS IN *BASCADDR* AND       #
#     SETTING *BASCODE*.                                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC EV$INI; 
      PROC EV$INI;
      BEGIN 
  
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
  
      ENDPTR = 0;                  # POSTN TABLE POINTER AT FIRST ENTRY#
  
      P<EVALDATA> = CMM$ALF( 7, 0, SM$GROUPID );
  
      BASCADDR[BASTABIND] = P<EVALDATA>;  # STORE ADDRESS              #
  
      BASCODE[BASTABIND]  = EVALCODE;     # SET DIRECTIVE CODE         #
  
      EVALFWA = P<EVALDATA>;       # SAVE FWA FOR *CUMFUNC*            #
  
      STDYES;                      # RETURN                            #
  
  
      END                          # PROC *EV$INI                      #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I F $ I N I                                                      #
#                                                                      #
#     *IF$INI$ SETS BASCODE FOR *IF*                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC IF$INI; 
      PROC IF$INI;
      BEGIN 
  
      BASCODE[BASTABIND] = IFCODE; # SAVE CODE FOR -IF- IN BASICTABLE  #
  
      STDYES; 
  
  
      END                          # PROC *IF$INI*                     #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     L I N K I T                                                      #
#                                                                      #
#     *LINKIT* ALLOCATES SPACE FOR THE USING/SETTING TABLE.  AFTER     #
#     THE INITIAL ALLOCATION, THE ADDRESS IS STORED IN THE BASICTABLE. #
#     SUBSEQUENT ALLOCATIONS ARE LINKED TO THE PREVIOUS BLOCK.         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC LINKIT;
      BEGIN 
  
      CURTABLE = CMM$ALF(MAXUS * EESIZE + 1, FIXED$LWA,SM$GROUPID); 
  
      IF BASCADDR[BASTABIND] EQ 0 
      THEN                         # IF THIS IS THE FIRST ALLOCATION   #
        BEGIN                      # SET ADDRESS IN THE BASIC TABLE    #
        BASCADDR[BASTABIND] = CURTABLE; 
        END 
      ELSE                         # IF THE TABLE EXISTS, LINK THE NEW #
        BEGIN                      # TO THE OLD BY STORING THE         #
        ATTRIB[MAXUS] = CURTABLE;  # ADDRESS AT THE END                #
        END 
  
      AINDEX = 0;                  # SET/RESET THE INDEX               #
      RETURN; 
  
      END                          # END PROC LINKIT                   #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O D $ I N I                                                    #
#                                                                      #
#     *MOD$INI INITIALIZES THE *MODIFY* DIRECTIVE.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC MOD$INI;
      PROC MOD$INI; 
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      BASCODE[BASTABIND] = MODCODE;  # SET DIRECTIVE CODE              #
  
                                   #  SO TABLE WILL BE ALLOCATED       #
      AINDEX = MAXUS;              # PRESET INDEX TO ITS MAXIMUM       #
  
      ANYAREAITEM = FALSE;         # ASSUME NO DATABASE ITEMS USED     #
  
      SEARCHKEY = FALSE;           # ASSUME SEARCH KEY NOT GIVEN       #
  
      UPDATING = TRUE;             # INDICATE AN UPDATE TO THE DATABASE#
  
      STDYES;                      # RETURN                            #
  
  
      END                          # PROC *MOD$INI*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O V $ I N I                                                    #
#                                                                      #
#     *MOV$INI* INITIALIZES THE MOVE DIRECTIVE BY ESTABLISHING THE     #
#     THE MOVE TABLE, STORING IT'S ADDRESS INTO *BASCADDR* AND SETTING #
#     *BASCODE*                                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC MOV$INI;
      PROC MOV$INI; 
      BEGIN 
  
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
  
      ENDPTR = 0;                  # POSTN TABLE POINTER AT FIRST ENTRY#
  
      P<MOVETBL> = CMM$ALF( MAXMOVE * EESIZE + 1, 0, SM$GROUPID );
  
      BASCADDR[BASTABIND] = P<MOVETBL>;  # STORE ADDRESS               #
  
      BASCODE[BASTABIND]  = MOVECODE;    # SET DIRECTIVE CODE          #
  
      STDYES;                      # RETURN                            #
  
  
      END                          # PROC *MOV$INI*                    #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     N X T B A S C                                                    #
#                                                                      #
#     *NXTBASC* ALLOCATES THE NEXT BASIC TABLE ENTRY                   #
#                                                                      #
#----------------------------------------------------------------------#
  
     XDEF PROC NXTBASC; 
     PROC NXTBASC;
     BEGIN
          IF BASTABLOC EQ 0 THEN       # ALLOCATE VERY 1ST BLOCK       #
          BEGIN                        # OF BASIC TABLES.              #
             BASTABLOC = CMM$ALF(15, FIXED$LWA, 0); 
             BASCPTR = BASTABLOC; 
             BASTABIND = 0; 
          END 
          ELSE
          IF BASTABIND EQ 6 THEN       # ALLOCATE THE SUBSEQUENT BLOCK #
          BEGIN                        # OF BASIC TABLES.              #
             P<BASICTABLE> = BASCPTR; 
             BASCODE[7] = CONTCODE;    # MARK CONTINUATION CODE        #
             BASCLAST[7] = CMM$ALF(15, FIXED$LWA, 0); 
             BASCPTR = BASCLAST[7];    # POINT TO NEW BLOCK            #
             BASTABIND = 0;            # POINT TO 1ST ENTRY IN NEW BLOC#
          END 
          ELSE                         #ALLOCATE NEXT ENTRY IN         #
             BASTABIND = BASTABIND + 1;# CURRENT BLOCK.                #
  
          P<BASICTABLE> = BASCPTR;
          SM$GROUPID = CMM$AGR(ABOVE$HHA);
          BASC$GROUPID[BASTABIND] = SM$GROUPID; 
          RETURN; 
     END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E L B A S C                                                    #
#                                                                      #
#     *RELBASC* WILL RELEASE THE BASIC TABLE                           #
#                                                                      #
#----------------------------------------------------------------------#
  
     XDEF PROC RELBASC; 
     PROC RELBASC;
     BEGIN
          ITEM K;            # LOOP COUNTER                            #
  
          FOR K = BASTABIND STEP -1 UNTIL 0 DO
             BEGIN
             IF BASC$GROUPID[K] NQ 0  # IF GROUP ID ASSIGNED           #
             THEN 
                BEGIN 
                CMM$FGR (BASC$GROUPID[K]);  # FREE GROUP ID            #
                END 
             END
  
             IF BASTABLOC NQ 0     # IF BASIC TABLE ASSIGNED           #
             THEN 
                BEGIN 
                CMM$FRF (BASTABLOC);  # FREE BASIC TABLE               #
                END 
  
          BASTABLOC = 0;
          BASTABIND = 0;
          SM$GROUPID = 0;    # CLEAR THE DIRECTIVE GROUP-ID            #
          SEARCHFLAG = FALSE;      # NO BASIC TABLE DIRECTIVE YET      #
          REFERFILE = 0;           # DATA BASE FILE NOT ACCESSED       #
          RETURN; 
     END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E M $ I N I                                                    #
#                                                                      #
#     *REM$INI INITIALIZES THE *REMOVE* DIRECTIVE.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC REM$INI;
      PROC REM$INI; 
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      BASCODE[BASTABIND] = REMCODE;  # SET DIRECTIVE CODE              #
  
                                   # SO TABLE WILL BE ALLOCATED        #
      AINDEX = MAXUS;              # PRESET INDEX TO MAXIMUM           #
  
      ANYAREAITEM = FALSE;         # ASSUME NO DATABASE ITEMS USED     #
  
      SEARCHKEY = FALSE;           # ASSUME SEARCH KEY NOT GIVEN       #
  
      UPDATING = TRUE;             # INDICATE AN UPDATE TO THE DATABASE#
  
      STDYES;                      # RETURN                            #
  
  
      END                          # PROC *REM$INI*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V D A T A                                                    #
#                                                                      #
#     *SAVDATA* IS CALLED DURING SYNGEN PROCESSING OF THE *SETTING*    #
#     CLAUSE.  THIS PROCEDURE WILL SET *SEARCHKEY* IF THE              #
#     CONDITIONS ARE MET.  *BLD$TBL* IS THEN CALLED TO BUILD THE       #
#     *SETTING* ENTRY INTO *ATTRIBTABLE*.                              #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVDATA;
      PROC SAVDATA; 
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
  
      USINGITEM = FALSE;           # ITEM NOT A USING ENTRY            #
  
      IF AREAITM                   # IF ITEM IS IN THE DATABASE        #
        AND RO                     # AND *READ ONLY* PARAMETER GIVEN   #
      THEN
        BEGIN 
        DIAG ( 308 );              # A CHANGE TO THE DATABASE IS       #
        STDNO;                     # NOT PERMITTED, DIAGNOSE AND RETURN#
        END 
  
      IF AKEYITEM                  # IF ITEM IS THE SEARCH KEY         #
      THEN
        BEGIN 
        IF BASCODE[BASTABIND] EQ STRSCODE  # IF *STORE SETTING*        #
        THEN
          BEGIN 
          SEARCHKEY = TRUE;        # FLAG THAT KEY HAS BEEN FOUND      #
          END 
        END 
  
      BLD$TBL;                     # BUILD *SETTING* ENTRY IN THE TABLE#
  
      STDYES; 
  
      END                          # PROC *SAVDATA*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V E U S I                                                    #
#                                                                      #
#     *SAVEUSI* IS CALLED DURING SYNGEN PROCESSING OF THE *USING*      #
#     CLAUSE.  A PRELIMINARY CHECK WILL INSURE THE *RO* PARAM WAS      #
#     NOT GIVEN BEFORE CALLING *BLD$TBL* TO BUILD THE *USING* ENTRY    #
#     INTO *ATTRIBTABLE*.  AFTERWARDS, *STO$KEY* IS CALLED TO SAVE     #
#     THE SEARCH KEY ORDINAL IN A BIT MAP FOR IMF PROCESSING.          #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVEUSI;
      PROC SAVEUSI; 
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
  
      USINGITEM = TRUE;            # ITEM IS A USING ENTRY             #
  
      IF RO                        # IF *READ ONLY* PARAMETER GIVEN    #
      THEN
        BEGIN 
        DIAG ( 308 );              # A CHANGE TO THE DATABASE IS       #
        STDNO;                     # NOT PERMITTED, DIAGNOSE AND RETURN#
        END 
  
      BLD$TBL;                     # BUILD THE *USING* ENTRY IN TABLE  #
  
      STO$KEY;                     # STORE THE KEY                     #
  
      STDYES;                      # RETURN                            #
  
      END                          # PROC *SAVEUSI*                    #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T F R O M                                                    #
#                                                                      #
#     *SETFROM* PROCESSES THE *FROM LFN* OPTION BY INSURING            #
#     THAT THE FILE NAME EXISTS AND THEN LINKS IT TO THE               #
#     LFN LIST.                                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETFROM;
      PROC SETFROM; 
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
  
      IF FROMKEYINFIT NQ 0         # IF A *FROM* FILE EXISTS           #
      THEN
        BEGIN                      # RETURN SINCE MULTIPLE *FROM*      #
        DIAG ( 370 );              # FILES ARE NOT ALLOWED             #
        STDNO;
        END 
  
      SVREFERFILE = REFERFILE;     # SAVE REFERFILE                    #
  
      LFNLOOKUP(J);                # LOCATE THE FILE FIT               #
  
      IF J NQ 0                    # IF FIT FOUND                      #
      THEN
        BEGIN 
        DESLIST = 0;               # NO DESCRIBE LIST FOR THIS FILE    #
        LINKNEWLFN(0);             # SET UP AND LINK NEW FIT           #
        END 
  
      REFERFILE = SVREFERFILE;     # RESTORE REFERFILE                 #
  
      P<AFIT> = CURRENTLFPTR + L$FITOFFSET;  # SET FIT ADDRESS         #
  
      BASCFROM[BASTABIND] = TRUE;  # INDICATE *FROM* FILE              #
      BASFITFROM[BASTABIND] = P<AFIT>;  # STORE FIT ADDR IN BASIC TABLE#
      FROMKEYINFIT = P<AFIT>;      # INDICATE *FROM* FILE EXISTS       #
  
      STDYES; 
  
      END                          # PROC *SETFROM*                    #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T P V                                                        #
#                                                                      #
#     *SETPV* SETS THE FLAGS FOR THE *PASS/VETO* OPTIONS STATED        #
#     WITHIN A STORE, MODIFY, OR REMOVE DIRECTIVE.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETPV;
      PROC SETPV; 
      BEGIN 
  
      IF RECORDFLAG                # IF RECORDING                      #
        OR TERMINAL EQ 0           # OR IN BATCH MODE                  #
      THEN
        BEGIN 
        STDNO;                     # IGNORE *PASS/VETO* OPTION         #
        END 
  
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
  
      IF CLXWRD[0] EQ PASS         # IF *PASS* GIVEN                   #
      THEN
        BEGIN 
        BASCPASS[BASTABIND] = TRUE;  # SET *PASS* FLAG                 #
        END 
      ELSE                         # IF *VETO* GIVEN                   #
        BEGIN 
        BASCVETO[BASTABIND] = TRUE;  # SET *VETO* FLAG                 #
        END 
  
      STDNO;                       # RETURN                            #
  
      END                          # PROC *SETPV*                      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T S E T                                                      #
#                                                                      #
#     *SETSET* IS CALLED TO INITIALIZE THE *SETTING* CLAUSE GIVEN      #
#     WITHIN A *STORE* DIRECTIVE.                                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETSET; 
      PROC SETSET;
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      USINGFLAG = TRUE;            # FLAG AS USING CLAUSE FOR FUTURE   #
  
      USINGITEM = FALSE;           # FLAG ITEM AS NON USING ENTRY      #
  
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
      BASCSET[BASTABIND] = TRUE;   # INDICATE *SETTING* SPECIFIED      #
                                   # REFLECT *SETTING* CLAUSE IN THE   #
      BASCODE[BASTABIND] = BASCODE[BASTABIND] + 1;  # DIRECTIVE CODE   #
  
      TYPEALOW = 4;                # ONLY DEFINED OR AREA ITEMS ALLOWED#
  
      STDYES; 
  
  
  
      END                          # PROC *SETSET*                     #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U S I                                                      #
#                                                                      #
#     *SETUSI* INITIALIZES THE *USING* CLAUSE GIVEN WITHIN             #
#     A *MODIFY* OR *REMOVE* DIRECTIVE.                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETUSI; 
      PROC SETUSI;
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      USINGITEM = FALSE;           # PRESET AS A NON USING ITEM        #
  
      USINGFLAG = TRUE;            # FLAG USING CLAUSE                 #
  
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
      BASCUSING[BASTABIND] = TRUE; # INDICATE *USING* CLAUSE           #
                                   # REFLECT *USING* CLAUSE IN THE     #
      BASCODE[BASTABIND] = BASCODE[BASTABIND] + 1;  # DIRECTIVE CODE   #
  
      TYPEALOW = 4;                # ONLY DEFINED OR AREA ITEMS ALLOWED#
  
      STDYES; 
  
  
      END                          # PROC *SETUSI*                     #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U S I S E T                                                #
#                                                                      #
#     *SETUSISET* INTIITALIZES THE *SETTING* CLAUSE GIVEN WITHIN       #
#     A *MODIFY* OR *REMOVE* DIRECTIVE.  ALL NORMAL *SETTING*          #
#     FLAGS ARE SET BUT THE DIRECTIVE CODE IS NOT INCREMENTED.         #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETUSISET;
      PROC SETUSISET; 
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      P<BASICTABLE> = BASCPTR;     # POSITION TO CURRENT BASIC TABLE   #
      BASCSET[BASTABIND] = TRUE;   # INDICATE *SETTING* CLAUSE         #
  
      TYPEALOW = 4;                # ONLY DEFINED OR AREA ITEMS ALLOWED#
  
      STDYES; 
  
  
      END                          # PROC *SETUSISET*                  #
  
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T 6 0                                                        #
#                                                                      #
#     *SET60* IS THE INITIALIZATION ROUTINE FOR ALL DIRECTIVES WHICH   #
#     ACCESS THE IMF DATA BASE.  IT INITIALIZES THE ARRAYS *RECORDS*   #
#     AND *THREAD* AND POINTS TO A NEW ENTRY IN BASICTABLE.            #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SET60;
      PROC SET60; 
      BEGIN 
      DTP = 0;                     # IDX INTO DISPLAY TABLE            #
      OLDSEARCH = SEARCHFLAG;      # SAVE OLD SEARCH FLAG              #
      IF NOT OLDSEARCH             # IF 1ST BASICTABLE DIR IN XMISSN   #
      THEN
        BEGIN 
        DESPASS = FALSE;
        FILEPASS = FALSE; 
        FOR K = 1 STEP 1           # FOR EVERY NON-0 ENTRY IN *RECORDS*#
          WHILE RECORDENTRY[K] NQ 0 
        DO
          BEGIN 
          RECORDSEEN[K] = FALSE;
          RECORDWSA[K] = 0; 
          DUPLICLIST[K] = 0;
          PATHLIST[K] = 0;
          END 
        END 
      SEARCHFLAG = TRUE;           # THIS IS A BASICTABLE DIRECTIVE    #
      RECYES;                      # STDYES IF RECORDING               #
  
  
      KEYMAP = 0;                  # INIT SEARCH KEY BIT MAP           #
  
      IF P<THREAD> EQ 0            # IF -THREAD- NOT YET ALLOCATED     #
      THEN
        BEGIN                      # ALLOC SPACE FOR ARRAY -THREAD-    #
        P<THREAD> = CMM$ALF (MAXTHREAD+1, FIXED$LWA, 0);
        END 
  
      FOR K = 0 STEP 1             # FOR EVERY ENTRY IN -THREAD-       #
        UNTIL MAXTHREAD 
      DO
        BEGIN 
        THREADENTRY[K] = 0;        # INITIALIZE IT TO ZERO             #
        END 
      THREADINDEX = 2;             # SKIP ENTRY FOR ROOT RECORD TYPE   #
  
      NXTBASC;                     # POINT TO NEXT B-TABLE ENTRY AND   #
                                   # SAVE CMM GROUP ID IN IT           #
      STDYES;                      # SUCCESSFUL RETURN                 #
      END                          # PROC *SET60*                      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O $ I N I                                                    #
#                                                                      #
#     *STO$INI* INITIALIZES THE *STORE* DIRECTIVE.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC STO$INI;
      PROC STO$INI; 
      BEGIN 
  
      RECYES;                      # RETURN IF RECORDING               #
  
      BASCODE[BASTABIND] = STORCODE;  # SET DIRECTIVE CODE             #
  
                                   # SO TABLE WILL BE ALLOCATED        #
      AINDEX = MAXUS;              # PRESET INDEX TO ITS MAXIMUM       #
  
      ANYAREAITEM = FALSE;         # ASSUME NOT DATABASE ITEMS USED    #
  
      SEARCHKEY = FALSE;           # ASSUME SEARCH KEY NOT FOUND       #
  
      UPDATING = TRUE;             # INDICATE AN UPDATE TO THE DATABASE#
  
      STDYES;                      # RETURN                            #
  
  
      END                          # PROC *STO$INI*                    #
#----------------------------------------------------------------------#
  
END 
TERM
