*DECK IMFRUN
USETEXT  TCMMDEF
USETEXT  TENVIRN
USETEXT  TIMF 
USETEXT  TIMFDEF
USETEXT  TSBASIC
PROC IMFRUN;                 #  IMF CAPSULE ENTRY POINTS               #
      BEGIN 
  
  
  
      XREF
          BEGIN 
          PROC CEDMS;         #ISSUE IMF (EDMS) FUNCTION# 
          PROC CEDMS93;       #CLOSE ALL FILES# 
          PROC CEDMS89;       #ACTIVATE ALL FILES#
          PROC CEDMS96;       #CLOSE SUBSCHEMA                         #
          PROC CEDMS97;       #INITIALIZE IMF (EDMS)# 
          PROC CEDMS99;       #SET RECORD UWA#
          PROC EAK$END;       #RELEASE EAK BUFFERS# 
          PROC EFM$END;       #RELEASE EFM BUFFERS# 
          FUNC IMFIF C(10);  # RETURNS IMF INTERFACE LEVEL NUMBER      #
          PROC SEDMR98;       # ACQUIRE SCH TABLES - REPAIR MODE       #
          PROC SEDMS98;       #ACQUIRE SCHEMA/SUBSCHEMA TABLES# 
          PROC SPM$CLS;      # CLOSE BAM                               #
          ITEM INI$FLG B;     #TRUE = IMF NOT INITIALIZED#
          ITEM INT$ACT B;     # TRUE = INTERACTIVE USER#
          ITEM OPN$FLG B;    # TRUE = METASCHEMA TABLES ARE VALID      #
          END 
      XREF ITEM ERR$RVF B;         # TRUE IF REPRIEVE IMPOSSIBLE       #
      XREF ITEM OCM$RLS B;         # TRUE IF IMF SETS OPN$FLG FALSE    #
                                   # AND RELEASES SCHEMA/SUBSCHEMA     #
                                   # TABLE CM IN CASE OF ERROR         #
      XREF ITEM QUESF I;           # CMM ERROR WORD                    #
      XREF ITEM REPAIRF B;         # TRUE IF -INVOKE FOR REPAIR-       #
      XREF ITEM RML$RPV B;         # CALLER SETS TRUE IF HE IS         #
                                   # REPRIEVING, HENCE WANTS CLOSE MSGS#
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC                  #
      XREF PROC READ;              # READ A LINE FROM TERMINAL         #
      XREF PROC REDMS98;           # STORE COMMUNICATION AREA ADDRESS  #
                                   # IN INFOBASE STACK                 #
  
XREF ITEM IMF$GRP I;         # GROUP-ID OF IMF BLOCKS.                 #
                             # SET TO A GROUP-ID WHILE IN OVERLAY 60-0.#
XREF ITEM IMF$QU B;          # TRUE IF IMF IS CALLED BY QU             #
  
XDEF ITEM CMM$LEN I;         # CALLER SETS LENGTH OF DESIRED BLOCK HERE#
XDEF ITEM CMM$ADR I;         # CALLER GETS OR SETS BLOCK ADDRESS HERE  #
  
      ITEM REPLY C(1);             # USER-S RESPONSE                   #
      ITEM TEMP I;                 # SCRATCH VARIABLE                  #
CONTROL EJECT;
  
XDEF FUNC INVOKE$;           # ACQUIRE TABLES                          #
     FUNC INVOKE$ (SCHNAME, SUBNAME, PRIVACY)   C(10);
          BEGIN 
          ITEM SCHNAME C(30); 
          ITEM SUBNAME C(30); 
          ITEM PRIVACY C(30); 
  
          IMF$QU = TRUE;           # IMF IS CALLED BY QU               #
          IF TERMINAL NQ 0         # IF INTERACTIVE USER AT TERMINAL   #
          THEN
            BEGIN 
            INT$ACT = TRUE; 
            END 
  
          IF IMFIF("QU3.3") NQ "V1.0L1"  # IF INCOMPATIBLE LEVEL OF IMF#
          THEN
            BEGIN 
            INVOKE$ = STV$INCOMP;  # INCOMPATIBLE VERSION OF IMF       #
            ERRCODE = STV$INCBIN; 
            RETURN; 
            END 
  
          CEDMS97;            # INITIALISE IN SYMBOLIC MODE#
          IF REPAIRF               # IF -INVOKE FOR REPAIR-            #
          THEN
            BEGIN 
            SEDMR98 (SCHNAME, SUBNAME, PRIVACY, SIC$COP); 
            END 
  
          ELSE
            BEGIN 
            SEDMS98 (SCHNAME, SUBNAME, PRIVACY, SIC$COP); 
            END 
  
          INVOKE$ = USERSTV;
          IF USERSTV EQ STV$OK     # GOOD INVOKE                       #
          THEN
              BEGIN 
              P<SYMSST$> = USERSSST + USERSSSL - SSSTENL; 
              P<SST$> = USERSSCT + USERSSCL - SSTENL; 
              END 
          FREETBL;            #FREE BUFFERS#
          RETURN; 
          END 
#----------------------------------------------------------------------#
  
XDEF FUNC EXEC$;             # ISSUE IMF COMMAND                       #
     FUNC EXEC$ (REC)  C(10); 
          BEGIN 
          ITEM SAVERC U;
          ARRAY REC [0:0] S(1);  ITEM RECORD C(0,0,10); 
  
          IF INI$FLG          #BUFFERS NEED TO BE ALLOCATED#
          THEN
              BEGIN 
              IMF$QU = TRUE;       # IMF IS CALLED BY QU               #
              IF TERMINAL NQ 0     # IF INTERACTIVE USER AT TERMINAL   #
              THEN
                BEGIN 
                INT$ACT = TRUE; 
                END 
  
              CEDMS97;        # INITIALISE IN SYMBOLIC MODE#
              OPN$FLG = TRUE; 
              ERR$RVF = FALSE;     # OK TO REPRIEVE                    #
              OCM$RLS = FALSE;     # DO NOT RELEASE CM ON ERROR        #
              SAVERC = USERRCI; 
              REDMS98 (SIC$COP);   # STORE COMMUNICATION AREA ADDRESS  #
                                   # IN INFOBASE STACK                 #
              ERRCODE = 1;
              FOR TEMP = TEMP      # LOOP UNTIL DATA-FILES ATTACHED    #
                WHILE ERRCODE NQ 0
              DO
                BEGIN 
                CEDMS89 (SIC$COP);  # ACTIVATE ALL FILES               #
                IF ERRCODE NQ 0    # IF ERROR                          #
                THEN
                  BEGIN 
                  REDMS98 (SIC$COP);  # STORE COMMUNICATION AREA ADDR  #
                                      # IN INFOBASE STACK BECAUSE ERROR#
                                      # PROCESSING CLEARED IT          #
                  IF ERRCODE NQ STV$FILEBUSY
                  THEN
                    BEGIN 
                    EXEC$ = USERSTV;  # RETURN ERROR TO CALLER         #
                    RETURN; 
                    END 
  
                  DIAG (261, "DATA-FILE");   # -DATA-FILE- UNAVAILABLE.#
                                             # FILE ATTACHED ELSEWHERE.#
                  DIAG (1004, "DATA-FILE");  # CANT GET -DATA-FILE-.   #
                                             # SHALL WE TRY AGAIN.     #
                  DIAG (1005);               # ANSWER Y OR N-          #
                  READ (REPLY, TEMP, 1, TEMP);  # READ USER-S RESPONSE #
                  IF REPLY EQ "Y"  # IF ANSWER IS YES                  #
                  THEN
                    BEGIN 
                    TEST TEMP;     # GO THROUGH LOOP AGAIN             #
                    END 
  
                  EXEC$ = USERSTV;  # RETURN ERROR TO CALLER           #
                  RETURN;          # NO NEED TO CLEAN UP OR RETURN     #
                                   # OTHER FILES SINCE IMF DOES THIS   #
                  END 
                END                # END TEMP LOOP                     #
  
              USERRCI = SAVERC; 
              END 
          CEDMS99 (REC,SIC$COP);
          CEDMS (SIC$COP);
          EXEC$ = USERSTV;
          RETURN; 
          END 
#----------------------------------------------------------------------#
  
XDEF PROC CLOSE$;            # RELEASE BUFFER SPACE                    #
     PROC CLOSE$; 
          BEGIN 
          IF OPN$FLG               # IF SCHEMA OPEN                    #
          THEN
            BEGIN 
            CEDMS93 (SIC$COP);     # RETURN ALL ACTIVATED FILES        #
            END 
  
          IF NOT INI$FLG           # IF IMF HAS ALLOCATED CM           #
          THEN
            BEGIN 
            FREETBL;               # FREE BUFFERS                      #
            END 
  
          RETURN; 
          END 
#----------------------------------------------------------------------#
  
PROC FREETBL; 
          BEGIN 
          EAK$END;
          EFM$END;
          SPM$CLS;
          INI$FLG = TRUE; 
          RETURN; 
          END 
#----------------------------------------------------------------------#
  
XDEF PROC CMM$RSV;           # IMF CALLS THIS TO GET A CM BLOCK        #
     PROC CMM$RSV;
     BEGIN
          CMM$ADR = CMM$ALF(CMM$LEN, FIXED$LWA, IMF$GRP); 
          RETURN; 
     END
#----------------------------------------------------------------------#
  
XDEF PROC CMM$RLS;           # IMF CALLS THIS TO RELEASE A CM BLOCK    #
     PROC CMM$RLS;
     BEGIN
          CMM$FRF(CMM$ADR); 
          RETURN; 
     END
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A U T O P 6 0                                                    #
#                                                                      #
#     CODE TO EXECUTE IN ORDER TO REPRIEVE AFTER QU HAS ABORTED.       #
#     IT WILL CALL CEDMS93 TO CLOSE FILES IF IT APPEARS NECESSARY      #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC AUTOP60;
      PROC AUTOP60; 
      BEGIN 
      IF OPN$FLG                   # IF SCHEMA OPEN                    #
      THEN
        BEGIN 
        RML$RPV = TRUE;            # REPRIEVING, HENCE WANT CLOSE MSGS #
        CEDMS96 (SIC$COP);         # CLOSE SUBSCHEMA                   #
        END 
  
      IF (ACCESSES + HITS + IOS NQ 0)  # IF SOME IO ACTIVITY           #
      AND QUESF EQ 0               # FL NOT EXHAUSTED                  #
      THEN
        BEGIN 
        DIAG (1006, ACCESSES, HITS, IOS); 
        END 
  
      RETURN; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I N V $ A B S                                                    #
#                                                                      #
#     CONDITIONAL CODE IN QUGEN CAUSES INV$ABS TO BE CALLED INSTEAD    #
#     OF INVOKE$ WHEN IMF IS ABSENT.                                   #
#     RETURNS ERROR 538 TO THE CALLER, CAUSING THE CALLER TO ISSUE     #
#         DIAGNOSTIC                                                   #
#                                                                      #
#         (538) THE QU/IMF INTERFACE IS NOT AVAILABLE                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF FUNC INV$ABS;
      FUNC INV$ABS C(10); 
      BEGIN 
      INV$ABS = STV$ABSENT;        # THE QU-IMF INTERFACE IS NOT       #
                                   # AVAILABLE                         #
      ERRCODE = STV$ABSBIN; 
      RETURN; 
      END                          # END PROC    INV$ABS               #
  
  
  
      END 
      TERM
