*DECK DB$SFIT 
USETEXT CDCSCTX 
  PROC DB$SFIT; 
  BEGIN 
 #
* *   DB$SFIT                                    PAGE  1
* *   SET USER-ASSIGNED FIT FOR A PARTICULAR FILE 
* *   W P CEAGLIO                                DATE  3/30/76
* 
* DC  PURPOSE 
* 
*     SETUP REQUIRED FIT FIELDS FOR A READ, WRITE, REWRITE, DELETE, 
*     START REQUEST 
* 
* DC  ENTRY CONDITIONS
* 
*     CDCS COMMON 
* 
*         RCB      FIT FROM USER REQUEST PACKET 
*         FPT      POINTER SET BY CALLER
* 
* DC  EXIT CONDITIONS 
* 
*     THE FOLLOWING FIELDS ARE SET IN THE FPT ENTRY--ES, MKL, KA, KP, 
*     KL,RKW,RKP
* 
*     A BUFFER IS ALLOCATED FOR THE SCHEMA WSA, 
*       AND IF MAPPING IS REQUIRED ON THE SUBSCHEMA 
*       THEN A BUFFER IS ALLOCATED FOR THE SUBSCHEMA WSA. 
* 
* DC  CALLING ROUTINES
* 
* 
*     DB$ACHK    CHECK AREA STATUS BEFORE PROCESSING IT 
*     DB$RCHK    CHECK RECORD STATUS BEFORE DOING I/O 
*     DB$REL$    RELATION READ RANDOM CONTROL SYMBIONT
*     DB$RSR$    RELATION START CONTROL SYMBIONT
* 
* DC  CALLED ROUTINES 
* 
*     DB$KMIF    KEY MAPPING INTERFACE
*     DB$MFA     ALLOCATE A FIXED POSITION BUFFER 
* 
* DC  DESCRIPTION 
* 
*     -  FIELDS IN THE FPT ENTRY ARE SET AS FOLLOWS-- 
* 
*           ES  -- ZERO 
*           KA  -- POINTS TO KEY IN RCB 
*           KP  -- ZERO 
*           KL  -- FROM FIT IN RCB
*           RKW -- FROM FIT IN RCB
*           RKP -- FROM FIT IN RCB
*           MKL -- FROM FIT IN RCB
* 
*     -  IF AN EMBEDDED KEY IS SPECIFIED IN THE RCB, DB$KMIF IS CALLED
*        TO PERFORM ANY REQUIRED MAPPING OF THE KEY.  THIS MAY RESULT 
*        IN CHANGES TO SOME OF THE ABOVE FIT FIELDS.  IF AN ERROR 
*        IN MAPPING THE KEY, CONTROL IS NOT RETURNED TO DB$SFIT.
* 
*     -  IF A BUFFER HAS NOT BEEN ALLOCATED FOR THE SCHEMA WSA, 
*        THEN ALLOCATE A BLOCK, SAVING THE ADDRESS IN THE TQT ENTRY.
* 
*     -  IF MAPPING IS REQUIRED ON THE SUBSCHEMA, AND A BUFFER HAS NOT
*        BEEN ALLOCATED FOR THE SUBSCHEMA WSA, THEN ALLOCATE A BLOCK. 
*        SAVE THE ADDRESS OF THE ALLOCATED BLOCK IN THE TQT ENTRY.
* 
*     -  RETURN TO CALLER.
* 
 #
  
# EXTERNAL REFERENCES                                                  #
  
      XREF PROC DB$ERR;                 # ERROR PROCESSOR              #
      XREF PROC DB$FLOP;                # IDENTIFY FLOW POINT          #
      XREF PROC DB$FLUI;                # FLOW POINT USER-ID           #
      XREF PROC DB$FSET;                # SELECT AND SET A FIT         #
      XREF PROC DB$KMIF;                # KEY MAPPER I/F               #
      XREF PROC DB$MFA;                 # ALLOCATE MEMORY              #
      XREF ARRAY DB$SYMB;               # FUNCTION FLAGS ARRAY         #
        BEGIN 
        ITEM FCSETUFT B(00,01,01);      #TRUE IF UFT FIELDS MUST BE SET#
        END 
  
# LOCAL VARIABLES                                                      #
  
      BASED ARRAY FIT;;                 # DUMMY PARAMETER#
      ITEM BLOCKADDR;                   # ADDRESS OF MEMORY BLOCK      #
      ITEM BLOCKL;                      # LENGTH OF MEMORY BLOCK       #
  
  
  
  
# S T A R T  O F  D B $ S F I T  E X E C U T A B L E  C O D E          #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLUI(" FILE ="); 
        DB$FLUI(OFFIT[0]);     # IDENTIFY THE FILE FOR FLOW POINTS     #
      CONTROL ENDIF;
  
      FPFITES [0] = 0;
      FPFITMKL [0] = 0; 
      IF FCSETUFT[RCFUNC[0]]
      THEN
        BEGIN 
        IF    RCFUNC[0] NQ DFWR2
          AND RCFUNC[0] NQ DFREW
          AND RCFUNC[0] NQ DFDEL
        THEN
          BEGIN 
          FPFITMKL [0] = RCPFITMKL [0]; 
          END 
        FPFITKA[0] = LOC(RCPPAKEY[0]);
        FPFITKP[0] = 0; 
        FPFITKL[0] = RCPFITKL [0];
        FPFITRKW[0] = RCPFITRKW [0];
        FPFITRKP[0] = RCPFITRKP [0];
        FPFITFP[0] = 0; 
        FPFTEX[0] = DFFTEX1;
        IF RCPPAKIO[0] NQ 0 
           AND
           NOT RCPPAKNMF
        THEN
          BEGIN 
          DB$FSET;
          P<FIT> = LOC(UFFIT[0]); 
          DB$KMIF(TRUE,RCPPAKRO[0],RCPPAKIO[0],FIT,0);
          FPFITKA [0] = UFFITKA [0];
          FPFITKEYD [0] = UFFITKEYD [0];
          END 
        END 
      ELSE
        BEGIN 
        FPFITKA [0] = 0;
        END 
# 
*     ALLOCATE WORKING STORAGE AREAS, IF REQUIRED.
* 
*     RETURN IF THE FUNCTION CODE IS NOT ONE THAT REQUIRES BUFFERS. 
# 
      IF    RCFUNC[0] NQ DFRD2
        AND RCFUNC[0] NQ DFRD1
        AND RCFUNC[0] NQ DFWR2
        AND RCFUNC[0] NQ DFREW
        AND RCFUNC[0] NQ DFDEL
        AND RCFUNC[0] NQ DFREL
        AND RCFUNC[0] NQ DFRLS
      THEN
        BEGIN 
        RETURN; 
  
        END 
# 
*     ALLOCATE BUFFERS FOR REWRITE OR WRITE.
# 
      IF RCFUNC[0] EQ DFREW 
        OR RCFUNC[0] EQ DFWR2 
      THEN
      BEGIN 
        IF TQSCWSA[0] EQ 0
        THEN                           # SCHEMA WSA NEEDS ASSIGNMENT   #
          BEGIN 
          BLOCKL = TQSCWSAL[0]; 
          IF BLOCKL LS 0               # IF WSA ASSIGNED ON EACH CALL  #
          THEN
            BEGIN 
            BLOCKL = RCPFITRL[0]; 
            IF RSRCCAPP[0] NQ 0        # IF RECORD MAPPING IS NEEDED...#
            THEN
              BEGIN 
              BLOCKL = OFFITMRL[0]; 
              END 
            END 
          BLOCKL = (BLOCKL+9)/10; 
          DB$MFA(BLOCKL, BLOCKADDR);
          TQSCWSA[0] = BLOCKADDR; 
          END 
        IF RSRCCAPP[0] NQ 0            # IF RECORD MAPPING IS NEEDED...#
        THEN
          BEGIN 
          IF RCPFITRL[0] GR CSFSBREC[0] 
          THEN                         # RL GR MAX SUBSCHEMA RL        #
            BEGIN 
            FPFITES[0] = O"167";       # RL OUTSIDE MIN-MAX RANGE      #
            DB$ERR(12); 
            END 
          IF TQSBWSA[0] EQ 0
          THEN
            BEGIN 
            BLOCKL = RCPFITRL;
            IF TQSCWSAL[0] GQ 0        # IF WSA RETAINED BETWEEN CALLS #
            THEN
              BEGIN 
              BLOCKL = CSFSBREC;
              END 
            BLOCKL = (BLOCKL +9) /10; 
            DB$MFA(BLOCKL, BLOCKADDR);
            TQSBWSA[0] = BLOCKADDR; 
            END 
          RSFSBREC[0] = TQSBWSA[0]; 
          END 
        ELSE
          BEGIN 
          IF RCPFITRL[0] GR OFFITMRL[0] 
          THEN
            BEGIN 
            FPFITES[0] = O"167";       # RL OUTSIDE MIN-MAX RANGE      #
            DB$ERR(12); 
            END 
          RSFSBREC[0] = TQSCWSA[0]; 
          END 
        RSFSBRECL[0] = (RCPFITRL[0] +9) /10;
        RETURN; 
  
        END 
# 
*     IF THE MAXIMUM WORKING STORAGE AREA LENGTH IS NEGATIVE, 
*     EACH REQUEST SHOULD BE ASSIGNED WSA TO FIT ITS IMMEDIATE NEEDS. 
*     THE BUFFERS WILL BE ALLOCATED AND RELEASED FOR EACH REQUEST.
# 
      IF TQSCWSAL[0] LS 0 
      THEN
        BEGIN 
        IF RCFUNC[0] EQ DFREL 
          OR RCFUNC[0] EQ DFRLS 
        THEN                 # ASSIGN FULL BUFFERS IF READ RELATIONS   #
          BEGIN 
          TQSCWSAL[0] = -TQSCWSAL[0]; 
          END 
        ELSE
          BEGIN 
          BLOCKL = (OFFITMRL[0] +9) /10;
          DB$MFA(BLOCKL, BLOCKADDR);
          TQSCWSA[0] = BLOCKADDR; 
          END 
        END 
# 
*     ALLOCATE MAXIMUM SIZE BUFFERS THAT WILL BE RETAINED FROM ONE
*     REQUEST TO THE NEXT.
*     THIS MINIMIZES CRM CALLS AT THE EXPENSE OF MEMORY UTILIZATION.
# 
      IF TQSCWSA[0] EQ 0
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("SFIT-2");
        CONTROL ENDIF;
  
        BLOCKL = (TQSCWSAL[0]+9)/10;
        DB$MFA(BLOCKL, BLOCKADDR);
        TQSCWSA[0] = BLOCKADDR; 
        IF CSFCAPPT[0] NQ 0            # MAPPING REQUIRED ON SUBSCHEMA #
        THEN
          BEGIN 
          BLOCKL = (CSFSBREC[0]+9)/10;
          DB$MFA(BLOCKL, BLOCKADDR);
          TQSBWSA[0] = BLOCKADDR; 
          END 
        END 
  END 
      TERM
