unit BPTree; interface uses UbixFS, strings; const B_NODE_LEAF = $4641454C; const B_NODE_INDEX = $58444E49; const B_NODE_OPEN = $4E45504F; const B_MAX_NAME_LENGTH = 254; type PbNode = ^TbNode; PbNodeData = ^TbNodeData; uPtr = packed record case integer of 0: (iAddr : inodeAddr); 1: (bPtr : PbNode); 2: (offset : int64); { 3: (iPtr : PubixfsInode);} 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; {data : array[0..64-1] of byte;} {data : array[0..464-1] of byte;} {data : array[0..464+512-1] of byte;} {data : array[0..4048-1] of byte;} end; TbNodeData = packed record link : uPtr; key : string[1]; end; {TbNode} type PbTree = ^bTree; bTree = object private root : uPtr; curTag : uInt32; treeHeight : uInt32; treeLeafKeys : uInt32; firstDeleted : uPtr; dataFile : file; memoryTree : boolean; f:text; bNodeSize : uInt32; { fs : PUbixFS; header : PbTreeHeader; fd : PfileDescriptor; tag : uInt32;} function align(keyLength:integer):integer; function allocEmptyNode:uPtr; procedure deAllocNode(node:PbNode); function deleteEntry(u:uPtr; key :PChar; value:uPtr):uPtr; procedure discardPage(node:PbNode); function findLeafNode(u:uPtr; key:PChar):uPtr; procedure freeAll; procedure freePage(u:uPtr); function getAddress(node:PbNode):uPtr; function insertEntry(u:uPtr; key:PChar; value:uPtr):boolean; function isNull(u:uPtr):boolean; function loadPage(u:uPtr):PbNode; procedure savePage(node:PbNode); procedure setLeft(u:uPtr; newPtr:uPtr); procedure setRight(u:uPtr; newPtr:uPtr); procedure setParent(u:uPtr; newPtr:uPtr); public constructor init(const filename:string); function Delete(key:PChar; value:uPtr):uPtr; function Insert(key:PChar; value:uPtr):boolean; function Find(key:PChar):uPtr; procedure Info(u:uPtr); procedure Print(u:uPtr); procedure PrintList; procedure PrintWholeTree; destructor done; end; {bTree} var nulluPtr:uPtr; implementation uses strings, dos, crt; function compareUPtrs(u1, u2:uPtr):boolean; begin { if (memoryTree) then result := (u1.bPtr = u2.bPtr) else} result := (u1.offset = u2.offset); end; {compareUPtrs} overload = = compareUPtrs; constructor bTree.init; var node:PbNode; begin root := nulluptr; curTag := 0; treeHeight := 0; treeLeafKeys := 0; bNodeSize := 1024; firstDeleted := nullUPtr; memoryTree := fileName = ''; if not (memoryTree) then begin assign(dataFile, filename); if (fsearch(filename, '')<>'') then reset(dataFile, bNodeSize) else rewrite(dataFile, bNodeSize); getmem(node, bNodeSize); fillchar(node^, bNodeSize, 0); curTag := fileSize(dataFile); if (filesize(dataFile) <> 0) then begin blockread(dataFile, node^, 1); while not (isNull(node^.parent)) do begin seek(dataFile, dword(node^.parent.offset)); blockread(dataFile, node^, 1); end; root := getAddress(node); end; freemem(node, bNodeSize); end; assign(f, 'output.txt'); {assign(f, '');} rewrite(f); end; {bTree.init} function bTree.align; begin result := ((sizeof(TbNodeData) + keyLength + 7) shr 3) shl 3; end; function bTree.allocEmptyNode; var newNode:PbNode; begin result := nulluptr; if (not isNull(firstDeleted)) then begin newNode := loadPage(firstDeleted); if (newNode = NIL) then exit; firstDeleted := newNode^.parent; end else begin getmem(newNode, bNodeSize); fillchar(newNode^, bNodeSize, 0); newNode^.tag := curTag; inc(curTag); end; with newNode^ do begin magic := B_NODE_LEAF; numKeys := 1; size := dword(@newNode^.data) - dword(newNode); left := nulluPtr; right := nulluptr; parent := nulluptr; reserved := nulluptr; end; {with} result := getAddress(newNode); savePage(newNode); discardPage(newNode); end; {bTree.allocEmptyNode} procedure bTree.deAllocNode; begin if (node = NIL) then exit; with node^ do begin magic := B_NODE_OPEN; left := nulluPtr; right := nulluPtr; parent := firstDeleted; reserved := nulluPtr; if (numKeys <> 0) then writeln('Warning! Node isn''t completely empty!'); {numKeys := 1; no keys, but get it ready for the next use} size := dword(@node^.data) - dword(node); fillchar(data, bNodeSize - size, 0); end; firstDeleted := getAddress(node); end; {btree.deAllocNode} function bTree.deleteEntry; var bnode : PbNode; dataNode, nextDataNode:PbNodeData; nodeSize:uInt32; curNode, res: integer; found: boolean; begin result := nulluPtr; 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 dataNode := @bnode^.data; curNode := 0; repeat res := strcomp(@dataNode^.key[1], key); if (res >= 0) then break; inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); inc(curNode); until (curNode = bnode^.numKeys); if (res <> 0) then exit; result := dataNode^.link; nodeSize := align(length(dataNode^.key)); nextDataNode := dataNode; inc(uInt8ArrayPtr(nextDataNode), nodeSize); move(nextDataNode^, dataNode^, bnode^.size - (dword(dataNode) - dword(bnode) - nodeSize)); dec(bnode^.numKeys); dec(bnode^.size, nodeSize); dataNode := pointer(dword(bnode) + bnode^.size); fillchar(dataNode^, nodeSize, 0); dec(treeLeafKeys); if (bnode^.numKeys = 0) then begin savePage(bnode); if not(isNull(bnode^.left)) then setRight(bnode^.left, bnode^.right); {bnode^.left.bPtr^.right.bPtr := bnode^.right.bPtr;} if not(isNull(bnode^.right)) then setLeft(bnode^.right, bnode^.left); {bnode^.right.bPtr^.left.bPtr := bnode^.left.bPtr;} if (getAddress(bnode) = root) then root := nulluptr else deleteEntry(bnode^.parent, NIL, getAddress(bnode)); deAllocNode(bnode); end; end else {not a leaf} begin dataNode := @bnode^.data; found := FALSE; curNode := 0; for curNode := 0 to bnode^.numKeys do begin if (curNode <> bnode^.numKeys) then nodeSize := align(length(dataNode^.key)); found := (dataNode^.link.bPtr = value.bPtr); if (found) then break; inc(uInt8ArrayPtr(dataNode), nodeSize); end; if (not found) then begin discardPage(bnode); exit; end; nextDataNode := dataNode; inc(uInt8ArrayPtr(nextDataNode), nodeSize); if (curNode = bnode^.numKeys) then nextDataNode^.link := dataNode^.link; fillchar(dataNode^, nodeSize, 0); move(nextDataNode^, dataNode^, bnode^.size - (dword(dataNode) - dword(bnode) - nodeSize)); dec(bnode^.numKeys); dec(bnode^.size, nodeSize); if (bnode^.numKeys = 0) then begin (* * technically we don't have to set left/right pointers in an index node *) if not(isNull(bnode^.left)) then setRight(bnode^.left, bnode^.right); {bnode^.left.bPtr^.right.bPtr := bnode^.right.bPtr;} if not(isNull(bnode^.right)) then setLeft(bnode^.right, bnode^.left); {orig: bnode^.right.bPtr^.left.bPtr := bnode^.left.bPtr;} savePage(bnode); if (getAddress(bnode) = root) then begin dataNode := @bnode^.data; root := dataNode^.link; dec(treeHeight); end else {not the root} begin deleteEntry(bnode^.parent, NIL, getAddress(bnode)); end; deAllocNode(bnode); end; {if bnode^.numKeys = 0} end; savePage(bnode); discardPage(bnode); end; {bTree.deleteEntry} procedure bTree.discardPage; begin if not (memoryTree) then if (node <> NIL) then freemem(node, bNodeSize); end; {bTree.discardPage} function bTree.insertEntry; var midKey:array[byte] of char; dataNode, nextDataNode:PbNodeData; nodeSize:uInt32; keyLength:integer; curNode : integer; dataSize:integer; tmpUPtr:uPtr; bnode, newNode, rootNode:PbNode; begin { writeln(f, 'Inserting: ', key);} result := FALSE; keyLength := strlen(key); // keep in mind that we use length + string + null, so the actual maxlength is 254 instead of 255 if (keyLength = 0) or (keyLength > B_MAX_NAME_LENGTH) then exit; nodeSize := align(keyLength); { writeln('nodeSize: ', nodeSize); nodeSize := sizeof(TbNodeData) + keyLength; inc(nodeSize, 8 - (nodeSize and not -8));} if (isNull(root)) then begin (* * This case should only occur once when a directory is first created. *) root := allocEmptyNode; if (isNull(root)) then halt; rootNode := loadPage(root); inc(treeLeafKeys); inc(treeHeight); rootNode^.magic := B_NODE_LEAF; dataNode := @rootNode^.data; fillchar(dataNode^, nodeSize, 0); dataNode^.link := value; dataNode^.key[0] := char(keyLength); move(key^, dataNode^.key[1], keyLength); inc(rootNode^.size, nodeSize); savePage(rootNode); discardPage(rootNode); result := TRUE; exit end; bnode := loadPage(u); if (bnode^.size + nodeSize <= bNodeSize) then begin dataNode := @bnode^.data; curNode := 0; repeat if (strcomp(key, @dataNode^.key[1]) <= 0) then break; inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); inc(curNode); until curNode = bnode^.numKeys; nextDataNode := dataNode; inc(uInt8ArrayPtr(nextDataNode), nodeSize); {cast to byte size records} move(dataNode^, nextDataNode^, bnode^.size - (dword(dataNode) - dword(bNode))); fillchar(dataNode^, nodeSize, 0); dataNode^.key[0] := char(keyLength); move(key^, dataNode^.key[1], keyLength); dataNode^.link := value; if (bnode^.magic = B_NODE_INDEX) then begin if (not isNull(dataNode^.link)) then setParent(dataNode^.link, getAddress(bnode)); {if (dataNode^.link.bPtr <> NIL) then dataNode^.link.bPtr^.parent.bPtr := bnode;} tmpUPtr := dataNode^.link; dataNode^.link := nextDataNode^.link; nextDataNode^.link := tmpUPtr; end; inc(bnode^.numKeys); if (bnode^.magic = B_NODE_LEAF) then inc(treeLeafKeys); 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(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); fillchar(midKey, sizeof(midKey), 0); move(dataNode^.key[1], midKey, length(dataNode^.key)); 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(uInt8ArrayPtr(dataNode), align(length(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; dec(bnode^.numKeys, newNode^.numKeys); savePage(bnode); savePage(newNode); if (strcomp(key, midKey) <= 0) then insertEntry(getAddress(bnode), key, value) else insertEntry(getAddress(newNode), key, value); end else {not a leaf} begin inc(uInt8ArrayPtr(dataNode), align(length(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; dec(bnode^.numKeys, newNode^.numKeys); dec(bnode^.numKeys); savePage(newNode); dataNode := @newNode^.data; for curNode := 0 to newNode^.numKeys do begin setParent(dataNode^.link, getAddress(newNode)); {dataNode^.link.bPtr^.parent.bPtr := newNode;} inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); end; savePage(bnode); if (strcomp(key, midKey) <= 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) = root) then begin root := allocEmptyNode; rootNode := loadPage(root); setParent(getAddress(bnode), root); setParent(getAddress(newNode), root); { bnode^.parent := root; newNode^.parent := root;} inc(treeHeight); {dataNode := @newNode^.data; } dataNode := @rootNode^.data; with rootNode^ do begin magic := B_NODE_INDEX; {numKeys := 1;} dataNode^.link := getAddress(bnode); keyLength := strlen(midKey); dataNode^.key[0] := char(keyLength); move(midKey, dataNode^.key[1], keyLength); inc(size, align(keyLength)); inc(size, sizeof(uPtr)); inc(uInt8ArrayPtr(dataNode), align(keyLength)); dataNode^.link := getAddress(newNode); end; {with} savePage(rootNode); discardPage(rootNode); end {if oldNode = root} else begin insertEntry(bnode^.parent, midKey, getAddress(newNode)); end; 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 = nulluPtr.bPtr) else result := (u.offset = nulluPtr.offset) 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, bNodeSize); blockread(dataFile, node^, 1); end; result := node end; {bTree.loadPage} 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.setRight; var node:PbNode; begin node := loadPage(u); if (node = NIL) then exit; node^.right := newPtr; savePage(node); discardPage(node); end; {bTree.setRight} procedure bTree.findLeafNode; var bNode:PbNode; dataNode:PbNodeData; i:integer; link:uPtr; begin result := nullUPtr; 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 (strcomp(key, @dataNode^.key[1]) <= 0) then begin link := dataNode^.link; discardPage(bnode); result := findLeafNode(link, key); exit; end; inc(uInt8ArrayPtr(dataNode), align(length(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(root); root := nulluptr; 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(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); end; freePage(dataNode^.link); end; freemem(node, bNodeSize); end; {bTree.freeAll} function bTree.getAddress; var u:uPtr; begin u := nulluptr; if (memoryTree) then u.bPtr := node else u.offset := node^.tag; { * bNodeSize;} result := u; end; {bTree.getAddress} function bTree.Delete; begin result := find(key); { result := deleteEntry(findLeafNode(root, key), key, value);} end; {bTree.Delete} function bTree.Find; var bnode:PbNode; dataNode:PbNodeData; i, res:integer; begin result := nulluPtr; bnode := loadPage(findLeafNode(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 := strcomp(@dataNode^.key[1], key); if (res >= 0) then break; inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); end; if (res = 0) then result := dataNode^.link; discardPage(bnode); end; {bTree.Find} procedure bTree.Info; const leafStr:array[boolean] of string[5] = ('INDEX', 'LEAF'); var dataNode:PbNodeData; curNode:integer; node : PbNode; begin node := loadPage(u); if (node = NIL) then exit; write(f, ' ', hex(dword(node^.parent.offset))); writeln(f, ' ', leafStr[node^.magic = B_NODE_LEAF]); write(f, hex(dword(node^.left.bPtr)), ' <-> ', hex(dword(node)), ' <-> ', hex(dword(node^.right.bPtr))); writeln(f, ' | capacity ', node^.size,'(', 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, '| '); write(f, '['); if (node^.magic = B_NODE_LEAF) then begin { if (dataNode^.link.iPtr <> NIL) then write(f, dataNode^.link.iPtr^.name) else write(f, '/');} end else write(f, hex(longint(dword(dataNode^.link.offset)))); write(f, ']'); if (curNode <> node^.numKeys) then writeln(f, ' {', dataNode^.key, '} '); inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); end; discardPage(node); writeln(f); end; {bTree.Info} function bTree.Insert; begin result := insertEntry(findLeafNode(root, key), key, value); end; {bTree.Insert} procedure bTree.Print; var curNode:integer; dataNode:PbNodeData; node : PbNode; link : uPtr; begin if isNull(u) then exit; Info(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(uInt8ArrayPtr(dataNode), align(length(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(root)) then exit; node := loadPage(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); inc(uInt8ArrayPtr(dataNode), align(length(dataNode^.key))); end; {for i} link := node^.right; discardPage(node); node := loadPage(link); end; {while} end; {bTree.PrintList} procedure bTree.PrintWholeTree; begin Print(root); writeln(f, '---------------------------------------------------------------------------'); end; {bTree.PrintWholeTree} destructor bTree.done; begin if not(memoryTree) then close(dataFile); if (not isNull(root)) then begin writeln('tree height: ', treeHeight); writeln('tree leaf key count: ', treeLeafKeys); writeln('Total number of nodes: ', curTag); freeAll; close(f); end; end; {bTree.done} begin {$ifdef MEMORY_TREE} fillchar(nulluptr, sizeof(nulluptr), 0); {$else} nulluptr.offset := -1; {$endif} end.