Power-Programmierung/CD1.mdf/pascal/library/dos/btree/tree/btree1.inc

Text File | 1989-06-27 | 54.1 KB | 1,259 lines

(*****************************************************************************)
(*                                                                           *)
(*   I N S E R T  /  D E L E T E  /  M I S C    B T R E E   R O U T I N E S  *)
(*                                                                           *)
(*****************************************************************************)

(* These definitions and routines are the 'guts' of the BTREE unit.  This
   contain all routines which manipulate the index nodes (physical records)
   and bitmaps, put values and logical record numbers in and out of the
   indexes and perform other important functions.  Most of the routines in
   this file are internal to the BTREE unit, although several are not.       *)

const
    NULL     : RecordNumber = 0;                   (* used to dilineate null
                                                               record number *)

type
    NodeType = (INVALIDNODETYPE,INDEXNODE,SEQUENCENODE);
                             (* INVALIDNODETYPE is not used for anything.
                                It serves one purpose.  It gives positive
                                values to the two remaining legal values
                                for this enumerated type.  I didn't want
                                to have zero be valid.  This helped in
                                debugging and there is no reason to
                                change it.                                   *)


(* These parameters are contained in the first record (0) in the index file

     variable        parameter               type         range
     --------        ---------               ----         -----
      userData       user data array      UserDataArray   N/A
      version        version info         VersionString   N/A
      nextAvail      next available node  NodePtrType     0 - MAXLONGINT
      firstBMRec     first bitmap record  PrNumber        0 - MAXLONGINT
      lastBMRec      last bitmap record   PrNumber        0 - MAXLONGINT
      fType          file type              FileTypes       INDEX,DATA,
                                                            LLIST,VLRDATA
      vSize          value size           Byte            1 - 245
      dummy          place holder         Byte            N/A
      rNode          root node            Longint         1 - MAXLONGINT
      fSNode         first sequence node  Longint         1 - MAXLONGINT
      lSNODE         last  sequence node  LongInt         1 - MAXLONGINT
      vType          value type           Byte            0 = INVALIDVALUE
                                                          1 = BYTEVALUE
                                                          2 = SHORTINTVALUE
                                                          3 = INTEGERVALUE
                                                          4 = LONGINTVALUE
                                                          5 = WORDVALUE
                                                          6 = STRINGVALUE
                                                          7 = REALVALUE
                                                          8 = SINGLEVALUE
                                                          9 = DOUBLEVALUE
                                                         10 = EXTENDEDVALUE
                                                         11 = COMPVALUE
                                                         12 = BYTEARRAYVALUE
      cursor         tree cursor info     TreeCursor     N/A                 *)

(*\*)
type
    NodePtrType   = PrNumber;                (* pointer to index records     *)

    TreeCursor = record
         prNum : PrNumber;
         entryNum : Byte;
         valid : boolean;
         end;

    ParameterRecord = record
         userData   : UserDataArray;                     (* for use by users *)
         version    : VersionString;               (* version of TBTREE used
                                                             to create index *)
         nextAvail  : NodePtrType;        (* next index node available       *)
         firstBMRec : PrNumber;           (* first record used for bitmap    *)
         lastBMRec  : PrNumber;           (* last record used for bitmap     *)
         fType      : FileTypes;          (* type of file                    *)
         vSize      : VSizeType;
         dummy      : Byte;               (* This came about because of the
                                             change in the definition of
                                             vSize.  vSize was previously
                                             defined to be in the range 1 ..
                                             494 but has been changed to be
                                             between 1 and 245.  It used to
                                             take up a word, now it takes up
                                             only a byte.  dummy serves as a
                                             place holder so that the rest of
                                             the parameter record would not
                                             shift one byte to the left.     *)
         rNode      : NodePtrType;
         fSNode     : NodePtrType;
         lSNode     : NodePtrType;
         vType      : ValueType;
         cursor     : TreeCursor;
         end;


(* These parameters is found in every index and sequence node in the index
   file.

     variable      parameter       location   size   type    range
     --------      ---------       --------   ----   ----    -----
      prev         prev sequence     503        4    int     -1 - MAXINT
                      node

      next         next sequence     507        4    int     -1 - MAXINT
                      node

      nType        node type         511        1    Byte    0 = INVALIDNODETYPE
                                                             1 = INDEXNODE
                                                             2 = SEQUENCENODE

      vCnt         value count       512        1    Byte    1 - MAXBYTE     *)


const
    PREVLOC   = 503;
    NEXTLOC   = 507;
    NTYPELOC  = 511;
    VCNTLOC   = 512;
    MAXUSABLE = 502;  (* how much can be used for entries and record numbers *)


var
    mustMoveCursor : Boolean;

(*\*)
(* This routine will return the record number for the first unused index
   record (node).  If the first unused node is the first used bitmap record
   then the bitmap records will be moved down to free up disk space.  The
   number of physical pages freed up depends on the size of the index file   *)

function FirstUnusedIndexRecord(var iFName : FnString;
                                                       (* var for speed only *)
                                var pRec : ParameterRecord) : NodePtrtype;

var
    prNum : PrNumber;
    byteNum : PageRange;
    bitNum : BytePosition;
    newRecord : NodePtrType;                 (* record number to be returned *)
    recsToMove : PrNumber;

    begin
    newRecord := pRec.nextAvail;                  (* record number to return *)
    pRec.nextAvail := FindNextAvailInBitmap(iFName,pRec.firstBMRec,
                                            pRec.lastBMRec,newRecord);
    if newRecord = pRec.firstBMRec then
        begin                                 (* need to move bitmap records *)
        if newRecord <= 4 then
            begin
            recsToMove := 1;
            end
        else
            begin
            if newRecord <= 10 then
                begin
                recsToMove := 3;
                end
            else
                begin
                recsToMove := 5;
                end;
            end;
        MoveRecords(iFName,pRec.firstBMRec,pRec.lastBMRec,recsToMove);
        end;
    FirstUnUsedIndexRecord := newRecord;         (* record number to return *)
    end;                            (* end of FirstUnusedIndexRecord routine *)

(*\*)
(* This routine will delete a node from the index file by setting the
   appropriate bitmap bit to zero                                            *)

procedure DeleteIndexRecord(var iFName : FnString;     (* var for speed only *)
                            thisNode : NodePtrType;
                            var pRec : ParameterRecord);

var
    page : SinglePage;

    begin
    SetBitInBitmap(iFName,pRec.firstBMRec,thisNode,0);     (* mark as unused *)
    ReleasePage(iFName,thisNode);  (* more for efficiency  .. not required   *)
    if thisNode < pRec.nextAvail then
        begin
        pRec.nextAvail := thisNode;
        end;
    end;                                 (* end of DeleteIndexRecord routine *)

(*\*)
(* This routine will insert a node between prevNode and nextNode in a node list.
   It will accomplish this by setting the prev and next ptrs as necessary
   for a node and its prev and next nodes.  Obviously, the node ptr and the
   next and prev node pointers must be known.  If the node type is
   SEQUENCENODE and this node is the first node in the sequential list, the
   parameter record will be updated to reflect this change (the sNode parameter
   will be set to this node ).                                               *)

procedure InsertNodeInList(var iFName : FnString;      (* var for speed only *)
                           thisNode : NodePtrType;
                           var prevNode;
                           var nextNode;
                           var pRec : ParameterRecord);

var
    page : SinglePage;
    tempPrevNode,
    tempNextNode : NodePtrType;

    begin
    Move(prevNode,tempPrevNode,RNSIZE);
    Move(nextNode,tempNextNode,RNSIZE);
    FetchPage(iFName,thisNode,page);
    Move(prevNode,page[PREVLOC],RNSIZE);
    Move(nextNode,page[NEXTLOC],RNSIZE);
    StorePage(iFName,thisNode,page);
    if tempPrevNode <> NULL then
        begin
        FetchPage(iFName,tempPrevNode,page);
        Move(thisNode,page[NEXTLOC],RNSIZE);
        StorePage(iFName,tempPrevNode,page);
        end
    else
        begin                               (* new node is first node *)
        if page[NTYPELOC] = Byte(SEQUENCENODE) then
            begin             (* set first seq node pointer to this new node *)
            pRec.fSNode := thisNode;
            end;
        end;
    if tempNextNode <> NULL then
        begin
        FetchPage(iFName,tempNextNode,page);
        Move(thisNode,page[PREVLOC],RNSIZE);
        StorePage(iFName,tempNextNode,page);
        end
    else
        begin                                       (* new node is last node *)
        if page[NTYPELOC] = Byte(SEQUENCENODE) then
            begin              (* set last seq node pointer to this new node *)
            pRec.lSNode := thisNode;
            end;
        end;
    end;                                  (* end of InsertNodeInList routine *)

(*\*)
(* This routine will delete a node from a node list and set its neighbors prev
   and next node pointers as appropriate.  It will also delete the record from
   the index file to allow it to be reused.                                  *)

procedure DeleteNodeFromList(var iFName : FnString;    (* var for speed only *)
                             thisNode : NodePtrType;
                             var pRec : ParameterRecord);

var
    page : SinglePage;
    prevNode,
    nextNode : NodePtrType;

    begin
    FetchPage(iFName,thisNode,page);
    Move(page[PREVLOC],prevNode,RNSIZE);                (* get Prev node ptr *)
    Move(page[NEXTLOC],nextNode,RNSIZE);                (* get Next node ptr *)
    if prevNode <> NULL then
        begin
        FetchPage(iFName,prevNode,page);
        Move(nextNode,page[NEXTLOC],RNSIZE);
        StorePage(iFName,prevNode,page);
        end
    else
        begin
        if NodeType(page[NTYPELOC]) = SEQUENCENODE then
            begin
            pRec.fSNode := nextNode;
            end;
        end;
    if nextNode <> NULL then
        begin
        FetchPage(iFName,nextNode,page);
        Move(prevNode,page[PREVLOC],RNSIZE);
        StorePage(iFName,nextNode,page);
        end
    else
        begin
        if NodeType(page[NTYPELOC]) = SEQUENCENODE then
            begin
            pRec.lSNode := nextNode;
            end;
        end;
    DeleteIndexRecord(iFName,thisNode,pRec);          (* get rid of phys rec *)
    end;                                        (* end of DeleteNodeFromList *)

(*\*)
(* This routine will create a new node and set the node type parameter
   and will insert this node between the prev node and the next node
   in the node linked list.  Remember, this level linked list is required to
   facilitate deletions.                                                     *)

function CreatedNode(var iFName : FnString;            (* var for speed only *)
                     var prevNode;
                     var nextNode;
                     nType : NodeType;
                     var pRec : ParameterRecord) : NodePtrType;

var
    page : SinglePage;
    newNode : NodePtrType;

    begin
    newNode := FirstUnUsedIndexRecord(iFName,pRec);
    FillChar(page,PAGESIZE,0);
    page[NTYPELOC] := Byte(nType);                      (* set the node type *)
    StorePage(iFName,newNode,page);    (* will create new node automatically *)
    InsertNodeInList(iFName,newNode,prevNode,nextNode,pRec);
    CreatedNode := newNode;         (* return the node ptr for this new node *)
    end;                                       (* end of CreatedNode routine *)

(*\*)
(* This routine will create an index file with the file name as specified
   by iFName.  The valSize parameter specifies the size of the index
   entries.  The easiest way to determine this is to use the SizeOf
   function.  The valType parameter specifies the type for the index
   entries.  The types supported are those enumerated by the ValueType
   enumerated type.

   note - Extremely important - WARNING - for STRINGVALUE indexes only - the
   valSize must be 1 greater than the number of characters of the longest
   string.  This will allow 1 byte for the string length to be stored.
   for example - if 'abc' is the longest string then valSize = 4.            *)

procedure CreateIndexFile(iFName : FnString;
                          valSize : VSizeType;
                          valType : ValueType);

var
    pRec : ParameterRecord;
    page : SinglePage;

    begin
    CreateGenericFile(iFName);
    FillChar(page,PAGESIZE,0);
    StorePage(iFName,0,page);                            (* parameter record *)
    StorePage(iFName,1,page);                               (* bitmap record *)
    FillChar(pRec.userData,SizeOf(pRec.userData),0);
    pRec.version := CURRENTVERSION;
    pRec.nextAvail  := 1;
    pRec.firstBMRec := 1;
    pRec.lastBMRec  := 1;
    pRec.fType := INDEX;
    pRec.vSize := valSize;
    pRec.dummy := 0;
    pRec.rNode := CreatedNode(iFName,NULL,NULL,INDEXNODE,pRec);      (* create
                                                                        root *)
    pRec.fSNode := NULL;
    pRec.lSNode := NULL;
    pRec.fSNode := CreatedNode(iFName,NULL,NULL,SEQUENCENODE,pRec);  (* create
                                                         first Sequence node *)
    FetchPage(iFName,pRec.rNode,page);                      (* get root page *)
    Move(pRec.fSNode,page[1],RNSIZE);                (* put seq node in root *)
    StorePage(iFName,pRec.rNode,page);                     (* store the root *)
    pRec.vType := valType;
    pRec.cursor.prNum := 0;
    pRec.cursor.entryNum := 0;
    pRec.cursor.valid := FALSE;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));          (* write parameters
                                                              back to buffer *)
    end;                                       (* end of CreateIndex routine *)

(*\*)
(* This routine will delete an index file.                                   *)

procedure DeleteIndexFile(iFName : FnString);

    begin
    DeleteGenericFile(iFName);
    end;                                   (* end of DeleteIndexFile routine *)

(* This routine will calculate and return the proper byte pointer position for
   the given entry number.  The byte pointer position will be equal to the
   location of the node pointer, not the value.                              *)

function BytePointerPosition(cnt : Byte;
                             vSize : VSizeType) : PageRange;

    begin
    BytePointerPosition := ((cnt - 1) * (vSize + RNSIZE)) + 1;
    end;                                       (* end of BytePointerPosition *)

(*\*)
(* This routine will return the entry number for the first entry in the node
   which has a value equal to paramValue.  If no value matches paramValue, the
   first entry which has a value greater than paramValue will be returned.  If
   paramValue is greater than the last value in the node, then the last entry
   number + 1 will be returned.  The routine will return 0 iff the particular
   node contains no entries.                                                 *)

function BinarySearchEntry(var pg : SinglePage;        (* var for speed only *)
                           var paramValue;
                           var pRec : ParameterRecord  (* var for speed only *)
                           ) : Byte;

var
    startCnt,
    midCnt,
    maxCnt : Byte;

    begin
    maxCnt := pg[VCNTLOC];
    if maxCnt = 0 then
        begin
        BinarySearchEntry := 0;
        Exit;
        end;
    if CompareValues(pg[RNSIZE + 1],paramValue,pRec.vType) <> LESSTHAN then
        begin
        BinarySearchEntry := 1;
        Exit;
        end;
    if CompareValues(pg[((maxCnt - 1) * (pRec.vSize + RNSIZE)) +
                         RNSIZE + 1],
                     paramValue,
                     pRec.vType) = LESSTHAN then
        begin
        BinarySearchEntry := maxCnt + 1;
        Exit;
        end;
    startCnt := 1;
    while startCnt < (maxCnt - 1) do
        begin
        midCnt := (maxCnt + startCnt) Div 2;
        if CompareValues(pg[((midCnt - 1) * (pRec.vSize + RNSIZE)) +
                         RNSIZE + 1],
                         paramValue,
                         pRec.vType) = LESSTHAN then
            begin
            startCnt := midCnt;
            end
        else
            begin
            maxCnt := midCnt;
            end;
        end;
    BinarySearchEntry := maxCnt;
    end;                                 (* end of BinarySearchEntry routine *)

(*\*)
(* This routine will search an index node and return the record number for the
   next lower node corresponding to the paramValue.  The returned node will
   either be another index node or a sequence node.

   Note : this assumes that there are lower nodes.  Prior to calling this
   routine check for an empty root                                           *)

function FindNextLevelPtr(var page : SinglePage;       (* var for speed only *)
                          var paramValue;
                          var pRec : ParameterRecord   (* var for speed only *)
                          ) : NodePtrType;

 var
     cnt : Byte;
     bytePtr : PageRange;
     p : NodePtrType;                 (* temporarily holds pointer to return *)

     begin
     cnt := BinarySearchEntry(page,paramValue,pRec);
     if cnt = 0 then
         begin
         bytePtr := 1;
         end
     else
         begin
         bytePtr := BytePointerPosition(cnt,pRec.vSize);
         end;
     Move(page[bytePtr],p,RNSIZE);                     (* ptr to be returned *)
     FindNextLevelPtr := p;
     end;                                 (* end of FindNextLevelPtr routine *)

(*\*)
(* This recursive routine will start at the specified node (rNum) and work
   down the tree until the correct sequence node is found.  It will return
   the record number of the sequence node.

   This routine assumes that as long as an index node is not empty, there
   should be one more pointer than there are values.  In other words, there
   is always a trailing valid pointer which takes care of the case of values
   larger than the largest value in the tree.

   This routine also assumes that some sequence node exists.  This will not
   work for an empty root.  This must be checked by caller.                  *)

Function FindSNode(var iFName : FnString;              (* var for speed only *)
                   rNum : NodePtrType;
                   var paramValue;
                   var pRec : ParameterRecord          (* var for speed only *)
                   ) : NodePtrType;

var
    page : SinglePage;

    begin
    FetchPage(iFName,rNum,page);                                 (* get node *)
    if NodeType(page[NTYPELOC]) = INDEXNODE then
        begin
        FindSNode := FindSNode(iFName,
                               FindNextLevelPtr(page,paramValue,pRec),
                               paramValue,pRec);
        end
    else
        begin
        FindSNode := rNum;
        end;
    end;                                        (* end of FindSNode function *)

(*\*)
(* This function locates the value within the index and returns a list of
   logical record numbers for this associated value.  It accomplishes this by
   using FindSNode to locate the sequence node.  It will fetch the sequence
   set node and search until the target key is found or it is determined that
   it does not exist (no entry).  If it is found all lrNumbers with a matching
   target key value will be returned in lrLst.  If the matching key value is
   not found then an empty list will be returned.                            *)

procedure GetEqualsFromBTree(var iFName : FnString;    (* var for speed only *)
                             var paramValue;
                             var lrLst : LrList;
                             var pRec : ParameterRecord (* var for speed only *)
                             );

var
    next : PrNumber;          (* used as pointer to next sequence node *)
    page : SinglePage;
    done : Boolean;
    cnt,                      (* used to count number of values *)
    vCnt : Byte;              (* count of values in a node *)
    lrNum : LrNumber;
    bytePtr : PageRange;      (* used to keep track of current byte *)

    begin
    CreateLrList(lrLst);
    FetchPage(iFName,
              FindSNode(iFName,pRec.rNode,paramValue,pRec),
              page);
    vCnt := page[VCNTLOC];
    cnt := BinarySearchEntry(page,paramValue,pRec);
    if (cnt <> 0) and (cnt <= vCnt) then
        begin                                                 (* value found *)
        Move(page[NEXTLOC],next,RNSIZE);
        bytePtr := BytePointerPosition(cnt,pRec.vSize);
        done := FALSE;
        while not done do
            begin
            if CompareValues(paramValue,
                             page[bytePtr+RNSIZE],
                             pRec.vType) = EQUALTO then
                begin
                Move(page[bytePtr],lrNum,RNSIZE);
                AddToLrList(lrNum,lrLst);
                if cnt = vCnt then
                    begin
                    if next <> NULL then              (* if next is not null *)
                        begin                      (* then get next seq node *)
                        cnt := 1;       (* need to continue in case there is *)
                        bytePtr := 1;             (* more than one occurrence
                                                              for this value *)
                        FetchPage(iFName,next,page);
                        vCnt := page[VCNTLOC];
                        Move(page[NEXTLOC],next,RNSIZE);
                        end
                    else
                        begin                           (* no more seq nodes *)
                        done := TRUE;
                        end;
                    end
                else
                    begin
                    bytePtr := bytePtr + pRec.vSize + RNSIZE;
                    Inc(cnt);
                    end;
                end
            else
                begin
                done := TRUE;           (* this will get us out of this loop *)
                end;
            end;
        end;
    end;                                (* end of GetEqualsFromBTree routine *)

(*\*)
(* This routine inserts a new value into a node.  It will locate the
   proper place, move all values and pointers past the spot to allow room for
   the new value and pointer, and insert the new value and pointer.  If there
   is a value equal to this new value, the new value will be inserted in
   front of the old one.  This routine will not work if there is not enough
   room in the node.  This must be checked prior to calling this routine.
   This routine works with both sequence and index nodes.  It assumes that the
   proper page has been read in prior to this routine being called.  This is
   why a page is passed in as a parameter in lieu of physical record number.

   This works for both index and sequence nodes                              *)

procedure InsertValueIntoNode(var page : SinglePage;
                              var paramValue;
                              rNum : RecordNumber;
                              var pRec : ParameterRecord);

var
    cnt,
    vCnt : Byte;
    bytePtr : PageRange;

    begin
    vCnt := page[VCNTLOC];                               (* get value count *)
    cnt := BinarySearchEntry(page,paramValue,pRec);
    if cnt = 0 then
        begin                                              (* node is empty *)
        bytePtr := 1;
        end
    else
        begin
        bytePtr := BytePointerPosition(cnt,pRec.vSize);
        end;
    FastMover(page[bytePtr],                                    (* make room *)
              page[bytePtr + pRec.vSize + RNSIZE],
              (((vCnt - cnt) + 1) * (pRec.vSize + RNSIZE)) + RNSIZE);
    Move(rNum,page[bytePtr],RNSIZE);                       (* insert pointer *)
    FastMover(paramValue,page[bytePtr + RNSIZE],pRec.vSize);   (*insert value*)
    page[VCNTLOC] := vCnt + 1;                            (* new value count *)
    if mustMoveCursor and (cnt <= pRec.cursor.entryNum) then
        begin
        Inc(pRec.cursor.entryNum);
        end;
    end;                               (* end of InsertValueIntoNode routine *)

(*\*)
(* This function will check to see if there is room to insert a new value into
   any type node.  If room exists then a routine is called to insert the
   node into the proper place.  The result is returned (True or False)
   This routine assumes that the proper page has been read in prior to this
   routine being called.  This is why page number is used in lieu of physical
   record number.                                                            *)

function InsertedInNode(var page : SinglePage;
                        var paramValue;
                        rNum : RecordNumber;
                        var pRec : ParameterRecord) : Boolean;

var
    maxValues : Byte;

    begin
    maxValues := (MAXUSABLE - RNSIZE) Div (pRec.vSize + RNSIZE);
    if page[VCNTLOC] < maxValues then
        begin
        InsertValueIntoNode(page,paramValue,rNum,pRec);
        InsertedInNode := TRUE;
        end
    else
        begin
        InsertedInNode := FALSE;
        end;
    end;                                    (* end of InsertedInNode routine *)

(*\*)
(* This routine will move n/2 (rounded down) values from the right node
   (rtNode) to the empty left node (ltNode).                                 *)

procedure MoveValues(var iFName : FnString;            (* var for speed only *)
                     var rtPage : SinglePage;
                     var ltPage : SinglePage;
                     ltNode : NodePtrType;
                     var pRec : ParameterRecord);

var
    bytesToMove,                            (* total number of bytes to move *)
    numToMove,                                   (* number of values to move *)
    vCnt : Byte;                            (* count of values in right node *)

    begin
    vCnt := rtPage[VCNTLOC];                       (* get right node's count *)
    numToMove := vCnt Div 2;
    bytesToMove := (RNSIZE + pRec.vSize) * numToMove;     (* calc # of bytes
                                                                     to move *)
    FastMover(rtPage[1],ltPage[1],bytesToMove);
    FastMover(rtPage[bytesToMove + 1],rtPage[1],MAXUSABLE - bytesToMove);
    Dec(vCnt,numToMove);
    if NodeType(rtPage[NTYPELOC]) = INDEXNODE then
        begin
        FillChar(rtPage[(vCnt * (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
                 numToMove * (pRec.vSize + RNSIZE),
                 0);
        end
    else
        begin
        FillChar(rtPage[(vCnt * (pRec.vSize + RNSIZE)) + 1],
                 numToMove * (pRec.vSize + RNSIZE),
                 0);
        end;
    rtPage[VCNTLOC] := vCnt;
    ltPage[VCNTLOC] := numToMove;
    if mustMoveCursor then
        begin
        if numToMove < pRec.cursor.entryNum then
            begin
            Dec(pRec.cursor.entryNum,numToMove);
            end
        else
            begin
            pRec.cursor.prNum := ltNode;
            end;
        end;
    end;                                        (* end of MoveValues routine *)

(*\*)
(* This recursive routine will start at a given node (usually the root) and
   follow the tree down until the correct sequence node is found.  The new
   value and record number will be inserted into the correct sequence node.
   In the event that the sequence node is full, the node will be split.  The
   value and record number will be put in the proper node if a split occurs.
   The routine will return NULL if no split occurs.  If a split occurs, the
   record number (node pointer) of the newly created node will be returned.
   This new node will be inserted in the parent index node.  If it won't
   fit the index node will be split and the new child record number will
   be inserted in the proper index node.  The value associated with the child
   record number is the largest value in the newly created child node.  This
   process continues until we bubble back to the root in the node.  Once at
   the root the routine will return back to the original caller.  If the root
   was not split then NULL will be returned.  If the root was split, then the
   newly created child record number is returned.  The caller will have to
   create a new root node and insert the new value and the child record
   number.  Be sure that the caller also inserts the newly inserted child's
   right sibling (record number only) since all indexes have one more pointer
   than they do values.

   This routine expects at least one pointer in the root.  This needs to be
   checked by the caller.                                                    *)

function InsertValue(var iFName : FnString;            (* var for speed only *)
                     rNum : RecordNumber;    (* record number to be inserted *)
                     var paramValue;         (* value to be inserted *)
                     thisNode : NodePtrType; (* node *)
                     var pRec : ParameterRecord) : NodePtrType;

var
    newNode,                    (* newly created node if needed (node split) *)
    lowerNode : NodePtrType;
    thisPage,
    newPage,
    lowerPage : SinglePage;
    lastValLoc : PageRange;       (* used to hold buffer position *)

    begin
    FetchPage(iFName,thisNode,thisPage);
    case NodeType(thisPage[NTYPELOC]) of
        INDEXNODE:
            begin
            lowerNode := InsertValue(iFName,rNum,paramValue,
                                     FindNextLevelPtr(thisPage,paramValue,
                                                      pRec),pRec);
            if lowerNode <> NULL then
                begin                     (* lower node must have been split *)
                FetchPage(iFName,lowerNode,lowerPage);
                lastValLoc := (((lowerPage[VCNTLOC] - 1)
                              * ( pRec.vSize + RNSIZE)) + RNSIZE) + 1;
                if InsertedInNode(thisPage,lowerPage[lastValLoc],
                                  lowerNode,pRec) then
                    begin
                    InsertValue := NULL;    (* node not split .. return NULL *)
                    end
                else
                    begin
                    newNode := CreatedNode(iFName,
                                           thisPage[PREVLOC],
                                           thisNode,
                                           INDEXNODE,
                                           pRec);
                    FetchPage(iFName,thisNode,thisPage);         (* required *)
                    FetchPage(iFName,newNode,newPage);
                    MoveValues(iFName,thisPage,newPage,newNode,pRec);
                    if CompareValues(paramValue,thisPage[RNSIZE + 1],
                                     pRec.vType) = GREATERTHAN then
                        begin
                        InsertValueIntoNode(thisPage,
                                            lowerPage[lastValLoc],
                                            lowerNode,pRec);
                        end
                    else
                        begin
                        InsertValueIntoNode(newPage,
                                            lowerPage[lastValLoc],
                                            lowerNode,pRec);
                        end;
                    StorePage(iFName,newNode,newPage);
                    InsertValue := newNode;      (* newly added node will be
                                                    returned                 *)
                    end;
                StorePage(iFName,thisNode,thisPage);
                end
            else
                begin
                InsertValue := NULL;    (* it fit at lower level therefore
                                           this level is fine .. return NULL *)
                end;
            end;
        SEQUENCENODE :
            begin
            mustMoveCursor := pRec.cursor.valid and
                              (pRec.cursor.prNum = thisNode);
            if InsertedInNode(thisPage,paramValue,rNum,pRec) then
                begin
                InsertValue := NULL;   (* it fits .. no split .. return NULL *)
                end
            else
                begin
                newNode := CreatedNode(iFName,
                                       thisPage[PREVLOC],
                                       thisNode,
                                       SEQUENCENODE,
                                       pRec);
                FetchPage(iFName,thisNode,thisPage);             (* required *)
                FetchPage(iFName,newNode,newPage);
                MoveValues(iFName,thisPage,newPage,newNode,pRec);
                if CompareValues(paramValue,thisPage[RNSIZE + 1],
                                 pRec.vType) = GREATERTHAN then
                    begin
                    InsertValueIntoNode(thisPage,paramValue,rNum,pRec);
                    end
                else
                    begin
                    InsertValueIntoNode(newPage,paramValue,rNum,pRec);
                    end;
                StorePage(iFName,newNode,newPage);
                InsertValue := newNode;
                end;
            StorePage(iFName,thisNode,thisPage);
            mustMoveCursor := FALSE;
            end;
        end;                                   (* end of case statement      *)
    end;                                       (* end of InsertValue routine *)

(*\*)
(* This routine will insert a value and its associated logical record number
   into the given index file.  This routine will guard against duplicate
   entries. An index should have no more than one occurence of any
   lrNum,paramValue pair (no two entries match on paramValue and lrNum).  This
   routine assures this by calling DeleteValueFromBTree prior to performing
   the insert.  This will get rid of a previous occurence if it exists.      *)

procedure InsertValueInBTree(iFName : FnString;
                             lrNum : LRNumber;
                             var paramValue);

var
    lowerNode : PrNumber;
    pRec : ParameterRecord;
    lowerPage,
    page : SinglePage;             (* used for root and first seq node pages *)
    lastValLoc : PageRange;                  (* used to hold buffer position *)

    begin
    DeleteValueFromBTree(iFName,lrNum,paramValue);   (* ensure no duplicates *)
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    lowerNode := InsertValue(iFName,lrNum,paramValue,pRec.rNode,pRec);
    if lowerNode <> NULL then
        begin                                (* we need to create a new root *)
        pRec.rNode := CreatedNode(iFName,NULL,NULL,INDEXNODE,pRec);
                                                    (* root has  no siblings *)
        FetchPage(iFName,pRec.rNode,page);                  (* get root node *)
        FetchPage(iFName,lowerNode,lowerPage);             (* get child node *)
        lastValLoc := (((lowerPage[VCNTLOC] - 1)
                         * ( pRec.vSize + RNSIZE)) + RNSIZE) + 1;
        Move(lowerPage[NEXTLOC],page[1],RNSIZE);
                                               (* insert ptr for right child *)
        InsertValueIntoNode(page,                  (* insert child into root *)
                            lowerPage[lastValLoc],
                            lowerNode,pRec);
        StorePage(iFName,pRec.rNode,page);
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    end;                 (* end of InsertValueInBTree routine *)

(*\*)
(* This routine will locate and delete a value and its associated record
   pointer from within a node/list of nodes.  It will first locate the value.
   The value will be found in this node or in succeeding nodes. The search will
   continue until the value and the correct associated record number are found
   or it is determined that it does not exist.If the correct value and record
   number are not found then the routine will return false indicating that no
   value was deleted.  If the correct value and record number are found they
   will be deleted.  In this case the node where the value was deleted from
   will be returned.  If the value deleted was the last in the node or the
   only one in the node these facts will be returned.  This is important
   because the calling node may have to alter or delete values as a result.

   note : if a node is the last node in a level node list the node will not
   be deleted.  In this case the value will be deleted but last will be set
   to FALSE.  This is because the parent needs to make no adjustment.        *)

function DeleteValueFromNode(var iFName : FnString;    (* var for speed only *)
                             rNum : RecordNumber;
                             var paramValue;
                             var thisNode : NodePtrType;
                             var pRec : ParameterRecord;
                             var last : Boolean;
                             var nodeDeleted : Boolean) : Boolean;

var
    done : Boolean;
    cnt,
    vCnt : Byte;
    bytePtr : PageRange;
    page : SinglePage;
    nextNode : NodePtrType;
    recNum : RecordNumber;

    begin
    FetchPage(iFName,thisNode,page);             (* fetch page for this node *)
    vCnt := page[VCNTLOC];                                (* get value count *)
    cnt := BinarySearchEntry(page,paramValue,pRec);
    if (cnt <> 0) and (cnt <= vCnt) then
        begin
        bytePtr := BytePointerPosition(cnt,pRec.vSize);
        done := FALSE;
        end
    else
        begin
        DeleteValueFromNode := FALSE;
        last := FALSE;
        nodeDeleted := FALSE;
        done := TRUE;
        end;
    while not done do
        begin
        if CompareValues(paramValue,
                         page[bytePtr + RNSIZE],
                         pRec.vType) = LESSTHAN then
            begin
            done := TRUE;
            DeleteValueFromNode := FALSE;
            last := FALSE;
            nodeDeleted := FALSE;
            end
        else
            begin            (* value found .. look for record number match *)
            Move(page[bytePtr],recNum,RNSIZE);
            if rNum = recNum then
                begin
                done := TRUE;
                DeleteValueFromNode := TRUE;
                Move(page[NEXTLOC],nextNode,RNSIZE);
                if (vCnt = 1) and (nextNode <> NULL) then
                    begin                       (* only 1 entry in this node *)
                    last := TRUE;
                    nodeDeleted := TRUE;
                    end
                else
                    begin
                    page[VCNTLOC] := vCnt - 1;
                    nodeDeleted := FALSE;
                    FastMover(page[bytePtr + RNSIZE + pRec.vSize],
                              page[bytePtr],
                              (RNSIZE + pRec.vSize) * (vCnt - cnt) + RNSIZE);
                    FillChar(page[(((vCnt - 1) * (pRec.vSize + RNSIZE)) + 1) +
                             RNSIZE],
                             pRec.vSize + RNSIZE,
                             0);
                    StorePage(iFName,thisNode,page);   (* store the page *)
                    last := (cnt = vCnt) and (vCnt <> 1) and (nextNode <> NULL);
                             (* the nextNode check is used since the last node
                             at level only has a node pointer and not a
                             corresponding value at the  next higher level.
                             Therefore, no value adjustment will be required *)
                    end;
                if mustMoveCursor then
                    begin
                    if pRec.cursor.entryNum > cnt then
                        begin
                        Dec(pRec.cursor.entryNum);
                        end
                    else
                        begin
                        if pRec.cursor.entryNum = cnt then
                            begin
                            pRec.cursor.valid := FALSE;
                            end;
                        end;
                    end;
                end;
            end;
        if not done then
            begin
            if (cnt = vCnt) then
                begin                       (* no more values .. get brother *)
                Move(page[NEXTLOC],thisNode,RNSIZE);          (* get brother *)
                if thisNode = NULL then
                    begin                              (* no brother .. quit *)
                    done := TRUE;
                    DeleteValueFromNode := FALSE;
                    last := FALSE;
                    nodeDeleted := FALSE;
                    end
                else
                    begin                                   (* brother found *)
                    FetchPage(iFName,thisNode,page);        (* fetch brother *)
                    bytePtr := 1;
                    cnt := 1;
                    vCnt := page[VCNTLOC];
                    end;
                end
            else
                begin
                Inc(cnt);
                bytePtr := bytePtr + RNSIZE + pRec.vSize;
                end;
            end;
        end;
    end;                               (* end of DeleteValueFromNode routine *)

(*\*)
(* This recursive routine will start at a given node (normally the root) and
   follow the tree down until the correct sequence node is found.  Once it
   is found DeleteValueFromNode is used to delete the value from the node if
   it exists.  The routine returns TRUE if the value (including the correct
   physical record pointer) is found and deleted.  Otherwise, FALSE is
   returned.  If this deletion causes an empty node, DeleteValueFromNode will
   delete the node.  This routine will take this into account and delete the
   lowernode and lowernode node pointer.  The variable nodeDeleted will be set
   TRUE by DeleteValueFromNode to denote that the lower node was deleted.  If
   the lower node was not deleted but the value deleted was the last value in
   the node (not the only value but the last) and was not the last node of a
   given level then this routine will change the value pointing to the lower
   node to take this into account.  This will be noted by last being set to
   TRUE by DeleteValueFromNode.                                              *)

function DeleteValue(var iFName : FnString;            (* var for speed only *)
                     rNum : RecordNumber;
                     var paramValue;
                     var thisNode : NodePtrType;
                     var pRec : ParameterRecord;
                     var last : Boolean;
                     var nodeDeleted : Boolean) : Boolean;

var
    lowerPage,
    thisPage : SinglePage;
    lastValLoc,
    bytePtr : PageRange;
    lowerNode : NodePtrType;
    cnt : Byte;

    begin
    FetchPage(iFName,thisNode,thisPage);
    case NodeType(thisPage[NTYPELOC]) of
        INDEXNODE :
            begin
            lowerNode := FindNextLevelPtr(thisPage,paramValue,pRec);
            if DeleteValue(iFName,
                           rNum,
                           paramValue,
                           lowerNode,      (* will become the lower node where
                                                  the value was deleted from *)
                           pRec,
                           last,
                           nodeDeleted) then
                begin      (* value was successfully deleted from node below *)
                if nodeDeleted then    (* check to see if lower node deleted *)
                    begin              (* it was - delete corresponding node
                                          pointer from this node             *)
                    DeleteValue := DeleteValueFromNode(iFName,
                                                       lowerNode,  (*lower node
                                                                    pointer *)
                                                       paramValue,
                                                       thisNode,  (* node to
                                                                     delete
                                                                     from *)
                                                       pRec,
                                                       last,
                                                       nodeDeleted);
                    DeleteNodeFromList(iFName,lowerNode,pRec);
                                              (* delete lower node from list *)
                    end
                else
                    begin                               (* node not deleted *)
                    if last then         (* value deleted was last entry in
                                            lower node and lower node was not
                                            last at that level              *)
                        begin
                        bytePtr := 1;
                        cnt := BinarySearchEntry(thisPage,paramValue,pRec);
                        if (cnt <> 0) and (cnt <= thisPage[VCNTLOC]) then
                            begin
                            bytePtr := BytePointerPosition(cnt,pRec.vSize);
                                             (* now find record number match *)
                            if CompareValues(lowerNode,
                                             thisPage[bytePtr],
                                             LONGINTVALUE) = EQUALTO then
                                (* It is not obvious, but if the first entry
                                   for paramValue is not the one that matches
                                   the lower node, no adjustment will be
                                   required.  This is because, if the lower node
                                   is not the first node with this value, the
                                   new last value for the lower node will be
                                   paramValue                                *)
                                begin
                                FetchPage(iFName,lowerNode,lowerPage);
                                lastValLoc := ((lowerPage[VCNTLOC] - 1)
                                              * (pRec.vSize + RNSIZE)) + 1;
                                FastMover(lowerPage[lastValLoc + RNSIZE],
                                          thisPage[bytePtr + RNSIZE],
                                          pRec.vSize);
                                StorePage(iFName,thisNode,thisPage);
                                end;
                            end;
                        end;
                    DeleteValue := FALSE;
                    end;
                end
            else
                begin
                DeleteValue := FALSE;
                end;
            end;
        SEQUENCENODE :
            begin
            mustMoveCursor := pRec.cursor.valid and
                              (pRec.cursor.prNum = thisNode);
            DeleteValue := DeleteValueFromNode(iFName,rNum,paramValue,
                                               thisNode,pRec,last,nodeDeleted);
            mustMoveCursor := FALSE;
            end;
        end;                                        (* end of case statement *)
    end;                                       (* end of DeleteValue routine *)

(*\*)
(* This routine will delete a value and its associated logical record number
   from a given index file.  If the logical record number passed in is zero
   then all records with a matching paramValue will be deleted.  Otherwise,
   only the entry with the matching paramValue and the matching logical record
   number will be deleted.                                                   *)

procedure DeleteValueFromBTree(iFName : FnString;
                               lrNum : LrNumber;
                               var paramValue);

var
    tempLrNum : LrNumber;
    lrLst : LrList;
    pRec : ParameterRecord;
    last,
    nodeDeleted : Boolean;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if lrNum = 0 then
        begin                         (* delete all occurences of paramValue *)
        CreateLrList(lrLst);
        GetEqualsFromBTree(iFName,paramValue,lrLst,pRec);
        tempLrNum := GetFirstLr(lrLst);
        while tempLrNum <> 0 do
            begin
            DeleteValueFromBTree(iFName,tempLrNum,paramValue);
            tempLrNum := GetNextLr(lrLst);
            end;
        DestroyLrList(lrLst);
        end
    else
        begin
        if DeleteValue(iFName,lrNum,paramValue,
                       pRec.rNode,pRec,last,nodeDeleted) then ;
        end;
    SaveFileParameters(iFName,pRec,SizeOf(pRec));
    end;                                      (* end of DeleteValueFromBTree *)

(*\*)
(* This routine will start at the root node and return the number of levels
that exist in a BTree.  The index file name is the only required input.      *)

function NumberOfBTreeLevels(iFName : FnString) : Byte;

var
    pRec : ParameterRecord;
    page : SinglePage;

    function CountLevels(thisNode : NodePtrType) : Byte;

    var
        lowerNode : NodePtrType;

        begin
        FetchPage(iFName,thisNode,page);
        case NodeType(page[NTYPELOC]) of
            INDEXNODE :
                begin
                Move(page,lowerNode,RNSIZE);
                CountLevels := CountLevels(lowerNode) + 1;
                end;
            SEQUENCENODE :
                begin
                CountLevels := 1;
                end;
            end;                                    (* end of case statement *)
        end;                                   (* end of CountLevels routine *)

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    NumberOfBTreeLevels := CountLevels(pRec.rNode);
    end;                               (* end of NumberOfBTreeLevels routine *)

(*\*)
(* This routine will search an index and determine whether the given logical
   record number is in the index.  If it is, TRUE is returned in found and the
   value associated with the logical record number is returned in paramValue.
   If it is not found, found will be returned as FALSE and paramValue will
   remain unchanged.  This is primarily used for debugging or determining if
   an index has somehow been damaged.                                        *)

procedure FindLrNumInBTree(iFName : FnString;
                           lrNum : LrNumber;
                           var paramValue;
                           var found : Boolean);

var
    pRec : ParameterRecord;
    page : SinglePage;
    tempLrNum : LrNumber;
    thisNode : NodePtrType;
    cnt,
    vCnt : Byte;
    bytePtr : PageRange;

    begin
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    thisNode := pRec.fSNode;
    found := FALSE;
    while thisNode <> 0 do
        begin
        FetchPage(iFName,thisNode,page);
        vCnt := page[VCNTLOC];
        cnt := 1;
        bytePtr := 1;
        while cnt <= vCnt do
            begin
            Move(page[bytePtr],tempLrNum,RNSIZE);
            if tempLrNum = lrNum then
                begin
                found := TRUE;
                FastMover(page[bytePtr + RNSIZE],paramValue,pRec.vSize);
                Exit;
                end
            else
                begin
                Inc(cnt);
                if cnt <= vCnt then
                    begin               (* required to keep bytePtr in range *)
                    bytePtr := bytePtr + RNSIZE + pRec.vSize;
                    end;
                end;
            end;
        Move(page[NEXTLOC],thisNode,RNSIZE);      (* set up to get next node *)
        end;
    end;                                  (* end of FindLrNumInBTree routine *)