Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TBTREE.ZIP/BTREE1.INC

Text File | 1988-07-26 | 48.6 KB | 1,147 lines

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 working file

     variable      parameter       location   size   type    range
     --------      ---------       --------   ----   ----    -----
      vSize        value size           1       1    Byte    1 - 114
      rNode        root node            2       4 Longint    1 - MAXLONGINT
      fSNode       first sequence node  6       4 Longint    1 - MAXLONGINT
      lSNODE       last  sequence node 10       4 LongInt    1 - MAXLONGINT
      vType        value type          14       1    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
      dFNameSize   data file name size 15       1 Byte       1 - FNSIZE
      dFName       data file name      16      80 FnString                   *)

const
    VSIZELOC      = 1;
    RNODELOC      = 2;
    FSNODELOC     = 6;
    LSNODELOC     = 10;
    VTYPELOC      = 14;
    DFNAMESIZELOC = 15;
    DFNAMELOC     = 16;

(*\*)
type
    NodePtrType   = PrNumber;                (* pointer to index records     *)
    FNameSizeType = 0 .. FNSIZE;             (* range for size of a file name
                                                string                       *)


    ParameterRecord = record
         vSize      : VSizeType;
         rNode      : NodePtrType;
         fSNode     : NodePtrType;
         lSNode     : NodePtrType;
         dFNameSize : FNameSizeType;
         dFName     : FnString;
         vType      : ValueType;
         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;

(*\*)
(* This procedure will read the zeroth physical record in the index file.
   The record contains the parameters to be stored in a variable (pRec) of type
   ParameterRecord (see above).                                              *)

Procedure FetchIndexParameters(iFName : FnString;
                               var pRec : ParameterRecord);

var
    page : SinglePage;

    begin
    FetchPage(iFName,0,page);
    pRec.vSize := page[VSIZELOC];
    Move(page[RNODELOC],pRec.rNode,RNSIZE);
    Move(page[FSNODELOC],pRec.fSNode,RNSIZE);
    Move(page[LSNODELOC],pRec.lSNode,RNSIZE);
    pRec.vType := ValueType(page[VTYPELOC]);
    pRec.dFNameSize := page[DFNAMESIZELOC];
    Move(page[DFNAMESIZELOC],pRec.dFName,pRec.dFNameSize + 1);
    end;                            (* End of FetchIndexParameters procedure *)


(* This procedure will save the zeroth physical record in the index file.
   The record contains the parameters documented above.  The zeroth record will
   be updated according to the values passed in pRec.                        *)

Procedure SaveIndexParameters(iFName : FnString;
                              pRec : ParameterRecord);

var
    page : SinglePage;

    begin
    FetchPage(iFName,0,page);
    page[VSIZELOC] := pRec.vSize;
    Move(pRec.rNode,page[RNODELOC],RNSIZE);
    Move(pRec.fSNode,page[FSNODELOC],RNSIZE);
    Move(pRec.lSNode,page[LSNODELOC],RNSIZE);
    page[VTYPELOC] := Integer(pRec.vType);
    Move(pRec.dFName,page[DFNAMESIZELOC],pRec.dFNameSize + 1);
    StorePage(ifName,0,page);
    end;                             (* End of SaveIndexParameters procedure *)

(*\*)
(* 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(iFName : FnString;
                           thisNode : NodePtrType;
                           var prevNode;
                           var nextNode);

var
    page : SinglePage;
    pRec : ParameterRecord;
    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] = Integer(SEQUENCENODE) then
            begin             (* set first seq node pointer to this new node *)
            FetchIndexParameters(iFName,pRec);
            pRec.fSNode := thisNode;
            SaveIndexParameters(iFName,pRec);
            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] = Integer(SEQUENCENODE) then
            begin              (* set last seq node pointer to this new node *)
            FetchIndexParameters(iFName,pRec);
            pRec.lSNode := thisNode;
            SaveIndexParameters(iFName,pRec);
            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(iFName : FnString;
                             thisNode : NodePtrType);

var
    pRec : ParameterRecord;
    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
            FetchIndexParameters(iFName,pRec);
            pRec.fSNode := nextNode;
            SaveIndexParameters(iFName,pRec);
            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
            FetchIndexParameters(iFName,pRec);
            pRec.lSNode := nextNode;
            SaveIndexParameters(iFName,pRec);
            end;
        end;
    DeleteRecord(iFName,thisNode);              (* 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(iFName : FnString;
                     var prevNode;
                     var nextNode;
                     nType : NodeType) : NodePtrType;

var
    page : SinglePage;
    newNode : NodePtrType;

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


(* This routine will create an index file and set the zeroth record as
   appropriate.  The root node will also be created.  The root node will
   be empty.

   note - File name passed as parameter does not have a file extension.  The
   extension will be added and returned.

   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 CreateIndex(var iFName : FnString;
                      valSize : VSizeType;
                      dataFName : FnString;
                      valType : ValueType);

var
    pRec : ParameterRecord;

    begin
    CreateFile(iFName,INDEX);
    pRec.vSize := valSize;
    pRec.rNode := CreatedNode(iFName,NULL,NULL,INDEXNODE);    (* create root *)
    pRec.fSNode := NULL;
    pRec.lSNode := NULL;
    pRec.dFNameSize := Length(dataFName);
    pRec.dFName := dataFName;
    pRec.vType := valType;
    SaveIndexParameters(iFName,pRec);     (* write parameters back to buffer *)
    end;                                       (* end of CreateIndex 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(page : SinglePage;
                          var paramValue;
                          pRec : ParameterRecord) : NodePtrType;

 var
     cnt,
     vCnt : Byte;
     bytePtr : PageRange;
     done : Boolean;
     p : NodePtrType;                 (* temporarily holds pointer to return *)
     result : Comparison;

     begin
     vCnt := page[VCNTLOC];
     bytePtr := 1;
     cnt := 1;
     done := FALSE;
     while not done do
         begin                          (* no more values in node *)
         if cnt > vCnt then
             begin
             Move(page[bytePtr],p,RNSIZE);    (* ptr to be returned *)
             done := TRUE;
             end
         else
             begin
             result := CompareValues(paramValue,
                                     page[bytePtr + RNSIZE],
                                     pRec.vType);
             if (result = LESSTHAN) or (result = EQUALTO) then
                 begin
                 Move(page[bytePtr],p,RNSIZE); (* ptr to be returned *)
                 done := TRUE;
                 end
             else
                 begin
                 cnt := cnt + 1;
                 bytePtr := bytePtr + pRec.vSize + RNSIZE;
                 end;
             end;
         end;
     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(iFName : FnString;
                   rNum : NodePtrType;
                   var paramValue;
                   pRec : ParameterRecord) : 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(iFName : FnString;
                             var paramValue;
                             var lrLst : LrList);

var
    pRec : ParameterRecord;   (* holds the index parameters *)
    next : PrNumber;          (* used as pointer to next sequence node *)
    vCnt : Byte;              (* count of values in a node *)
    result : Comparison;
    page : SinglePage;
    done : Boolean;
    cnt : Byte;               (* used to count number of values *)
    lrNum : LrNumber;
    bytePtr : PageRange;      (* used to keep track of current byte *)

    begin
    FetchIndexParameters(iFName,pRec);
    CreateLrList(lrLst);
    if pRec.fSNode <> NULL then
        begin
        FetchPage(iFName,
                  FindSNode(iFName,pRec.rnode,paramValue,pRec),
                  page);
        vCnt := page[VCNTLOC];
        Move(page[NEXTLOC],next,RNSIZE);
        cnt := 1;
        bytePtr := 1;
        done := FALSE;
        while not done do
            begin
            result := CompareValues(paramValue,
                                    page[bytePtr+RNSIZE],
                                    pRec.vType);
            if result = EQUALTO then
                begin
                Move(page[bytePtr],lrNum,RNSIZE);
                AddToLrList(lrNum,lrLst);
                end
            else
                begin
                if result = LESSTHAN then
                    begin
                    done := TRUE;               (* this will get us out of this
                                                   loop .. value does not exist
                                                   in this record *)
                    end;
                end;
            if not done then
                begin
                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 *)
                        FetchPage(iFName,next,page);                 (* value *)
                        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;
                    cnt := cnt + 1;
                    end;
                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;
                              pRec : ParameterRecord);

var
    result : Comparison;
    cnt,
    vCnt : Byte;
    done : Boolean;
    bytePtr : PageRange;

    begin
    vCnt := page[VCNTLOC];                               (* get value count *)
    bytePtr := 1;
    cnt := 1;
    done := FALSE;
    while not done do
        begin
        if cnt > vCnt then
            begin
            done := TRUE;
            end
        else
            begin
            result := CompareValues(paramValue,
                                    page[bytePtr + RNSIZE],
                                    pRec.vType);
            if (result = LESSTHAN) or (result = EQUALTO) then
                begin
                done := TRUE;
                end
            else
                begin
                cnt := cnt + 1;
                            (* we don't have to worry about range of bytePtr
                               since the value will definitely fit           *)
                bytePtr := byteptr + pRec.vSize + RNSIZE;
                end;
            end;
        end;
    Move(page[bytePtr],                                         (* make room *)
         page[bytePtr + pRec.vSize + RNSIZE],
         ((vCnt - cnt) + 1) * (pRec.vSize + RNSIZE) + RNSIZE);
    Move(rNum,page[bytePtr],RNSIZE);                       (* insert pointer *)
    Move(paramValue,page[bytePtr + RNSIZE],pRec.vSize);        (*insert value*)
    page[VCNTLOC] := vCnt + 1;                            (* new value count *)
    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;
                        pRec : ParameterRecord) : Boolean;

var
    maxValues : Byte;
    vCnt : Byte;

    begin
    maxValues := (MAXVALSIZE + RNSIZE) DIV (pRec.vSize + RNSIZE);
    vCnt := page[VCNTLOC];
    if vCnt < 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(iFName : FnString;
                     rtNode : NodePtrType;
                     ltNode : NodePtrType;
                     vSize : VSizeType);

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

    begin
    FetchPage(ifName,rtNode,rtPage);               (* get right node's page  *)
    FetchPage(ifName,ltNode,ltPage);               (* get left node's page   *)
    vCnt := rtPage[VCNTLOC];                       (* get right node's count *)
    numToMove := vCnt div 2;
    bytesToMove := (RNSIZE + vSize) * numToMove;  (* calc # of bytes to move *)
    Move(rtPage[1],ltPage[1],bytesToMove);
    Move(rtPage[BytesToMove + 1],
         rtPage[1],(MAXVALSIZE + RNSIZE + RNSIZE) - bytesToMove);
    vCnt := vCnt - numToMove;
    if NodeType(rtPage[NTYPELOC]) = INDEXNODE then
        begin
        FillChar(rtPage[(vCnt * (vSize + RNSIZE)) + 1 + RNSIZE],
                 numToMove * (vSize + RNSIZE),
                 0);
        end
    else
        begin
        FillChar(rtPage[(vCnt * (vSize + RNSIZE)) + 1],
                 numToMove * (vSize + RNSIZE),
                 0);
        end;
    rtPage[VCNTLOC] := vCnt;
    ltPage[VCNTLOC] := numToMove;
    StorePage(iFName,rtNode,rtPage);
    StorePage(iFName,ltNode,ltPage);
    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(iFName : FnString;
                     rNum : RecordNumber;    (* record number to be inserted *)
                     var paramValue;         (* value to be inserted *)
                     thisNode : NodePtrType; (* node *)
                     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 *)
                    StorePage(iFName,thisNode,thisPage);
                    end
                else
                    begin
                    newNode := CreatedNode(iFName,
                                           thisPage[PREVLOC],
                                           thisNode,
                                           INDEXNODE);
                    MoveValues(iFName,thisNode,newNode,pRec.vSize);
                    FetchPage(iFName,thisNode,thisPage);
                    if CompareValues(paramValue,thisPage[RNSIZE + 1],
                                     pRec.vType) = GREATERTHAN then
                        begin
                        InsertValueIntoNode(thisPage,
                                            lowerPage[lastValLoc],
                                            lowerNode,pRec);
                        StorePage(iFName,thisNode,thisPage);
                        end
                    else
                        begin
                        FetchPage(iFName,newNode,newPage);
                        InsertValueIntoNode(newPage,
                                            lowerPage[lastValLoc],
                                            lowerNode,pRec);
                        StorePage(iFName,newNode,newPage);
                        end;
                    InsertValue := newNode;      (* newly added node will be
                                                    returned                 *)
                    end;
                end
            else
                begin
                InsertValue := NULL;    (* it fit at lower level therefore
                                           this level is fine .. return NULL *)
                end;
            end;
        SEQUENCENODE :
            begin
            if InsertedInNode(thisPage,paramValue,rNum,pRec) then
                begin
                InsertValue := NULL;   (* it fits .. no split .. return NULL *)
                StorePage(iFName,thisNode,thisPage);
                end
            else
                begin
                newNode := CreatedNode(iFName,
                                       thisPage[prevLoc],
                                       thisNode,
                                       SEQUENCENODE);
                MoveValues(iFName,thisNode,newNode,pRec.vSize);
                Fetchpage(iFName,thisNode,thisPage);
                if CompareValues(paramValue,thisPage[RNSIZE + 1],
                                 pRec.vType) = GREATERTHAN then
                    begin
                    InsertValueIntoNode(thisPage,paramValue,rNum,pRec);
                    StorePage(iFName,thisNode,thisPage);
                    end
                else
                    begin
                    FetchPage(iFName,newNode,newPage);
                    InsertValueIntoNode(newPage,paramValue,rNum,pRec);
                    StorePage(iFName,newNode,newPage);
                    end;
                InsertValue := newNode;
                end;
            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 *)
    FetchIndexParameters(iFName,pRec);
    if pRec.fSNode = NULL then
        begin                                          (* root must be empty *)
        pRec.fSNode := CreatedNode(iFName,NULL,NULL,SEQUENCENODE); (* create seq
                                                                     node *)
        pRec.lSNode := pRec.fSNode;
        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 *)
        FetchPage(iFName,pRec.fSNode,page);                   (* get seq node *)
        InsertValueIntoNode(page,paramValue,lrNum,pRec);   (* insert value into
                                                              seq node       *)
        StorePage(iFName,pRec.fSNode,page);             (* store the seq node *)
        end
    else
        begin
        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); (* 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;
            InsertValueIntoNode(page,              (* insert child into root *)
                                lowerPage[LastValLoc],
                                lowerNode,pRec);
            Move(lowerPage[NEXTLOC],
                 page[RNSIZE + 1 + pRec.vSize],RNSIZE);    (* insert ptr for
                                                                 right child *)
            StorePage(iFName,pRec.rNode,page);
            SaveIndexParameters(iFName,pRec);
           end;
        end;
    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(iFName : FnString;
                             rNum : RecordNumber;
                             var ParamValue;
                             var thisNode : NodePtrType;
                             pRec : ParameterRecord;
                             var last : Boolean;
                             var nodeDeleted : Boolean) : Boolean;

var
    done : Boolean;
    result : Comparison;
    cnt,
    vCnt : Byte;
    bytePtr : PageRange;
    page : SinglePage;
    nextNode : NodePtrType;

    begin
    FetchPage(iFName,thisNode,page);             (* fetch page for this node *)
    vCnt := page[VCNTLOC];                                (* get value count *)
    cnt := 1;
    bytePtr := 1;
    done := FALSE;
    while not done do
        begin
        if cnt <= vCnt then
            begin
            result := CompareValues(paramValue,
                                    page[bytePtr + RNSIZE],
                                    pRec.vType);
            case result of
                LESSTHAN :
                    begin
                    done := TRUE;
                    DeleteValueFromNode := FALSE;
                    last := FALSE;
                    nodeDeleted := FALSE;
                    end;
                EQUALTO :
                    begin     (* value found .. look for record number match *)
                    result := CompareValues(rNum,
                                            page[bytePtr],
                                            LONGINTVALUE);
                    if result = EQUALTO 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;
                            Move(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 *)
                            if (cnt = vCnt) and (vCnt <> 1)
                                            and (nextNode <> NULL) then
                                            (* 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
                                               necessary.                    *)
                                begin              (* value deleted was last *)
                                last := TRUE;
                                end
                            else
                                begin
                                last := FALSE;
                                end;
                            end;
                        end
                    else
                        begin
                        cnt := cnt + 1;
                        if cnt <= vCnt then
                            begin      (* if stmt will keep bytePtr in range *)
                            bytePtr := bytePtr + RNSIZE + pRec.vSize;
                            end;
                        end;
                    end;
                GREATERTHAN :
                    begin
                    cnt := cnt + 1;
                    if cnt <= vCnt then
                        begin          (* if stmt will keep bytePtr in range *)
                        bytePtr := bytePtr + RNSIZE + pRec.vSize;
                        end;
                    end;
                end;                                (* end of case statement *)
            end
        else
            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;
        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(iFName : FnString;
                     rNum : RecordNumber;
                     var paramValue;
                     var thisNode : NodePtrType;
                     pRec : ParameterRecord;
                     var last : Boolean;
                     var nodeDeleted : Boolean) : Boolean;

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

    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);   (*delete lower node
                                                              from ist list *)
                    end
                else
                    begin
                    if last then
                        begin
                        bytePtr := 1;
                        cnt := 1;
                        FetchPage(iFName,lowerNode,lowerPage);
                        lastValLoc := ((lowerPage[VCNTLOC] - 1)
                                      * (pRec.vSize + RNSIZE)) + 1;
                                             (* now find record number match *)
                        done := FALSE;
                        while not done do
                            begin
                            if CompareValues(lowerNode,
                                             thisPage[bytePtr],
                                             LONGINTVALUE) = EQUALTO then
                                begin
                                done := TRUE;
                                if cnt <= thisPage[VCNTLOC] then
                                    begin       (* the above check takes care
                                                   of the case where the lower
                                                   node has a pointer to it in
                                                   this page but does not have
                                                   a corresponding value since
                                                   this is the last index page
                                                   in a given level sequence *)
                                    Move(lowerPage[lastValLoc + RNSIZE],
                                         thisPage[bytePtr + RNSIZE],
                                         pRec.vSize);
                                    StorePage(iFName,thisNode,thisPage);
                                    end;
                                end
                            else
                                begin
                                if cnt = thisPage[VCNTLOC] then
                                    begin
                                    Move(thisPage[NEXTLOC],thisNode,RNSIZE);
                                    FetchPage(iFName,thisNode,thisPage);
                                    bytePtr := 1;
                                    cnt := 1;
                                    end
                                else
                                    begin
                                    bytePtr := bytePtr + pRec.vSize + RNSIZE;
                                    cnt := cnt + 1;
                                    end;
                                end;
                            end;
                        end;
                    DeleteValue := FALSE;
                    end;
                end
            else
                begin
                DeleteValue := FALSE;
                end;
            end;
        SEQUENCENODE :
            begin
            DeleteValue := DeleteValueFromNode(iFName,rNum,paramValue,
                                               thisNode,pRec,last,nodeDeleted);
            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
    FetchIndexParameters(iFName,pRec);
    if pRec.fSNode <> NULL then               (* see if sequence node exists *)
        begin
        if lrNum = 0 then
            begin                     (* delete all occurences of paramValue *)
            CreateLrList(lrLst);
            GetEqualsFromBTree(iFName,paramValue,lrLst);
            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;
        end;
    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(page : SinglePage) : Byte;

    var
        lowerNode : PrNumber;

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

    begin
    FetchIndexParameters(iFName,pRec);
    if pRec.fSNode = NULL then
        begin                                          (* root must be empty *)
        NumberOfBTreeLevels := 0;
        end
    else
        begin
        FetchPage(iFName,pRec.rNode,page);                  (* get root node *)
        NumberOfBTreeLevels := CountLevels(page);
        end;
    end;                               (* end of NumberOfBTreeLevels routine *)