*DECK SEMINV
USETEXT  TCMMDEF
USETEXT  TENVIRN
USETEXT  TIMF 
USETEXT  TIMFDEF
PROC SEMINV;                 # SEMANTIC ROUTINES FOR -INVOKE-          #
BEGIN 
  
  
#----------------------------------------------------------------------#
#     S T A R T    O F    X D E F S                                    #
  
      XDEF ITEM PRIVACYKEY C(30);  # EXTERNAL SCHEMA PRIVACY KEY LITERL#
  
#----------------------------------------------------------------------#
#     S T A R T    O F    X R E F S                                    #
  
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC                  #
      XREF FUNC INVOKE$ C(10);     # ISSUE IMF INVOKE                  #
      XREF PROC RECYES;            # GO TO *STDYES* IF RECORDING       #
      XREF PROC STDNO;
      XREF PROC STDYES; 
  
      XREF ITEM CDCSCAT B;         # TRUE IF CDCS CATALOG MODE         #
      XREF ITEM CURWORD C(30);     # CURRENT SYNTAX SOURCE WORD        #
      XREF ITEM FOLLOWON B;        # INDICATES STORED NAVIGN STRATEGY  #
      XREF ITEM IMFDBM B;          # TRUE IF IMF DATA BASE MODE        #
      XREF ITEM PRYPFID I;         # METADATABASE PERMANENT FILE UN/ID #
      XREF ITEM PWRD$;             # METADATABASE PERMANENT FILE PW    #
      XREF ITEM REPAIRF B;         # TRUE IF -INVOKE FOR REPAIR-       #
      XREF ITEM SCHMSDB I;         # METADATABASE PERMANENT FILE NAME  #
      XREF ITEM SM$GROUPID I;      # CMM GROUP ID FOR DIRECTIVE        #
  
      XREF BASED ARRAY SCHNAMA;    # EXTERNAL SCHEMA NAME AND          #
                                   # CONCEPTUAL SCHEMA NAME ARRAY      #
        BEGIN 
        ITEM SUBNAME      C(00,00,30);  # EXTERNAL SCHEMA NAME         #
        ITEM SCHNAME      C(03,00,30);  # CONCEPTUAL SCHEMA NAME       #
        END 
  
  
#----------------------------------------------------------------------#
#     S T A R T    O F    D E F S                                      #
  
      DEF CALL # #; 
      DEF MAXERRORNO #14#;
  
#----------------------------------------------------------------------#
#     S T A R T    O F    L O C A L    I T E M S                       #
  
      ITEM INFRSEEN B;             # TRUE IF *IN* OR *FROM* SEEN       #
      ITEM K I;                    # TEMPORARY SCRATCH CELL            #
  
#----------------------------------------------------------------------#
#     S T A R T    O F    L O C A L    A R R A Y S                     #
  
ARRAY [0: MAXERRORNO];       # ARRAY TO MAP CERTAIN IMF (OCM) ERRORS   #
                             # INTO SELF EXPLANATORY QU DIAGNOSTICS.   #
                             # OTHER OCM ERRORS ARE SHOWN IN DIAG 505. #
  BEGIN 
    ITEM IMFERRORNO U(0,0,30) = 
             [     8,     9,    12,    13,
                  14,    15,    16,    22,
                  23,    27,    28,    30,
                 538,   540              ]; 
    ITEM QUERRORNO U(0,30,30) = 
             [   520,   520,   521,   522,
                 523,   524,   525,   526,
                 526,   542,   543,   503,
                 538,   540              ]; 
  
                                   # ERROR 538 IS GENERATED BY QU IF   #
                                   # QU WAS BUILT WITHOUT IMF, THAT IS,#
                                   # WITHOUT *DEFINE IMF               #
                                   # ERROR 540 IS GENERATED BY QU IF   #
                                   # QU WAS BUILT WITH AN              #
                                   # INCOMPATIBLE VERSION OF IMF       #
  END 
  
#----------------------------------------------------------------------#
  
      XDEF PROC CHKIMF;            # *NO* IF ILLEGAL SYNTAX ACCEPTED   #
                                   # OR CDCS CATALOG MODE              #
      PROC CHKIMF;
      BEGIN 
      RECYES;                      # RETURN TO *STDYES* IF RECORDING   #
      IF CDCSCAT                   # IF CDCS CATALOG MODE              #
      THEN
        BEGIN 
        DIAG (406, SUBNAME);       # SUBSCHEMA NOT THE SAME AS CDCS    #
                                   # CATALOG FILE                      #
        STDNO;                     # ERROR EXIT                        #
        END 
  
      STDYES;                      # GOOD EXIT                         #
      END 
  
#----------------------------------------------------------------------#
  
      XDEF PROC CHKINFR;           # *YES* IF *IN* OR *FROM* SEEN      #
      PROC CHKINFR; 
      BEGIN 
      IF INFRSEEN                  # IF *IN* OR *FROM* SEEN            #
      THEN
        BEGIN 
        STDYES;                    # *IN* OR *FROM* SEEN               #
        END 
  
      STDNO;                       # *IN* AND *FROM* NOT SEEN          #
      END 
  
#----------------------------------------------------------------------#
  
      XDEF PROC CHKREPM;           # *YES* IF -INVOKE FOR REPAIR- SPEC.#
      PROC CHKREPM; 
      BEGIN 
      IF REPAIRF                   # IF -INVOKE FOR REPAIR-            #
      THEN
        BEGIN 
        STDYES;                    # -FOR REPAIR- SEEN                 #
        END 
  
      STDNO;                       # -FOR REPAIR- NOT SEEN             #
      END 
  
#----------------------------------------------------------------------#
  
XDEF PROC INV$EXE;           # EXECUTE INVOKE DIRECTIVE                #
     PROC INV$EXE;
   BEGIN
          IF RECORDFLAG            # IF RECORDING                      #
          THEN
            BEGIN 
            IMFDBM = TRUE;         # SET IMF DATA BASE MODE.  THIS IS  #
                                   # NECESSARY, EVEN IF RECORDING, SO  #
                                   # THAT CORRECT OVERLAY WILL CRACK   #
                                   # STORE/MODIFY/REMOVE SYNTAX        #
            STDYES; 
            END 
          ERRSTATEMENT = INVOKE$ (SCHNAME, SUBNAME, PRIVACYKEY);
          IF ERRSTATEMENT NQ STV$OK THEN
          BEGIN 
             IF P<SCHNAMA> NQ 0    # IF SCHEMA NAME ARRAY EXISTS       #
             THEN 
                BEGIN 
                CMM$FRF (P<SCHNAMA>);  # RELEASE SCHEMA NAME ARRAY     #
                P<SCHNAMA> = 0;    # INDICATE NO SCHEMA NAME ARRAY     #
                END 
  
             FOR K=0 STEP 1 UNTIL MAXERRORNO DO 
             BEGIN
                IF IMFERRORNO [K] EQ ERRCODE THEN 
                BEGIN 
                   CALL DIAG(QUERRORNO [K]);
                   STDNO; 
                END 
             END
             CALL DIAG(505, ERRSTATEMENT);
             STDNO; 
          END 
  
          IMFDBM = TRUE;           # IMF SCHEMA INVOKED                #
          STDYES; 
   END
#----------------------------------------------------------------------#
  
XDEF PROC INV$INI;           # INITIALISE INVOKE DIRECTIVE             #
     PROC INV$INI;
     BEGIN
          PWRD$ = DEFAULT$PW;      # PREPARE DEFAULT PW VALUE          #
          PRYPFID = 0;             # CLEAR OUT PREVIOUS ID/UN          #000170
                                   # ALLOCATE CM FOR SCHEMA NAME ARRAY #
          P<SCHNAMA> = CMM$ALF (6, FIXED$LWA, 0); 
          INFRSEEN = FALSE;        # *IN* OR *FROM* NOT SEEN YET       #
          PRIVACYKEY = " ";        # INITIALIZE TO BLANKS              #
          REPAIRF = FALSE;         # INIT. TO NO -INVOKE FOR REPAIR-   #
          STDYES; 
     END
#----------------------------------------------------------------------#
  
      XDEF PROC INV$TER;           # TERMINATE PREVIOUS IMF INVOKE     #
      PROC INV$TER; 
      BEGIN 
      IF RECORDFLAG                # IF RECORDING                      #
      THEN
        BEGIN 
        IMFDBM = FALSE;            # NO LONGER IMF DATA BASE MODE      #
        STDYES; 
        END 
  
      IF IMFDBM                    # IF IMF PREVIOUSLY INVOKED         #
      THEN
        BEGIN 
        IF USERSCHT NQ 0
        THEN
          BEGIN 
          CMM$FRF (USERSCHT);      # RELEASE CONCEPTUAL SCHEMA TABLE   #
          END 
  
        IF USERSSCT NQ 0
        THEN
          BEGIN 
          CMM$FRF (USERSSCT);      # RELEASE EXTERNAL SCHEMA TABLE     #
          END 
  
        IF USERSSST NQ 0
        THEN
          BEGIN 
          CMM$FRF (USERSSST);      # RELEASE SYMBOLIC EXTERNAL SCHEMA  #
                                   # TABLE                             #
          USERSSST = 0;            # INDICATE NO SCHEMA TABLE          #
          END 
  
        IF P<RECORDS> NQ 0
        THEN
          BEGIN 
          CMM$FRF (P<RECORDS>);    # RELEASE RECORD TABLE              #
          END 
  
        IF P<FOLLOWS> NQ 0
        THEN
          BEGIN 
          CMM$FRF (P<FOLLOWS>);    # RELEASE NAVIGATION STRATEGY       #
          P<FOLLOWS> = 0; 
          FOLLOWON = FALSE; 
          END 
  
        IF P<SCHNAMA> NQ 0         # IF SCHEMA NAME ARRAY EXISTS       #
        THEN
          BEGIN 
          CMM$FRF (P<SCHNAMA>);    # RELEASE SCHEMA NAME ARRAY         #
          P<SCHNAMA> = 0;          # INDICATE NO SCHEMA NAME ARRAY     #
          END 
  
        IMFDBM = FALSE;            # IMF NO LONGER INVOKED             #
        END 
  
      STDYES; 
      END 
  
#----------------------------------------------------------------------#
  
XDEF PROC SAVDBN; 
   PROC   SAVDBN; 
   BEGIN
          CALL ZEROFILL (PRYPFID); # GET METADB UN/ID ZERO-FILLED      #
          STDYES; 
   END
#----------------------------------------------------------------------#
  
      XDEF PROC SAVEXTS;           # SAVE EXTERNAL SCHEMA NAME         #
      PROC SAVEXTS; 
      BEGIN 
      RECYES; 
      SUBNAME = CURWORD;           # SAVE EXTERNAL SCHEMA NAME         #
      STDYES; 
      END 
  
#----------------------------------------------------------------------#
  
XDEF PROC SAVKEY;            # TO SAVE THE EXTERNAL SCHEMA PRIVACY KEY #
     PROC SAVKEY; 
     BEGIN
          PRIVACYKEY = CURWORD; 
          STDYES; 
     END
#----------------------------------------------------------------------#
  
XDEF PROC SAVPW;
   PROC   SAVPW;
   BEGIN
          CALL ZEROFILL (PWRD$);   # GET METADB PASSWORD ZERO-FILLED   #
          STDYES; 
   END
#----------------------------------------------------------------------#
  
XDEF PROC SAVS; 
   PROC   SAVS; 
   BEGIN
                             # ZERO-FILL TO THE RIGHT METADB PF NAME   #
          SCHMSDB = 0;
          FOR K=0 STEP 1 WHILE C<K> CURWORD NQ " " AND K LQ 7  DO 
                    C<K> SCHMSDB = C<K> CURWORD;
          STDYES; 
   END
#----------------------------------------------------------------------#
  
XDEF PROC SAVSCH; 
   PROC   SAVSCH; 
   BEGIN
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          SCHNAME   = CURWORD;
          STDYES; 
   END
#----------------------------------------------------------------------#
  
  
      XDEF PROC SETINFR;           # SET *INFRSEEN* TRUE               #
      PROC SETINFR; 
      BEGIN 
      INFRSEEN = TRUE;             # SET *INFRSEEN* TRUE               #
      STDYES; 
      END 
  
#----------------------------------------------------------------------#
  
      XDEF PROC STINVRP;           # SET -INVOKE FOR REPAIR- FLAG      #
      PROC STINVRP; 
      BEGIN 
      REPAIRF = TRUE; 
      STDYES; 
      END 
  
#----------------------------------------------------------------------#
  
     PROC ZEROFILL (WORD);   # TO GET UP TO 7 CHARACTERS FROM CURWORD  #
     BEGIN                   # AND PLACE THEM ZERO-FILLED IN WORD      #
                             # RIGHT JUSTIFIED                         #
          ITEM WORD U;
          C<0,10>WORD = C<0,10>CURWORD; 
          FOR K=0 STEP 1 WHILE C<9, 1> WORD EQ " " DO 
                                       WORD = B<0, 54> WORD;
          RETURN; 
     END
#----------------------------------------------------------------------#
  
END 
TERM
