*DECK     DB$FSAV 
USETEXT CDCSCTX 
      PROC DB$FSAV; 
      BEGIN 
 #
* *   DB$FSAV -- SAVE THE FILE POSITION          PAGE  1
* *   R L MCALLESTER                             DATE  08/08/86 
* *   R L MCALLESTER                             DATE  03/14/88 
* 
* DC  PURPOSE 
* 
*     SAVE THE FILE POSITION THAT IS ASSOCIATED WITH THE USER TQT.
* 
* DC  ENTRY CONDITIONS
* 
*     P<RSB> IS SET.               RUN-UNIT STATUS BLOCK. 
*     P<RSARBLK> IS SET.           RUN-UNIT STATUS BLOCK AREA CONTROL 
*                                  BLOCK. 
*     P<FKL> IS SET.               FILE KEY LIST. 
*     P<FPT> IS SET.               FILE PARAMETER TABLE.
*     P<OFT> IS SET.               OPEN FILE TABLE. 
*     P<UFT> IS SET.               USER FILE TABLE. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE PRIMARY AND ALTERNATE KEYS OF THE CURRENT RECORD HAVE BEEN
*     SAVED IN THE FKL. 
*     SPACE IN THE FKL HAS BEEN ALLOCATED IF NECESSARY. 
* 
* DC  CALLING ROUTINES
* 
*     DB$GET     A RANDOM READ
*     DB$GETN    A SEQUENTIAL READ
*     DB$RSR$    RELATION START 
*     DB$SKF$    SKIP FORWARD 
*     DB$STR$    START
*     DB$STX$    START INDEX
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FKLA;           # ALLOCATE A BLOCK IN THE FKL       #
      XREF PROC DB$FKLR;           # RELEASE A BLOCK IN THE FKL        #
      XREF PROC DB$FLOP;           # IDENTIFY FLOW POINT               #
# 
*     NON-LOCAL VARIABLES 
# 
*CALL FIATDCLS
 #
*     LOCAL VARIABLES 
# 
      ITEM PKL   I;                # PRIMARY KEY LENGTH                #
      ITEM SPL   I;                # SAVED PTREE LENGTH                #
      ITEM XA    I;                # LOOP INDEX                        #
  
      BASED ARRAY BLOCK;           # AAM BLOCK HEADER                  #
        BEGIN 
        ITEM BLOCKID U(01,00,24);  # PRU NUMBER OF THE BLOCK           #
        END 
  
      BASED ARRAY SARRAY;          # ARRAY FOR SOURCE OF MOVE          #
        BEGIN 
        ITEM SW  I(00,00,60);      # FULL WORD                         #
        END 
  
      BASED ARRAY TARRAY;          # ARRAY FOR TARGET OF MOVE          #
        BEGIN 
        ITEM TW  I(00,00,60);      # FULL WORD                         #
        ITEM TST I(00,00,08);      # CURPTR, QFR, QLR, QEI FROM PTREE  #
        END 
  
  
  
#     B E G I N   D B $ F S A V   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("FSAV");
      CONTROL ENDIF;
  
      FPCFPOS[0] = FALSE; 
      P<FIAT> = UFFITFIAT[0]; 
      SPL = 0;                     # PRESET THE SAVED PTREE LENGTH     #
 #
*     IF THE ACCESS KEY IS NOT THE PRIMARY KEY
*     PROCESS AN ALTERNATE KEY. 
 #
      IF FIPOSK1[0] NQ 0
      THEN
        BEGIN 
        XA = (FIPKRKL[0] + 19) / 10;
 #
*       IF THE ALLOCATED ALTERNATE KEY BLOCK IS TOO SMALL FOR 
*       THIS KEY, RELEASE IT. 
 #
        IF RSARAKO[0] NQ 0
          AND RSARAKL[0] LS XA
        THEN
          BEGIN 
          RSARRQ3[0] = TRUE;
          DB$FKLR;
          END 
 #
*       ALLOCATE A NEW ALTERNATE KEY BLOCK IF REQUIRED. 
 #
        IF RSARAKO[0] EQ 0
        THEN
          BEGIN 
          RSARAKL[0] = XA;
          RSARRQ3[0] = TRUE;
          DB$FKLA;
          END 
 #
*       SAVE "POSKEY1" AND THE ALTERNATE KEY. 
 #
        P<SARRAY> = FIALTKA[0] - 1; 
        P<TARRAY> = LOC(FKL) + RSARAKO[0];
  
        FOR XA = XA -1 STEP -1 UNTIL 0
        DO
          BEGIN 
          TW[XA] = SW[XA];
          END 
        END 
      ELSE
 #
*     IF NOT ACCESSING BY ALTERNATE KEY 
*       RELEASE THE ALTERNATE KEY BLOCK IF THERE IS ONE.
 #
        BEGIN 
        IF RSARAKO[0] NQ 0
        THEN
          BEGIN 
          RSARRQ3[0] = TRUE;
          DB$FKLR;
          END 
 #
*       IF THE PRIMARY KEY IS INDEXED SEQUENTIAL
*         SET THE PTREE LENGTH THAT IS TO BE SAVED WITH THE KEY 
 #
        IF UFFITFO[0] EQ DFFITFOIS
        THEN
          BEGIN 
          P<PTREE> = FIPTR5[0]; 
          SPL = PTCURPTR[0] + 1;   # SAVE THE CURRENT PTREE LENGTH     #
          END 
        END 
      PKL = (OFPRIKL[0] + 9) / 10;
      XA = PKL + SPL; 
 #
* 
*     IF THE ALLOCATED PRIMARY KEY BLOCK IS TOO SMALL FOR 
*     THIS KEY AND PTREE, RELEASE IT. 
 #
      IF RSARPKO[0] NQ 0
        AND RSARPKL[0] LS XA
      THEN
        BEGIN 
        RSARRQ2[0] = TRUE;
        DB$FKLR;
        END 
 #
*     ALLOCATE A NEW PRIMARY KEY BLOCK IF REQUIRED. 
 #
      IF RSARPKO[0] EQ 0
      THEN
        BEGIN 
        RSARPKL[0] = XA;
        RSARRQ2[0] = TRUE;
        DB$FKLA;
        END 
 #
*     SAVE THE PRIMARY KEY. 
*         SAVE IT FROM THE FIAT 
*         EXCEPT FOR AK AND DA FILES IF A KEY ADDRESS IS SPECIFIED. 
 #
      P<SARRAY> = FIPRIKA[0]; 
      IF OFPRIKWKP[0] EQ UFFITKWKP[0] 
        AND UFFITKA[0] NQ 0 
        AND SPL EQ 0
      THEN
        BEGIN 
        P<SARRAY> = UFFITKA[0]; 
        END 
      P<TARRAY> = LOC(FKL) + RSARPKO[0];
  
      FOR XA = PKL - 1 STEP -1 UNTIL 0
      DO
        BEGIN 
        TW[XA] = SW[XA];
        END 
 #
*     SAVE THE PTREE IF ACCESSING BY AN "IS" PRIMARY KEY
 #
      IF SPL NQ 0 
      THEN
        BEGIN 
        P<TARRAY> = P<TARRAY> + PKL;
        FOR XA = SPL - 1 STEP -1 UNTIL 0
        DO
          BEGIN 
          TW[XA] = PTREEWRD[XA];
          END 
        P<PTREE> = P<TARRAY>; 
        FOR XA = SPL - 1 STEP -1 UNTIL 0
        DO
          BEGIN 
          IF PTBLKIN[XA] NQ 0      # IF IT IS A CM ADDRESS,            #
          THEN                     # CONVERT IT TO A FILE PRU NUMBER   #
            BEGIN 
            P<BLOCK> = PTCURBADR[XA]; 
            PTCURBLK[XA] = BLOCKID[0];
            END 
          END 
        END 
 #
*     SAVE THE FP (FILE POSITION) FIELD FROM THE FIAT.
*     SAVE THE CURPTR, QFR, QLR AND QEI 
*     FROM THE PTREE OF THE DATA FILE.
 #
      FIFP[0] = UFFITFP[0]; 
      FPFIFP[0] = FIFP[0];
      P<TARRAY> = FIPTR5[0];
      FPFIPST[0] = TST[0];
 #
*     SAVE THE "XFER" BIT.
 #
      FPFIATX[0] = FIXFER[0] ;
      RETURN; 
  
      END 
      TERM
