*DECK     DB$FKLR 
USETEXT CDCSCTX 
      PROC DB$FKLR; 
      BEGIN 
 #
* *   DB$FKLR -- RELEASE A BLOCK IN FKL          PAGE  1
* *   R L MCALLESTER                             DATE  07/28/86 
* 
* DC  PURPOSE 
* 
*     RELEASE AN FPT OR A KEY AREA IN THE FILE KEY LIST.
* 
* DC  ENTRY CONDITIONS
* 
*     P<RSARBLK> IS SET.
*     RSARRQ1 IS TRUE IF AN FPT IS TO BE RELEASED.
*     RSARRQ2 IS TRUE IF PRIMARY KEY SPACE IS TO BE RELEASED. 
*     RSARRQ3 IS TRUE IF ALTERNATE KEY SPACE IS TO BE RELEASED. 
* 
* DC  EXIT CONDITION
* 
*     A BLOCK IS RELEASED IN THE FKL. 
*     THE CORRESPONDING POINTERS ARE CLEARED IN THE AREA CONTROL BLOCK. 
*     THE REQUEST FLAGS RSARRQ1, RSARRQ2 AND RSARRQ3 ARE FALSE. 
* 
* DC  CALLING ROUTINES
* 
*     DB$CLSA                CLOSE AREA 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;           # GENERATE FLOW POINT               #
      XREF PROC DB$PUNT;           # CDCS INTERNAL ERROR               #
      XREF ITEM RJRSW B;           # RESTRICT JOURNAL RECORDS - SWITCH #
# 
* DC  DESCRIPTION 
* 
*     THE STRUCTURE - 
* 
*     MEMORY ALLOCATION WITHIN THE FILE KEY LIST (FKL) IS MAINTAINED
*     BY DB$FKLA AND DB$FKLR. 
*     POINTERS TO THE ALLOCATED BLOCKS ARE KEPT IN THE AREA CONTROL 
*     BLOCKS IN THE RSB.
* 
*     THE FIRST WORD OF THE FKL CONTAINS THE LIST DEFINITION. 
*     FKLEMPTY IS A POINTER TO THE FIRST EMPTY BLOCK. 
*     FKLLENGTH CONTAINS THE LENGTH OF THE FKL. 
* 
*     THE EMPTY BLOCKS ARE CONNECTED BY THE EMPTY BLOCK CHAIN WHICH IS
*     CONTAINED IN THE FIRST WORD OF EACH EMPTY BLOCK.
*     FKLEMPTY IS A POINTER TO THE NEXT EMPTY BLOCK.
*     FKLLENGTH CONTAINS THE LENGTH OF THE EMPTY BLOCK. 
* 
* 
*     THE PROCESS - 
* 
*     EACH OF THE THREE FLAGS IS EXAMINED TO SEE IF MEMORY RELEASE
*     IS REQUESTED.  IF IT IS, THE "RELEASE" PROCEDURE IS CALLED. 
*     THE REQUEST FLAGS ARE CLEARED.
* 
*     "RELEASE" MERGES THE RELEASED BLOCK INTO THE EMPTY CHAIN. 
*     IF THE NEW EMPTY BLOCK IS CONTIGUOUS WITH ANOTHER EMPTY BLOCK,
*     EITHER BEFORE IT OR BEYOND IT, THE EMPTY BLOCKS ARE MERGED INTO 
*     SINGLE EMPTY BLOCK. 
* 
 #
# 
*     LOCAL VARIABLES 
# 
      ITEM BLOCKBASE;        # OFFSET TO BLOCK IN THE FILEKEY LIST     #
      ITEM BLOCKSIZE;        # SIZE OF BLOCK TO BE RELEASED           # 
      ITEM PRIORBLOCK;       # BLOCK POINTING TO THE CURRENT ONE       #
      ITEM XA;               # SCRATCH VARIABLE                        #
  
  
  
#     B E G I N   D B $ F K L R   E X E C U T A B L E   C O D E .      #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("FKLR   "); 
      CONTROL ENDIF;
  
      P<FKL> = RSFFKLLOC[0];
  
      IF RSARRQ1
      THEN
        BEGIN                      # RELEASE AN FPT                   # 
        BLOCKBASE = RSARFPT[0]; 
        IF RJRSW THEN 
          BEGIN 
          BLOCKSIZE = DFFPTSZ1; 
          END 
        ELSE
          BEGIN 
          BLOCKSIZE = DFFPTSZ2; 
          END 
        RELEASE;
        RSARFPT[0] = 0; 
        END 
  
      IF RSARRQ2
      THEN
        BEGIN                      # RELEASE A PRIMARY KEY AREA       # 
        BLOCKBASE = RSARPKO[0]; 
        BLOCKSIZE = RSARPKL[0]; 
        RELEASE;
        RSARPKO[0] = 0; 
        END 
  
      IF RSARRQ3
      THEN
        BEGIN                      # RELEASE AN ALTERNATE KEY AREA    # 
        BLOCKBASE = RSARAKO[0]; 
        BLOCKSIZE = RSARAKL[0]; 
        RELEASE;
        RSARAKO[0] = 0; 
        END 
      RSARREQ[0] = 0;              # CLEAR THE REQUEST FLAGS           #
      RETURN; 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   R E L E A S E          #
#                                                                      #
#**********************************************************************#
  
  
      PROC RELEASE;          # RELEASE A BLOCK IN THE FKL              #
        BEGIN 
        IF BLOCKBASE EQ 0 
        THEN                 # THERE IS NO BLOCK TO BE RETURNED        #
          BEGIN 
          RETURN; 
  
          END 
                             # THE SIZE OF THE RELEASE BLOCK IS IN     #
                             # THE VARIABLE "BLOCKSIZE".               #
                             # THE OFFSET TO THE RELEASE BLOCK IS IN   #
                             # THE VARIABLE "BLOCKBASE".               #
        IF BLOCKBASE GQ FKLLENGTH[0]
        THEN
          BEGIN              # THE BLOCK IS NOT WITHIN THE FKL         #
          DB$PUNT("DB$FKLR"); 
          END 
        FKLWORD[BLOCKBASE] = 0; 
        IF FKLEMPTY[0] GR BLOCKBASE 
        THEN
                             # THERE IS NO PRIOR EMPTY BLOCK           #
                             # LINK THIS ONE FROM WORD ZERO            #
          BEGIN 
          FKLWORD[BLOCKBASE] = 0; 
          FKLLENGTH[BLOCKBASE] = BLOCKSIZE; 
          FKLEMPTY[BLOCKBASE] = FKLEMPTY[0];
          FKLEMPTY[0] = BLOCKBASE;
          END 
        ELSE
          BEGIN 
                             # LOCATE THE PRIOR BLOCK                  #
  
          FOR XA = FKLEMPTY[0] WHILE XA LS BLOCKBASE
          DO
            BEGIN 
            PRIORBLOCK = XA;       # ADVANCE TO THE NEXT EMPTY BLOCK   #
            XA = FKLEMPTY[XA];
            END 
  
          IF PRIORBLOCK + FKLLENGTH[PRIORBLOCK] EQ BLOCKBASE
          THEN
                             # THE PRIOR BLOCK IS CONTIGUOUS           #
                             # MERGE THIS ONE INTO IT.                 #
            BEGIN 
            FKLLENGTH[PRIORBLOCK] = FKLLENGTH[PRIORBLOCK] + BLOCKSIZE;
            BLOCKBASE = PRIORBLOCK; 
            END 
          ELSE
                             # THE PRIOR BLOCK IS NOT CONTIGUOUS       #
                             # LINK THIS ONE FROM IT.                  #
            BEGIN 
            FKLWORD[BLOCKBASE] = 0; 
            FKLLENGTH[BLOCKBASE] = BLOCKSIZE; 
            FKLEMPTY[BLOCKBASE] = FKLEMPTY[PRIORBLOCK]; 
            FKLEMPTY[PRIORBLOCK] = BLOCKBASE; 
            END 
          END 
        XA =  FKLEMPTY[BLOCKBASE];
                             # XA IS THE LOCATION OF THE NEXT BLOCK    #
        IF FKLLENGTH[0] NQ XA 
          AND BLOCKBASE + FKLLENGTH[BLOCKBASE] EQ XA
        THEN
                             # THERE IS A "NEXT BLOCK"                 #
                             # AND IT IS CONTIGUOUS,                   #
                             # MERGE IT WITH THIS ONE                  #
          BEGIN 
          FKLLENGTH[BLOCKBASE] = FKLLENGTH[BLOCKBASE] + FKLLENGTH[XA];
          FKLEMPTY[BLOCKBASE] = FKLEMPTY[XA]; 
          END 
        END 
  
      END 
      TERM
