{$TPO-} // treat all pointer inc/dec's as byte adjusts
unit lists;
interface
const B_NODE_LEAF = $4641454C; // LEAF
const B_NODE_INDEX = $58444E49; // INDX
const B_NODE_OPEN = $4E45504F; // OPEN
type
int8 = shortInt;
int16 = smallInt;
int32 = longInt;
uInt8 = byte;
uInt16 = word;
uInt32 = dWord;
type
treeTypes = (BT_CUSTOM, BT_PCHAR, BT_STRING, BT_SINGLE, BT_DOUBLE, BT_INT32, BT_INT64);
PbNode = ^TbNode;
PbNodeData = ^TbNodeData;
uPtr = packed record
case integer of
0: (i : int32);
1: (u : uInt32);
2: (s : single);
3: (d : double);
4: (p : pointer);
5: (bPtr : PbNode);
6: (offset : int64);
{ 7: (iAddr : inodeAddr);}
end;
TbNode = packed record
magic : uInt32;
tag : uInt32;
numKeys : uInt32;
size : uInt32;
left : uPtr;
right : uPtr;
parent : uPtr;
reserved : uPtr;
data : array[0..0] of byte;
end;
TbNodeData = packed record
link : uPtr;
key : record
case treeTypes of
BT_PCHAR,
BT_STRING: (str:string[1]);
BT_SINGLE: (s:single);
BT_DOUBLE: (d:double);
BT_INT32 : (i:int32);
BT_INT64 : (x:int64);
end; {record}
end; {TbNode}
type
BTreeSearchRec = record
value : uPtr;
key : pointer;
keySize:integer;
end; {BTreeSearchRec}
type
PBTreeInfo = ^BTreeInfo;
BTreeInfo = packed record
root : uPtr;
firstDeleted : uPtr;
nodes : uInt32;
height : uInt32;
keys : uInt32;
bNodeSize : uInt32;
treeType : treeTypes;
end; {BTreeHeader}
type compareKeyFunc = function(key1, key2:pointer):integer;
type copyKeyProc = procedure(srcKey, destKey:pointer);
type keySizeFunc = function(key:pointer):integer;
type
PbTree = ^bTree;
bTree = object
private
compareKeys : compareKeyFunc;
copyKey : copyKeyProc;
keySize : keySizeFunc;
info : PBTreeInfo;
dataFile : file;
memoryTree : boolean;
f:text;
function align(keyLength:integer):integer;
function allocEmptyNode:uPtr;
function calcSize(node:PbNode):integer;
procedure deAllocNode(node:PbNode);
function deleteEntry(u:uPtr; key:pointer; value:uPtr):uPtr;
procedure discardPage(node:PbNode);
function fetchFirstKey(u:uPtr; var searchRec:BTreeSearchRec):boolean;
function fetchLastKey(u:uPtr; var searchRec:BTreeSearchRec):boolean;
function findLeafNode(u:uPtr; key:pointer):uPtr;
procedure freeAll;
procedure freePage(u:uPtr);
function getAddress(node:PbNode):uPtr;
function insertEntry(u:uPtr; key:pointer; value:uPtr):boolean;
function isNull(u:uPtr):boolean;
function loadPage(u:uPtr):PbNode;
function replaceEntry(u:uPtr; key:pointer; value:uPtr):boolean;
procedure savePage(node:PbNode);
procedure setLeft(u:uPtr; newPtr:uPtr);
procedure setNull(var u:uPtr);
procedure setRight(u:uPtr; newPtr:uPtr);
procedure setParent(u:uPtr; newPtr:uPtr);
public
constructor init(const filename:string; nodeSize:uInt32; tt:treeTypes);
function Delete(key:pointer; value:uPtr):uPtr;
function Insert(key:pointer; value:uPtr):boolean;
procedure InstallUserFunctions(cmpFunc:compareKeyFunc; copyProc:copyKeyProc; ksFunc:keySizeFunc);
function Find(key:pointer; var u:uPtr):boolean;
procedure FindClose(var searchRec:BTreeSearchRec);
function FindFirst(key:pointer; var searchRec:BTreeSearchRec):boolean;
function FindNext(var searchRec:BTreeSearchRec):boolean;
function FindPrev(var searchRec:BTreeSearchRec):boolean;
function GetFirstKey(var searchRec:BTreeSearchRec):boolean;
function GetLastKey(var searchRec:BTreeSearchRec):boolean;
procedure PrintInfo(u:uPtr);
procedure Print(u:uPtr);
procedure PrintList;
procedure PrintWholeTree;
destructor done;
end; {bTree}
implementation
uses strings, dos;
function compareKeyNull(key1, key2:pointer):integer; result := 0; {compareKeyNull}
procedure copyKeyNull(srcKey, destKey:pointer); begin end; {compareKeyNull}
function keySizeNull(key:pointer):integer; result := 0; {keySizeNull}
(*
* CompareKey functions
*
*)
function compareKeyString(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
if string(key1^) < string(key2^) then
result := -1
else
if string(key1^) > string(key2^) then result := 1;
end; {comapreKeyString}
function compareKeyPChar(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
result := strcomp(pchar(key1), pchar(key2));
end; {compareKeyPChar}
function compareKeyDouble(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
if (double(key1^) < double(key2^)) then
result := -1
else
if (double(key1^) > double(key2^)) then result := 1;
end; {compareKeyDouble}
function compareKeySingle(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
if (single(key1^) < single(key2^)) then
result := -1
else
if (single(key1^) > single(key2^)) then result := 1;
end; {compareKeySingle}
function compareKeyInt32(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
if (int32(key1^) < int32(key2^)) then
result := -1
else
if (int32(key1^) > int32(key2^)) then result := 1;
end; {compareKeyInt32}
function compareKeyInt64(key1, key2:pointer):integer;
begin
result := 0;
if ((key1 = NIL) or (key2 = NIL)) then exit;
if (int64(key1^) < int64(key2^)) then
result := -1
else
if (int64(key1^) > int64(key2^)) then result := 1;
end; {compareKeyInt64}
(*
* CopyKey functions
*
*)
procedure copyKeyPChar(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
strcopy(pchar(destKey), pchar(srcKey));
end; {copyeKeyPChar}
procedure copyKeyString(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
string(destKey^) := string(srcKey^);
end; {copyKeyString}
procedure copyKeySingle(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
single(destKey^) := single(srcKey^);
end; {copyKeySingle}
procedure copyKeyDouble(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
double(destKey^) := double(srcKey^);
end; {copyKeyDouble}
procedure copyKeyInt32(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
int32(destKey^) := int32(srcKey^);
end; {copyKeyInt32}
procedure copyKeyInt64(srcKey, destKey:pointer);
begin
if ((srcKey = NIL) or (destKey = NIL)) then exit;
int64(destKey^) := int64(srcKey^);
end; {copyKeyInt64}
(*
* KeySize functions
*
*)
function keySizePChar(key:pointer):integer;
begin
result := 0;
if (key = NIL) then exit;
result := strlen(pchar(key))+1;
end; {keySizePChar}
function keySizeString(key:pointer):integer;
begin
result := 0;
if (key = NIL) then exit;
result := length(string(key^))+1;
end; {keySizeString}
function keySizeSingle(key:pointer):integer;
begin
if (key = NIL) then result := 0 else result := sizeof(single);
end; {keySizeSingle}
function keySizeDouble(key:pointer):integer;
begin
if (key = NIL) then result := 0 else result := sizeof(double);
end; {keySizeDouble}
function keySizeInt32(key:pointer):integer;
begin
if (key = NIL) then result := 0 else result := sizeof(int32);
end; {keySizeInt32}
function keySizeInt64(key:pointer):integer;
begin
if (key = NIL) then result := 0 else result := sizeof(int64);
end; {keySizeInt64}
(********************************)
function compareUPtrs(u1, u2:uPtr):boolean;
begin
result := (u1.offset = u2.offset);
end; {compareUPtrs}
overload = = compareUPtrs;
(*
*
* B^Tree object methods
*
*)
constructor bTree.init;
var node:PbNode;
begin
memoryTree := fileName = '';
// allocate the info section
getmem(info, sizeof(BTreeInfo));
if (info = NIL) then exit;
fillchar(info^, sizeof(BTreeInfo), 0);
with info^ do
begin
// setNull requires the memoryTree flag to be set
setNull(root);
setNull(firstDeleted);
nodes := 1;
height := 0;
keys := 0;
bNodeSize := nodeSize;
treeType := tt;
end; {with}
if not (memoryTree) then
begin
assign(dataFile, filename);
if (fsearch(filename, '') <> '') then
begin
reset(dataFile, 1);
blockread(dataFile, info^, sizeof(BTreeInfo));
end
else
begin
rewrite(dataFile, 1);
blockwrite(datafile, info^, sizeof(BTreeInfo));
end;
reset(dataFile, info^.bNodeSize);
end;
case info^.treeType of
BT_CUSTOM : InstallUserFunctions(compareKeyNull, copyKeyNull, keySizeNull);
BT_PCHAR : InstallUserFunctions(compareKeyPChar, copyKeyPChar, keySizePChar);
BT_STRING : InstallUserFunctions(compareKeyString, copyKeyString, keySizeString);
BT_SINGLE : InstallUserFunctions(compareKeySingle, copyKeySingle, keySizeSingle);
BT_DOUBLE : InstallUserFunctions(compareKeyDouble, copyKeyDouble, keySizeDouble);
BT_INT32 : InstallUserFunctions(compareKeyInt32, copyKeyInt32, keySizeInt32);
BT_INT64 : InstalluserFunctions(compareKeyInt64, copyKeyInt64, keySizeInt64);
else
InstallUserFunctions(compareKeyNull, copyKeyNull, keySizeNull);
end; {case}
assign(f, 'output.txt');
{assign(f, '');}
rewrite(f);
end; {bTree.init}
function bTree.align;
begin
result := ((sizeof(uptr) + keyLength + 7) shr 3) shl 3;
end; {bTree.align}
function bTree.allocEmptyNode;
var newNode:PbNode;
begin
setNull(result);
if (not isNull(info^.firstDeleted)) then
begin
newNode := loadPage(info^.firstDeleted);
if (newNode = NIL) then exit;
info^.firstDeleted := newNode^.parent;
end
else
begin
getmem(newNode, info^.bNodeSize);
fillchar(newNode^, info^.bNodeSize, 0);
newNode^.tag := info^.nodes;
inc(info^.nodes);
end;
with newNode^ do
begin
magic := B_NODE_LEAF;
numKeys := 1;
size := dword(@newNode^.data) - dword(newNode);
setNull(left);
setNull(right);
setNull(parent);
setNull(reserved);
end; {with}
result := getAddress(newNode);
savePage(newNode);
discardPage(newNode);
end; {bTree.allocEmptyNode}
function bTree.calcSize;
var
size:integer;
curNode:integer;
dataNode:PbNodeData;
begin
if (node = NIL) then exit;
dataNode := @node^.data;
size := dword(dataNode) - dword(node);
for curNode := 1 to node^.numKeys do
begin
inc(size, align(keySize(@dataNode^.key)));
inc(dataNode, align(keySize(@dataNode^.key)));
end;
if (node^.magic = B_NODE_INDEX) then inc(size, sizeof(uPtr));
result := size;
end;
procedure bTree.deAllocNode;
begin
if (node = NIL) then exit;
with node^ do
begin
magic := B_NODE_OPEN;
setNull(left);
setNull(right);
setNull(reserved);
parent := info^.firstDeleted;
size := dword(@node^.data) - dword(node);
fillchar(data, info^.bNodeSize - size, 0);
end;
info^.firstDeleted := getAddress(node);
end; {btree.deAllocNode}
function bTree.deleteEntry;
var
bnode, tmpNode, neighbor, parent : PbNode;
neighborSize:integer;
dataNode, nextDataNode, tmpDataNode:PbNodeData;
src, dst : pointer;
tmpLink:uPtr;
nodeSize:uInt32;
curNode, res, size: integer;
found : boolean;
procedure getNeighbor;
var
l, r:PbNode;
begin
neighbor := NIL;
neighborSize := 0;
l := loadPage(bnode^.left);
r := loadPage(bnode^.right);
if (l = NIL) then
begin
// this next check may be unecessary
if (r^.parent = bnode^.parent) then
begin
neighbor := r;
neighborSize := r^.size;
end;
exit
end;
if (r = NIL) then
begin
// this next check may be unecessary
if (l^.parent = bnode^.parent) then
begin
neighbor := l;
neighborSize := l^.size;
end;
exit
end;
if (l^.parent = r^.parent) then // left/right neighbors are children of the same parent
begin
if (l^.size < r^.size) then
begin
neighbor := l;
neighborSize := l^.size;
discardPage(r);
exit
end
else
begin
neighbor := r;
neighborSize := r^.size;
discardPage(l);
exit
end;
end
else // one of the neighbors has a different parent
begin
if (l^.parent = bnode^.parent) then
begin
neighbor := l;
neighborSize := l^.size;
discardPage(r);
exit
end
else
begin
neighbor := r;
neighborSize := r^.size;
discardPage(l);
exit
end;
end;
discardPage(l);
discardPage(r);
end; {getNeighbor local function}
begin
setNull(result);
if (isNull(u)) then exit;
bnode := loadPage(u);
if (bnode^.numKeys = 0) then halt; {this should never happen}
if (bnode^.magic = B_NODE_LEAF) then
begin
case info^.treeType of
BT_STRING:writeln(f, 'Deleting ', string(key^), ' size: ', align(keySize(key)));
BT_PCHAR:writeln(f, 'Deleting ', pchar(key));
end;
dataNode := @bnode^.data;
curNode := 0;
repeat
res := compareKeys(@dataNode^.key, key);
if (res >= 0) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
inc(curNode);
until (curNode = bnode^.numKeys);
if (res <> 0) then exit;
result := dataNode^.link;
nodeSize := align(keySize(@dataNode^.key));
nextDataNode := dataNode;
inc(nextDataNode, nodeSize);
move(nextDataNode^, dataNode^, bnode^.size - (dword(nextDataNode) - dword(bnode)));
dec(bnode^.numKeys);
dec(bnode^.size, nodeSize);
dataNode := pointer(dword(bnode) + bnode^.size);
fillchar(dataNode^, nodeSize, 0);
dec(info^.keys);
// check for merges and other stuff
if (getAddress(bnode) = info^.root) then
begin
if (bnode^.numKeys = 0) then
begin
setNull(info^.root);
dec(info^.height);
deAllocNode(bnode);
exit;
end;
end
else {not root}
begin
if (bnode^.size < (info^.bNodeSize / 2)) then
begin
getNeighbor;
if (neighbor <> NIL) and (neighborSize <> 0) then
begin
if (bnode^.size + neighborSize <= info^.bNodeSize) then
begin
// if neighbor is a predecessor of bnode then swap them
if (getAddress(neighbor) = bnode^.left) then
begin
tmpNode := bnode;
bnode := neighbor;
neighbor := tmpNode;
end;
// merge the two nodes together
// bnode is the left node, neighbor is the right node
src := @neighbor^.data;
dst := pointer(dword(bnode) + bnode^.size);
size := neighbor^.size - (dword(src) - dword(neighbor));
move(src^, dst^, size);
inc(bnode^.size, size);
inc(bnode^.numKeys, neighbor^.numKeys);
setRight(bnode^.left, getAddress(neighbor));
bnode^.right := neighbor^.right;
move(bnode^, neighbor^, info^.bNodeSize);
savePage(neighbor);
deleteEntry(bnode^.parent, NIL, getAddress(bnode));
discardPage(neighbor);
deAllocNode(bnode);
exit;
end //if (bnode^.size + neighborSize <= info^.bNodeSize)
else // "acquire" an entry from a neighbor
begin
if (getAddress(neighbor) = bnode^.right) then
begin
// neighbor node is to the right. Append an entry from it to bnode
dataNode := @neighbor^.data;
src := dataNode;
dst := pointer(dword(bnode) + bnode^.size);
nodeSize := align(keySize(@dataNode^.key));
move(src^, dst^, nodeSize);
inc(bnode^.size, nodeSize);
inc(bnode^.numKeys);
nextDataNode := dataNode;
inc(nextDataNode, nodeSize);
move(nextDataNode^,
dataNode^,
neighbor^.size - (dword(dataNode) - dword(neighbor)) - nodeSize);
dec(neighbor^.size, nodeSize);
dec(neighbor^.numKeys);
// clear off the end of the neighbor node
dataNode := pointer(dword(neighbor) + neighbor^.size);
fillchar(dataNode^, nodeSize, 0);
savePage(bnode);
savePage(neighbor);
dataNode := dst;
replaceEntry(bnode^.parent, @dataNode^.key, getAddress(bnode));
discardPage(bnode);
discardPage(neighbor);
exit;
end
else
begin
// neighbor node is to the left. Take the last entry and prepend to bnode
dataNode := @neighbor^.data;
for curNode := 1 to neighbor^.numKeys-1 do
inc(dataNode, align(keySize(@dataNode^.key)));
// dataNode (hopefully) now points to the last key/value pair in neighbor
nodeSize := align(keySize(@dataNode^.key));
src := @bnode^.data;
dst := src;
inc(dst, nodeSize);
move(src^, dst^, bnode^.size - (dword(src) - dword(bnode)));
dst := src;
src := dataNode;
move(src^, dst^, nodeSize);
fillchar(src^, nodeSize, 0);
dec(neighbor^.size, nodeSize);
dec(neighbor^.numKeys);
inc(bnode^.size, nodeSize);
inc(bnode^.numKeys);
savePage(bnode);
savePage(neighbor);
// this can be optimized by storing the previous
// node from the for loop above
dataNode := @neighbor^.data;
for curNode := 1 to neighbor^.numKeys-1 do
inc(dataNode, align(keySize(@dataNode^.key)));
replaceEntry(neighbor^.parent, @dataNode^.key, getAddress(neighbor));
discardPage(bnode);
discardPage(neighbor);
exit;
end; // else
end;
end; //if (neighbor <> NIL) and (neighborSize <> 0)
end; // if (bnode^.size < (info^.bNodeSize / 2))
end; // else not root
end
else // not a leaf
begin
dataNode := @bnode^.data;
nextDataNode := dataNode;
nodeSize := align(keySize(@dataNode^.key));
inc(nextDataNode, nodeSize);
found := FALSE;
for curNode := 1 to bnode^.numKeys do
begin
found := (dataNode^.link = value);
if (found) then break;
if (curNode <> bnode^.numKeys) then
begin
dataNode := nextDataNode;
nodeSize := align(keySize(@nextDataNode^.key));
inc(nextDataNode, nodeSize);
end;
end;
if (not found) then
begin
if (nextDataNode^.link = value) then
nextDataNode^.link := dataNode^.link
else
begin
writeln(f, 'didn''t find: ', hex(value.u));
printInfo(getAddress(bnode));
discardPage(bnode);
exit;
end;
end;
{if (dataNode = nextDataNode) then inc(nextDataNode, align(keySize(@dataNode^.key)));}
// Copy this link into the next link so we can just delete this node
{nextDataNode^.link := dataNode^.link;}
fillchar(dataNode^, nodeSize, 0);
move(nextDataNode^, dataNode^, bnode^.size - (dword(nextDataNode) - dword(bnode)));
dec(bnode^.numKeys);
dec(bnode^.size, nodeSize);
dst := pointer(dword(bnode) + bnode^.size);
fillchar(dst^, nodeSize, 0);
// check for merges and other stuff
if (getAddress(bnode) = info^.root) then
begin
if (bnode^.numKeys = 0) then
begin
dataNode := @bnode^.data;
info^.root := dataNode^.link;
dec(info^.height);
deAllocNode(bnode);
bnode := loadPage(info^.root);
setNull(bnode^.parent);
savePage(bnode);
discardPage(bnode);
exit
end;
end
else {not root}
begin
if (bnode^.size < (info^.bNodeSize / 2)) then
begin
getNeighbor;
if (neighbor<>NIL) and (neighborSize<>0) then
begin
if (bnode^.size + neighborSize <= info^.bNodeSize) then
begin
// if neighbor is a predecessor of bnode then swap them
if (getAddress(neighbor) = bnode^.left) then
begin
tmpNode := bnode;
bnode := neighbor;
neighbor := tmpNode;
end;
// We need to get the key that currently resides between
// the bnode (left) link and the neighbor (right) link in the parent
parent := loadPage(bnode^.parent);
if (parent = NIL) then halt; // this would be bad
dataNode := @parent^.data;
for curNode := 0 to parent^.numKeys-1 do
begin
if (dataNode^.link = getAddress(bnode)) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for}
// theoretically dataNode^.key is the key between the two links
size := align(keySize(@dataNode^.key));
if ((bnode^.size + neighbor^.size + size - (dword(@bnode^.data) - dword(bnode))) > info^.bNodeSize) then
begin
// The key wouldn't fit. bail
discardPage(parent);
discardPage(neighbor);
savePage(bnode);
discardPage(bnode);
exit;
end;
// copy the key to the end of bnode
src := @dataNode^.key;
dst := pointer(dword(bnode) + bnode^.size);
move(src^, dst^, keySize(@dataNode^.key));
inc(bnode^.numKeys); // we just added a key
dec(size, sizeof(uPtr));
inc(bnode^.size, size); // increment by aligned size
inc(dst, size); // also increment the dst by aligned size
discardPage(parent); // don't need the parent any more
// merge the two nodes together
// bnode is the left node, neighbor is the right node
src := @neighbor^.data;
size := neighbor^.size - (dword(src) - dword(neighbor));
move(src^, dst^, size);
inc(bnode^.size, size);
inc(bnode^.numKeys, neighbor^.numKeys);
dataNode := @bnode^.data;
for curNode := 0 to bnode^.numKeys do
begin
setParent(dataNode^.link, getAddress(neighbor));
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for}
setRight(bnode^.left, getAddress(neighbor));
bnode^.right := neighbor^.right;
move(bnode^, neighbor^, info^.bNodeSize);
savePage(neighbor);
deleteEntry(bnode^.parent, NIL, getAddress(bnode));
deAllocNode(bnode);
discardPage(neighbor);
exit;
end
else // "acquire" an entry from a neighbor
begin
// we need to do one extra check
if (getAddress(neighbor) = bnode^.right) then
begin
tmpLink := getAddress(bnode);
tmpDataNode := @neighbor^.data;
end
else
begin
tmpLink := getAddress(neighbor);
tmpDataNode := @neighbor^.data;
for curNode := 1 to neighbor^.numKeys-1 do
inc(dataNode, align(keySize(@tmpDataNode^.key)));
end;
if (neighbor^.size - align(keySize(@tmpDataNode^.key)) < info^.bNodeSize / 2) then
begin
savePage(bnode);
discardPage(bnode);
discardPage(neighbor);
exit
end;
// get the key between the neighbor/bnode pair
parent := loadPage(bnode^.parent);
if (parent = NIL) then halt; // this would be bad
dataNode := @parent^.data;
for curNode := 1 to parent^.numKeys do
begin
if (dataNode^.link = tmpLink) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for}
// theoretically dataNode^.key is the key between the two links
nodeSize := align(keySize(@dataNode^.key));
// do one last check before we borrow
if (getAddress(neighbor) = bnode^.right) then
begin
savePage(neighbor);
src := @dataNode^.key;
dataNode := @neighbor^.data;
insertEntry(getAddress(bnode), src, dataNode^.link);
replaceEntry(getAddress(parent), @dataNode^.key, getAddress(bnode));
deleteEntry(getAddress(neighbor), NIL, dataNode^.link);
exit;
end
else
begin
// neighbor is to the left, bnode is to the right
savePage(bnode);
// We need to take the key from the parent node, coupled with the
// last value in the neighbor, and insert them into bnode
// To do this we have to move everything in bnode over
src := @dataNode^.key;
nodeSize := align(keySize(@dataNode^.key));
dataNode := @bnode^.data;
nextDataNode := dataNode;
inc(nextDataNode, nodeSize);
move(dataNode^, nextDataNode^, bnode^.size - (dword(dataNode) - dword(bnode)));
// copy in the key
fillchar(dataNode^, nodeSize, 0);
move(src^, dataNode^.key, keySize(src));
// now we update the size and keys
inc(bnode^.size, nodeSize);
inc(bnode^.numKeys);
// we still have to insert the value and update the child's parent ptr
tmpDataNode := dataNode;
dataNode := @neighbor^.data;
for curNode := 1 to neighbor^.numKeys-1 do
inc(dataNode, align(keySize(@dataNode^.key)));
nextDataNode := dataNode;
inc(nextDataNode, align(keySize(@dataNode^.key)));
// insert the value
tmpDataNode^.link := nextDataNode^.link;
setParent(tmpDataNode^.link, getAddress(bnode));
// need to change the insert (don't forget to update the child's parent ptr)
// insertEntry(getAddress(bnode), src, nextDataNode^.link);
replaceEntry(getAddress(parent), @dataNode^.key, getAddress(neighbor));
deleteEntry(getAddress(neighbor), NIL, nextDataNode^.link);
exit;
end;
end;
end;
end;
end;
end; {not a leaf}
savePage(bnode);
discardPage(bnode);
end; {bTree.deleteEntry}
procedure bTree.discardPage;
begin
// disk based trees allocate temporary memory to hold a page. So, if we're not
// a memory tree, dispose of the temp page
if not (memoryTree) then if (node <> NIL) then freemem(node, info^.bNodeSize);
end; {bTree.discardPage}
function bTree.insertEntry;
var
tmpUPtr:uPtr;
dataNode, nextDataNode, prevDataNode:PbNodeData;
midKey:BTreeSearchRec;
keyLength, curNode, dataSize, res:integer;
bnode, newNode, rootNode:PbNode;
nodeSize:uInt32;
begin
result := FALSE;
if (key = NIL) then exit;
case info^.treeType of
BT_STRING:writeln(f, 'Inserting: ', string(key^));
BT_PCHAR:writeln(f, 'Inserting: ', pchar(key));
end;
midKey.key := NIL;
midKey.keySize := 0;
keyLength := keySize(key);
if (keyLength = 0) or (keyLength > info^.bNodeSize) then exit;
nodeSize := align(keyLength);
if (isNull(info^.root)) then
begin
(*
* This case should only occur once when a directory is first created.
*)
info^.root := allocEmptyNode;
if (isNull(info^.root)) then halt;
rootNode := loadPage(info^.root);
inc(info^.keys);
inc(info^.height);
rootNode^.magic := B_NODE_LEAF;
dataNode := @rootNode^.data;
fillchar(dataNode^, nodeSize, 0);
dataNode^.link := value;
copyKey(key, @dataNode^.key);
inc(rootNode^.size, nodeSize); {hm.. should I add the sizeof the link?}
savePage(rootNode);
discardPage(rootNode);
result := TRUE;
exit
end;
bnode := loadPage(u);
if (bnode^.size + nodeSize <= info^.bNodeSize) then
begin
dataNode := @bnode^.data;
curNode := 0;
repeat
res := compareKeys(key, @dataNode^.key);
if (res <= 0) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
inc(curNode);
until curNode = bnode^.numKeys;
if (res = 0) then
begin
dataNode^.link := value;
savePage(bnode);
discardPage(bnode);
result := TRUE;
exit;
end;
nextDataNode := dataNode;
inc(nextDataNode, nodeSize); {cast to byte size records}
move(dataNode^, nextDataNode^, bnode^.size - (dword(dataNode) - dword(bNode)));
fillchar(dataNode^, nodeSize, 0);
copyKey(key, @dataNode^.key);
dataNode^.link := value;
if (bnode^.magic = B_NODE_INDEX) then
begin
if (not isNull(dataNode^.link)) then setParent(dataNode^.link, getAddress(bnode));
{ if (curNode = bnode^.numKeys) then
begin}
tmpUPtr := dataNode^.link;
dataNode^.link := nextDataNode^.link;
nextDataNode^.link := tmpUPtr;
{ end;}
end;
inc(bnode^.numKeys);
if (bnode^.magic = B_NODE_LEAF) then inc(info^.keys);
inc(bNode^.size, nodeSize);
savePage(bnode);
end
else
begin
newNode := loadPage(allocEmptyNode);
if (newNode = NIL) then halt;
newNode^.magic := bnode^.magic;
newNode^.left := getAddress(bnode);
newNode^.right := bnode^.right;
newNode^.parent := bnode^.parent;
if not(isNull(newNode^.right)) then setLeft(newNode^.right, getAddress(newNode));
bnode^.right := getAddress(newNode);
dataNode := @bnode^.data;
{for curNode:=0 to (bnode^.numKeys div 2)-1 do
inc(dataNode, align(keySize(@dataNode^.key)));}
curNode := 1;
repeat
prevDataNode := dataNode;
inc(dataNode, align(keySize(@dataNode^.key)));
inc(curNode);
until (dword(dataNode) - dword(bnode) >= bnode^.size shr 1);
{midKey := dataNode;}
dataNode := prevDataNode;
midKey.keySize := keySize(@dataNode^.key);
GetMem(midKey.key, midKey.KeySize);
{if (midKey.key = NIL) then halt;}
copyKey(@dataNode^.key, midKey.key);
dec(curNode);
if (bnode^.magic = B_NODE_LEAF) then
begin
{ newNode^.left := getAddress(bnode);
newNode^.right := bnode^.right;
if not(isNull(newNode^.right)) then setLeft(newNode^.right, getAddress(newNode));
bnode^.right := getAddress(newNode);}
inc(dataNode, align(keySize(@dataNode^.key)));
dataSize := bnode^.size - (dword(dataNode) - dword(bnode));
move(dataNode^, newNode^.data, dataSize);
fillchar(dataNode^, dataSize, 0);
dec(bnode^.size, dataSize);
newNode^.size := dataSize + (dword(@newNode^.data) - dword(newNode));
{newNode^.numKeys := bnode^.numKeys - (bnode^.numKeys div 2)-1;}
newNode^.numKeys := bnode^.numKeys - curNode;
dec(bnode^.numKeys, newNode^.numKeys);
savePage(bnode);
savePage(newNode);
if (compareKeys(key, midKey.key) <= 0) then
insertEntry(getAddress(bnode), key, value)
else
insertEntry(getAddress(newNode), key, value);
end
else {not a leaf}
begin
inc(dataNode, align(keySize(@dataNode^.key)));
dataSize := bnode^.size - (dword(dataNode) - dword(bnode));
move(dataNode^, newNode^.data, dataSize);
fillchar(dataNode^, dataSize, 0);
dec(bnode^.size, dataSize);
// we need to adjust the size because we're taking out the midkey
// and we're also adding that extra pointer
dec(bnode^.size, align(keySize(midkey.key)));
inc(bnode^.size, sizeof(uPtr));
newNode^.size := dataSize + (dword(@newNode^.data) - dword(newNode));
{newNode^.numKeys := bnode^.numKeys - (bnode^.numKeys div 2)-1;}
newNode^.numKeys := bnode^.numKeys - curNode;
dec(bnode^.numKeys, newNode^.numKeys);
dec(bnode^.numKeys);
savePage(bnode);
savePage(newNode);
dataNode := @newNode^.data;
for curNode := 0 to newNode^.numKeys do
begin
setParent(dataNode^.link, getAddress(newNode));
inc(dataNode, align(keySize(@dataNode^.key)));
end;
//savePage(bnode);
if (compareKeys(key, midKey.key) <= 0) then
insertEntry(getAddress(bnode), key, value)
else
insertEntry(getAddress(newNode), key, value);
end;
(*
* If we were the root node, then create a new one
*)
if (getAddress(bnode) = info^.root) then
begin
info^.root := allocEmptyNode;
rootNode := loadPage(info^.root);
setParent(getAddress(bnode), info^.root);
setParent(getAddress(newNode), info^.root);
inc(info^.height);
{dataNode := @newNode^.data; }
dataNode := @rootNode^.data;
with rootNode^ do
begin
magic := B_NODE_INDEX;
{numKeys := 1;}
dataNode^.link := getAddress(bnode);
keyLength := midKey.keySize;
copyKey(midKey.key, @dataNode^.key);
inc(size, align(keyLength));
inc(size, sizeof(uPtr));
inc(dataNode, align(keyLength));
dataNode^.link := getAddress(newNode);
end; {with}
savePage(rootNode);
discardPage(rootNode);
end {if oldNode = root}
else
begin
insertEntry(bnode^.parent, midKey.key, getAddress(newNode));
end;
if (midKey.key <> NIL) and (midKey.keySize <> 0) then FreeMem(midKey.key, midKey.keySize);
discardPage(newNode);
end; {if out of space in this node}
discardPage(bnode);
result := TRUE
end; {bTree.insertEntry}
function bTree.isNull;
begin
if (memoryTree) then
result := (u.bPtr = NIL)
else
result := (u.offset = -1)
end; {bTree.isNull}
function bTree.loadPage;
var node:PbNode;
begin
result := NIL;
if isNull(u) then exit;
if (memoryTree) then
node := u.bPtr
else
begin
seek(dataFile, dword(u.offset));
getmem(node, info^.bNodeSize);
blockread(dataFile, node^, 1);
end;
result := node
end; {bTree.loadPage}
function bTree.replaceEntry;
var
dataNode:PbNodeData;
node:PbNode;
curNode, res, srcKeySize, dstKeySize, deltaSize:integer;
src, dst:pointer;
begin
result := FALSE;
if ((key = NIL) or (isNull(u))) then exit;
node := loadPage(u);
if (node = NIL) then exit;
if (node^.magic <> B_NODE_INDEX) then
begin
writeln('Error! Not in index nodes.');
discardPage(node);
exit
end;
dataNode := @node^.data;
// possible bug on count
for curNode := 0 to node^.numKeys do
begin
if (dataNode^.link = value) then
begin
srcKeySize := keySize(key);
dstKeySize := keySize(@dataNode^.key);
deltaSize := align(srcKeySize) - align(dstKeySize);
if (deltaSize = 0) then
begin
// source and dest keys are equal length. Replace old key with new key
fillchar(dataNode^.key, dstKeySize, 0);
move(key^, dataNode^.key, srcKeySize);
end
else
if (deltaSize < 0) then
begin
// source key is smaller than dest key.
fillchar(dataNode^.key, dstKeySize, 0);
move(key^, dataNode^.key, srcKeySize);
src := dataNode;
dst := dataNode;
inc(src, align(dstKeySize)); // no, this isn't backwards
inc(dst, align(srcKeySize)); // we're copying from the old size
move(src^, dst^, node^.size - (dword(src) - dword(node)));
inc(node^.size, deltaSize); // deltaSize is negative
end
else
begin
// source key is bigger than dest key
if ((deltaSize + node^.size) > info^.bNodeSize) then
begin
writeln('Source key would cause split');
end
else // source key will fit
begin
// dataNode points to the value/key pair
src := dataNode;
dst := dataNode;
inc(src, align(dstKeySize));
inc(dst, align(srcKeySize));
move(src^, dst^, node^.size - (dword(src) - dword(node)));
fillchar(dataNode^.key, dstKeySize, 0);
move(key^, dataNode^.key, srcKeySize);
inc(node^.size, deltaSize);
end;
end;
break;
end;
inc(dataNode, align(keySize(@dataNode^.key)));
end;
discardPage(node);
result := TRUE;
end; {bTree.replaceEntry}
procedure bTree.savePage;
begin
if (memoryTree) then exit;
if (node = NIL) then exit;
seek(dataFile, dword(node^.tag));
blockwrite(dataFile, node^, 1);
end; {btree.savePage}
procedure bTree.setLeft;
var node:PbNode;
begin
node := loadPage(u);
if (node = NIL) then exit;
node^.left := newPtr;
savePage(node);
discardPage(node);
end; {bTree.setLeft}
procedure bTree.setParent;
var node:PbNode;
begin
node := loadPage(u);
if (node = NIL) then exit;
node^.parent := newPtr;
savePage(node);
discardPage(node);
end; {bTree.setParent}
procedure bTree.setNull;
begin
if (memoryTree) then
u.offset := 0
else
u.offset := -1;
end; {bTree.setNull}
procedure bTree.setRight;
var node:PbNode;
begin
node := loadPage(u);
if (node = NIL) then exit;
node^.right := newPtr;
savePage(node);
discardPage(node);
end; {bTree.setRight}
function bTree.fetchFirstKey;
var
node:PbNode;
dataNode:PbNodeData;
begin
result := FALSE;
if isNull(u) then exit;
node := loadPage(u);
if (node = NIL) then exit;
dataNode := @node^.data;
if (node^.magic = B_NODE_LEAF) then
begin
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
GetMem(searchRec.key, align(searchRec.keySize));
if (searchRec.key = NIL) then exit;
fillchar(searchRec.key^, align(searchRec.keySize), 0);
copyKey(@dataNode^.key, searchRec.key);
result := TRUE;
end
else
begin
result := fetchFirstKey(dataNode^.link, searchRec);
end;
discardPage(node);
end; {bTree.fetchFirstKey}
function bTree.fetchLastKey;
var
node:PbNode;
dataNode:PbNodeData;
curNode:integer;
begin
result := FALSE;
if isNull(u) then exit;
node := loadPage(u);
if (node = NIL) then exit;
dataNode := @node^.data;
if (node^.magic = B_NODE_LEAF) then
begin
for curNode := 1 to node^.numKeys-1 do
inc(dataNode, align(keySize(@dataNode^.key)));
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
GetMem(searchRec.key, align(searchRec.keySize));
if (searchRec.key = NIL) then exit;
fillchar(searchRec.key^, align(searchRec.keySize), 0);
copyKey(@dataNode^.key, searchRec.key);
result := TRUE;
end
else
begin
for curNode := 1 to node^.numKeys do
inc(dataNode, align(keySize(@dataNode^.key)));
result := fetchLastKey(dataNode^.link, searchRec);
end;
discardPage(node);
end; {bTree.fetchLastKey}
procedure bTree.findLeafNode;
var
bNode:PbNode;
dataNode:PbNodeData;
i:integer;
link:uPtr;
begin
setNull(result);
if (key = NIL) then exit;
if (isNull(u)) then exit;
bnode := loadPage(u);
if (bnode^.magic = B_NODE_LEAF) then
begin
result := u;
discardPage(bnode);
exit;
end
else
begin
dataNode := @bnode^.data;
for i:=0 to bnode^.numKeys -1 do
begin
if (compareKeys(key, @dataNode^.key) <= 0) then
begin
link := dataNode^.link;
discardPage(bnode);
result := findLeafNode(link, key);
exit;
end;
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for}
link := dataNode^.link;
discardPage(bnode);
result := findLeafNode(link, key);
end;
end; {bTree.findLeafNode}
procedure bTree.freeAll;
begin
if not(memoryTree) then exit;
freePage(info^.root);
setNull(info^.root);
end; {bTree.freeAll}
procedure bTree.freePage;
var
curNode:integer;
dataNode:PbNodeData;
node : PbNode;
begin
if isNull(u) then exit;
node := u.bPtr;
curNode := 0;
if (node^.magic = B_NODE_INDEX) then
begin
dataNode := @node^.data;
for curNode := 0 to node^.numKeys-1 do
begin
freePage(dataNode^.link);
inc(dataNode, align(keySize(@dataNode^.key)));
end;
freePage(dataNode^.link);
end;
freemem(node, info^.bNodeSize);
end; {bTree.freeAll}
function bTree.getAddress;
var u:uPtr;
begin
setNull(u);
if (memoryTree) then
u.bPtr := node
else
u.offset := node^.tag; { * bNodeSize;}
result := u;
end; {bTree.getAddress}
function bTree.Delete;
begin
result := deleteEntry(findLeafNode(info^.root, key), key, value);
end; {bTree.Delete}
function bTree.Find;
var
bnode:PbNode;
dataNode:PbNodeData;
i, res:integer;
begin
result := FALSE;
setNull(u);
bnode := loadPage(findLeafNode(info^.root, key));
if (bnode = NIL) then exit; {oops! serious problem}
if (bnode^.magic <> B_NODE_LEAF) then writeln('Error! not in leaf nodes');
dataNode := @bnode^.data;
for i:=0 to bnode^.numKeys-1 do
begin
res := compareKeys(@dataNode^.key, key); // strcomp(@dataNode^.key.str[1], pchar(key));
if (res >= 0) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for i}
// did we find it?
if (res = 0) then
begin
u := dataNode^.link;
result := TRUE;
end; {if res = 0}
discardPage(bnode);
end; {bTree.Find}
procedure bTree.FindClose;
begin
with searchRec do
begin
setNull(value);
if (key<>NIL) then
FreeMem(key, align(keySize));
key := NIL;
keySize := 0;
end; {with F}
end; {bTree.FindClose}
function bTree.FindFirst;
var
node:PbNode;
dataNode:PbNodeData;
curNode, res:integer;
begin
result := FALSE;
with searchRec do
begin
setNull(value);
key := NIL;
keySize := 0
end; {with searchRec}
if (key = NIL) then exit;
node := loadPage(findLeafNode(info^.root, key));
if (node = NIL) then exit;
dataNode := @node^.data;
curNode := 0;
repeat
res := compareKeys(key, @dataNode^.key);
if (res <= 0) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
inc(curNode);
until curNode = node^.numKeys;
if (res = 0) then // we found it
begin
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
GetMem(searchRec.key, align(searchRec.keySize));
fillchar(searchRec.key^, align(searchRec.keySize), 0);
if (searchRec.key = NIL) then exit;
copyKey(@dataNode^.key, searchRec.key);
result := TRUE;
end; {if res = 0}
discardPage(node);
end; {bTree.FindFirst}
function bTree.FindNext;
var
nextNode:uPtr;
node:PbNode;
dataNode:PbNodeData;
curNode, res:integer;
begin
result := FALSE;
if (searchRec.key = NIL) then exit;
node := loadPage(findLeafNode(info^.root, searchRec.key));
if (node = NIL) then
begin
findClose(searchRec);
exit
end;
dataNode := @node^.data;
curNode := 0;
repeat
res := compareKeys(@dataNode^.key, searchRec.key);
if (res > 0) then break;
inc(dataNode, align(keySize(@dataNode^.key)));
inc(curNode);
until curNode = node^.numKeys;
if (res <= 0) and (curNode = node^.numKeys) then
begin
nextNode := node^.right;
discardPage(node);
node := loadPage(nextNode);
if (node = NIL) then
begin
findClose(searchRec);
exit
end; {node = NIL}
dataNode := @node^.data;
end;
FreeMem(searchRec.key, align(searchRec.keySize));
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
searchRec.key := NIL;
GetMem(searchRec.key, align(searchRec.keySize));
// sanity check
if (searchRec.key <> NIL) then
begin
fillchar(searchRec.key^, align(searchRec.keySize), 0);
copyKey(@dataNode^.key, searchRec.key);
result := TRUE
end;
discardPage(node);
end; {bTree.FindNext}
function bTree.FindPrev;
var
prevNode:uPtr;
node:PbNode;
lastDataNode, dataNode:PbNodeData;
curNode, res:integer;
begin
result := FALSE;
if (searchRec.key = NIL) then exit;
node := loadPage(findLeafNode(info^.root, searchRec.key));
if (node = NIL) then
begin
findClose(searchRec);
exit
end;
dataNode := @node^.data;
lastDataNode := dataNode;
curNode := 0;
res := compareKeys(searchRec.key, @dataNode^.key);
if (res > 0) then
repeat
lastDataNode := dataNode;
inc(curNode);
inc(dataNode, align(keySize(@dataNode^.key)));
res := compareKeys(searchRec.key, @dataNode^.key);
until (res <= 0) or (curNode = node^.numKeys);
dataNode := lastDataNode;
if ((res <= 0) and (curNode = 0)) then
begin
prevNode := node^.left;
discardPage(node);
node := loadPage(prevNode);
if (node = NIL) then
begin
FindClose(searchRec);
exit
end;
dataNode := @node^.data;
// scan to the end of the previous node.
// If there's only 1 key, this will do nothing
for curNode := 1 to node^.numKeys-1 do
inc(dataNode, align(keySize(@dataNode^.key)));
end;
FreeMem(searchRec.key, align(searchRec.keySize));
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
searchRec.key := NIL;
GetMem(searchRec.key, align(searchRec.keySize));
// sanity check
if (searchRec.key <> NIL) then
begin
fillchar(searchRec.key^, align(searchRec.keySize), 0);
copyKey(@dataNode^.key, searchRec.key);
result := TRUE
end;
discardPage(node)
end; {bTree.FindPrev}
function bTree.GetFirstKey;
var
childLink:uPtr;
node:PbNode;
dataNode:PbNodeData;
begin
with searchRec do
begin
setNull(value);
key := NIL;
keySize := 0;
end; {with searchRec}
result := fetchFirstkey(info^.root, searchRec);
(*
dataNode := @node^.data;
while (node <> NIL) and (node^.magic <> B_NODE_LEAF) do
begin
childLink := dataNode^.link;
discardPage(node);
node := loadPage(childLink);
dataNode := @node^.data;
end;
if (node = NIL) then exit;
searchRec.value := dataNode^.link;
searchRec.keySize := keySize(@dataNode^.key);
GetMem(searchRec.key, align(searchRec.keySize));
if (searchRec.key = NIL) then exit;
fillchar(searchRec.key^, align(searchRec.keySize), 0);
copyKey(@dataNode^.key, searchRec.key);
discardPage(node);
result := TRUE *)
end; {bTree.GetFirstKey}
function bTree.GetLastKey;
var
childLink:uPtr;
node:PbNode;
dataNode:PbNodeData;
curNode:integer;
begin
with searchRec do
begin
setNull(value);
key := NIL;
keySize := 0;
end; {with searchRec}
result := fetchLastKey(info^.root, searchRec);
end; {bTree.GetLastKey}
procedure bTree.PrintInfo;
const leafStr:array[boolean] of string[5] = ('INDEX', 'LEAF');
var
dataNode:PbNodeData;
curNode:integer;
node : PbNode;
i:integer;
begin
node := loadPage(u);
if (node = NIL) then exit;
write(f, ' ', hex(dword(node^.parent.offset)));
writeln(f, ' ', leafStr[node^.magic = B_NODE_LEAF], ' (', hex(node^.magic), ')');
write(f, hex(dword(node^.left.bPtr)), ' <-> ', hex(dword(node)), ' <-> ', hex(dword(node^.right.bPtr)));
writeln(f, ' | capacity ', node^.size, '[', calcSize(node), '](', info^.bNodeSize, ') | keys:', node^.numKeys);
if (node^.numKeys = 0) then exit;
dataNode := @node^.data;
curNode := 0;
for curNode := 0 to node^.numKeys-(ord(node^.magic = B_NODE_LEAF)) do
begin
write(f, '| ', curNode:2, '| ');
{if (node^.magic = B_NODE_INDEX) then}
write(f, '[', hex(dword(dataNode^.link.offset)), ']');
if (curNode <> node^.numKeys) then
case info^.treeType of
BT_INT32:writeln(f, ' {', dataNode^.key.i, '} ');
BT_INT64:writeln(f, ' {', dataNode^.key.x, '} ');
BT_SINGLE:writeln(f, ' {', dataNode^.key.s, '} ');
BT_DOUBLE:writeln(f, ' {', dataNode^.key.d, '} ');
BT_STRING:writeln(f, ' {', dataNode^.key.str, '} ');
BT_PCHAR:begin
(*writeln(f, ' {', pchar(@dataNode^.key)^, '} '); *)
write(f, ' {');
i:=0;
while (dataNode^.key.str[i]<>#0) do
begin
write(f, dataNode^.key.str[i]);
inc(i);
end;
writeln(f, '} ');
end;
end;
inc(dataNode, align(keySize(@dataNode^.key)));
end;
discardPage(node);
writeln(f);
end; {bTree.PrintInfo}
function bTree.Insert;
begin
result := insertEntry(findLeafNode(info^.root, key), key, value);
end; {bTree.Insert}
procedure bTree.InstallUserFunctions;
begin
compareKeys := cmpFunc;
copyKey := copyProc;
keySize := ksFunc;
end; {bTree.InstallUserFunc}
procedure bTree.Print;
var
curNode:integer;
dataNode:PbNodeData;
node : PbNode;
link : uPtr;
begin
if isNull(u) then exit;
PrintInfo(u);
node := loadPage(u);
curNode := 0;
if (node^.magic = B_NODE_INDEX) then
begin
dataNode := @node^.data;
for curNode := 0 to node^.numKeys-1 do
begin
Print(dataNode^.link);
inc(dataNode, align(keySize(@dataNode^.key)));
end;
Print(dataNode^.link);
end;
discardPage(node);
end; {bTree.Print}
procedure bTree.PrintList;
var
dataNode:PbNodeData;
node:PbNode;
link:uPtr;
i : integer;
begin
if (isNull(info^.root)) then exit;
node := loadPage(info^.root);
while (node^.magic = B_NODE_INDEX) do
begin
dataNode := @node^.data;
link := dataNode^.link;
discardPage(node);
node := loadPage(link);
end;
while (not isNull(link)) do
begin
dataNode := @node^.data;
for i := 0 to node^.numKeys -1 do
begin
writeln(f, dataNode^.key.str);
inc(dataNode, align(keySize(@dataNode^.key)));
end; {for i}
link := node^.right;
discardPage(node);
node := loadPage(link);
end; {while}
end; {bTree.PrintList}
procedure bTree.PrintWholeTree;
begin
Print(info^.root);
writeln(f, '---------------------------------------------------------------------------');
end; {bTree.PrintWholeTree}
destructor bTree.done;
begin
if not(memoryTree) then
begin
reset(dataFile, 1);
blockwrite(dataFile, info^, sizeof(BTreeInfo));
close(dataFile);
end;
if (not isNull(info^.root)) then
with info^ do
begin
writeln('tree height: ', height);
writeln('tree leaf key count: ', keys);
writeln('Total number of nodes: ', nodes);
freeAll;
close(f);
end;
end; {bTree.done}
end.
