unit BPTree;

interface

uses UbixFS, strings;

const B_NODE_MAGIC = $DEADBEEF;

const B_MAX_KEYS = 15;
const B_MAX_NAME_LENGTH = 256;

type
  PbNode = ^TbNode;
  PbNodeData = ^TbNodeData;

  uPtr = packed record
   case integer of
     0: (iAddr  : inodeAddr);
     1: (bPtr   : PbNode);
     2: (vPtr   : pointer);
     3: (iPtr   : PubixfsInode);
     4: (nPtr   : PbNodeData);
     5: (offset : int64);
  end;

  TbNode = packed record
    magic1   : uInt32;
    numKeys  : uInt32;
    tag      : uInt32;
    size     : uInt32;
    leaf     : longbool;
    reserved : uInt32;
    left     : uPtr;
    right    : uPtr;
    parent   : uPtr;
    data     : array[0..4040-1] of byte;
  end;

  TbNodeData = packed record
    link     : uPtr;
    key      : string[1];
  end; {TbNode}

  (*
  TbNode = packed record
    magic1 : uInt32;
    used   : uInt32;
    parent : uPtr;
    tag    : int64;
    keys   : array[0..B_MAX_KEYS-1, 0..B_MAX_NAME_LENGTH-1] of char;
    present: array[0..B_MAX_KEYS] of boolean;
    head   : array[0..B_MAX_KEYS] of uPtr;
    childCount : array[0..B_MAX_KEYS] of uInt32;
    magic2 : uInt32;
    leaf   : boolean;
    reserved : array[0..18] of byte;
  end; {bNode}
  *)
type
  PbTreeHeader = ^TbTreeHeader;
  TbTreeHeader = packed record
    treeDepth       : uInt32;
    treeWidth       : uInt32;
    treeLeafCount   : uInt32;
    firstNodeOffset : int64;
    firstDeleted    : int64;
    paddington      : array[0..4067] of byte;
  end; {bTreeHeader}

type
  PbTree = ^bTree;
  bTree = object
   private
    root      : PbNode;
    curTag    : uInt32;
{    fs        : PUbixFS;
    header    : PbTreeHeader;
    fd        : PfileDescriptor;
    tag       : uInt32;}
    function    allocEmptyNode:PbNode;
{    function    getFirstNode(node:PbNode):PubixfsInode;
    function    inodeSearch(inode:PubixfsInode; const key:PChar):PubixfsInode;
    procedure   insertNode(node:PbNode; const key:PChar; headPtr:PbNode);
    procedure   splitNode(oldNode:PbNode);
    function    treeSearch(bnode:PbNode; const key:PChar):PubixfsInode;}
   public
    constructor init;
    function    Insert(key:PChar; var value):boolean;
{    function    Find(key:PChar):PubixfsInode;}
    procedure   Info(node:PbNode);
{    function    Insert(inode:PubixfsInode):boolean;
    procedure   Print(node:PbNode);
    procedure   PrintWholeTree;}
    destructor  done;
  end; {bTree}

implementation

uses strings, dos, crt;

constructor bTree.init;
begin
  root   := NIL;
  curTag := 0;
end; {bTree.init}

function bTree.allocEmptyNode;
var newNode:PbNode;
begin
  new(newNode);
  fillchar(newNode^, sizeof(newNode^), 0);
  inc(curTag);
  with newNode^ do
    begin
      magic1         := B_NODE_MAGIC;
      numKeys        := 1;
      tag            := curTag;
      leaf           := FALSE;  { assume? }
      left.vPtr      := NIL;
      right.vPtr     := NIL;
      parent.vPtr    := NIL;

      size           := sizeof(magic1) + sizeof(numKeys) + sizeof(tag) +
                        sizeof(leaf) + sizeof(left) + sizeof(right) +
                        sizeof(reserved) + sizeof(parent) + sizeof(size) +
                        sizeof(uPtr);
{      writeln('allocated size is: ', size);}
    end; {with}
  result := newNode;
end; {bTree.allocEmptyNode}

procedure bTree.Info;
var
  nodeData:PbNodeData;
  i:integer;

begin
  if ((node = NIL) or (root = NIL)) then exit;

  writeln(hex(longint(node)), ' | ', hex(longint(node^.parent.bPtr)));

  nodeData := @node^.data;
  for i := 0 to node^.numKeys do
    begin
      write('[');
      if (nodeData^.link.iPtr <> NIL) then
        write(nodeData^.link.iPtr^.name)
      else
        write('/');
      write(']');
      if (i <> node^.numKeys) then
        write(' {', nodeData^.key, '} ');
      inc(uInt8ArrayPtr(nodeData), ((sizeof(TbNodeData) + length(nodeData^.key) + 3) shr 2) shl 2);
    end; {for i}
  writeln;
end; {bTree.Info}

function bTree.Insert;
var
  dataNode, nextDataNode:PbNodeData;
  nodeSize, tmpSize:uInt32;
  keyLength:integer;
  bnode:PbNode;
  curNode : integer;
  p, src, dst:pointer;
  f:file;
begin
  result := FALSE;

  keyLength := strlen(key);
  if (keyLength = 0) or (keyLength > 255) then exit;

  nodeSize := ((sizeof(TbNodeData) + keyLength + 7) shr 3) shl 3;
{  writeln('nodeSize: ', nodeSize);
  nodeSize := sizeof(TbNodeData) + keyLength;
  inc(nodeSize, 8 - (nodeSize and not -8));}

  if (root = NIL) then
    begin
  writeln('-- 1 --');
      root := allocEmptyNode;
      if (root = NIL) then halt;

      dataNode := @root^.data;

      fillchar(dataNode^, nodeSize, 0);

      dataNode^.link.iPtr := NIL;
      dataNode^.key[0] := char(keyLength);
      move(key^, dataNode^.key[1], keyLength);

      with root^ do
        begin
          inc(uInt8ArrayPtr(dataNode), nodeSize); {cast to byte size records}
          dataNode^.link.iPtr := uPtr(value).iPtr;
          leaf := TRUE;
          inc(size, nodeSize);
        end;
info(root);
      result := TRUE;
      exit
    end;

  bnode := root;

  while not bnode^.leaf do
    begin
    end;

  dataNode := @bnode^.data;

  with bNode^ do
    if (numKeys = 1) and (dataNode^.link.iPtr = NIL) then
      begin
        if (strcomp(key, @dataNode^.key[1]) < 0) then
          dataNode^.link.iPtr := uPtr(value).iPtr
        else
          begin
            writeln('-- 2 --');
            nodeSize := ((sizeof(TbNodeData) + length(dataNode^.key) + 7) shr 3) shl 3;
            // decrease the size by the size of the first node
            dec(size, nodeSize);

            nextDataNode := dataNode;
            inc(uInt8ArrayPtr(nextDataNode), nodeSize); {cast to byte size records}
            dataNode^.link.iPtr := nextDataNode^.link.iPtr;

            // make a string

            dataNode^.key[0] := char(keyLength);
            move(key^, dataNode^.key[1], keyLength);

            nodeSize := ((sizeof(TbNodeData) + length(dataNode^.key) + 7) shr 3) shl 3;
            inc(uInt8ArrayPtr(dataNode), nodeSize); {cast to byte size records}
            dataNode^.link.iPtr := uPtr(value).iPtr;
            // readjust the size based on the size of the new data
            inc(size, nodeSize);
          end;
info(bnode);
        result := TRUE;
        exit
    end; {if}


  curNode := 0;
  repeat
    if (strcomp(key, @dataNode^.key[1]) < 0) then break;
    inc(uInt8ArrayPtr(dataNode), ((sizeof(TbNodeData) + length(dataNode^.key) + 7) shr 3) shl 3); {cast to byte size records}
    inc(curNode);
  until curNode = bnode^.numKeys;

  if (curNode = bnode^.numKeys) then
    begin
      writeln('--- 3 ---');
      nextDataNode := dataNode;
      inc(uInt8ArrayPtr(nextDataNode), nodeSize); {cast to byte size records}

      dataNode^.key[0] := char(keyLength);
      move(key^, dataNode^.key[1], keyLength);
      nextDataNode^.link.iPtr := uPtr(value).iPtr;
      inc(bNode^.size, nodeSize);
    end
  else
    begin
      if (curNode = 0) and
          ((dataNode^.link.iPtr <> NIL) and (strcomp(key, dataNode^.link.iPtr^.name) < 0)) then
        begin
          writeln('---- 4a ----');

          // we need to move the data over by the size of the name in the first link
          // note that we might need to split the node first
           
          keyLength := strlen(dataNode^.link.iPtr^.name);
          nodeSize := ((sizeof(TbNodeData) + keyLength + 7) shr 3) shl 3;
          nextDataNode := dataNode;
          inc(uInt8ArrayPtr(nextDataNode), nodeSize); {cast to byte size records}
          move(dataNode^, nextDataNode^, bnode^.size - (dword(dataNode) - dword(bNode)));

          dataNode^.key[0] := char(keyLength);
          move(dataNode^.link.iPtr^.name, dataNode^.key[1], keyLength);
          dataNode^.link.iPtr := uPtr(value).iPtr;
          nodeSize := ((sizeof(TbNodeData) + keyLength + 7) shr 3) shl 3;
          inc(bNode^.size, nodeSize);
        end
      else
        begin
          writeln('---- 4b ----');
          nextDataNode := dataNode;
          inc(uInt8ArrayPtr(nextDataNode), nodeSize); {cast to byte size records}
          move(dataNode^, nextDataNode^, bnode^.size - (dword(dataNode) - dword(bNode)));
          dataNode^.key[0] := char(keyLength);
          move(key^, dataNode^.key[1], keyLength);
          nextDataNode^.link.iPtr := uPtr(value).iPtr;
          inc(bNode^.size, nodeSize);
        end;
    end;

  inc(bnode^.numKeys);
info(bnode);

  result := TRUE;
end; {bTree.Insert}

destructor bTree.done;
var f:file;
begin
  if (root <> NIL) then
    begin
      assign(f, 'tree.dat');
      rewrite(f, sizeof(TbNode));
      blockwrite(f, root^, 1);
      close(f);
    end;
  if (root<>NIL) then dispose(root);
end; {bTree.done}


{$ifdef foo}
constructor bTree.init;
begin
  root := NIL;
  tag := 0;
  new(header);
  if (header = NIL) then halt;
  fillchar(header^, sizeof(TbTreeHeader), 0);
  with header^ do
    begin
      treeDepth := 1;
      treeWidth := 0;
      treeLeafCount := 0;
      firstDeleted := -1;
      firstNodeOffset := sizeof(TbTreeHeader);
    end; {with}
  if (inode = NIL) then exit;
  root := allocEmptyNode;
  if (root = NIL) then exit;

  with root^ do
    begin
      used := 1;
      parent.bPtr := NIL;
      leaf := true;
      childCount[1] := 1;
      move(inode^.name, keys[0], B_MAX_NAME_LENGTH);
      head[1].iPtr := inode;
      present[1] := TRUE;
    end; {with}

  with inode^ do
    begin
      next.iPtr := NIL;
      prev.iPtr := NIL;
    end;

end; {bTree.init}

function bTree.allocEmptyNode;
var newNode:PbNode;
begin
  new(newNode);
  if (newNode = NIL) then halt;
  fillchar(newNode^, sizeof(TbNode), 0);
  inc(tag);
  with newNode^ do
    begin
      magic1 := B_NODE_MAGIC_1;
      magic2 := B_NODE_MAGIC_2;
      parent.bPtr := NIL;
      tag := self.tag;
    end; {with}
  result := newNode;
end; {bTree.allocEmptyNode}

function bTree.getFirstNode;
var
  tmpNode:PbNode;
  i:integer;
begin
  tmpnode := node;
  result := NIL;
  if (tmpNode = NIL) then exit;

  while not(tmpNode^.leaf) do
    begin
      for i := 0 to tmpNode^.used-1 do
        begin
          if (tmpnode^.head[i].bPtr <> NIL) then
            begin
              tmpNode := tmpNode^.head[i].bPtr;
              break;
            end; {if}
        end; {for i}
    end; {while}

  for i := 0 to tmpNode^.used do
    begin
      if (tmpNode^.head[i].iPtr <> NIL) then
        begin
          result := tmpNode^.head[i].iPtr;
          exit;
        end; {if}
    end; {for i}
end; {bTree.getFirstNode}

function bTree.inodeSearch;
var i:integer;
begin
  result := NIL;
  if ((inode = NIL) or (key = NIL)) then exit;

  i := strcomp(inode^.name, key);
  if (i = 0) then
    begin
      result := inode;
      exit
    end;

  if (i < 0) then
    begin
      inode := inode^.next.iPtr;
      if (inode <> NIL) then
        repeat
          i := strcomp(inode^.name, key);
          inode := inode^.next.iPtr;
        until ((inode = NIL) or (i >= 0));
    end
  else
    begin
      inode := inode^.prev.iPtr;
      if (inode <> NIL) then
        repeat
          i := strcomp(inode^.name, key);
          inode := inode^.prev.iPtr;
        until ((inode = NIL) or (i <= 0));
    end;
  if (i = 0) then result := inode;
end; {bTree.inodeSearch}

procedure bTree.insertNode;
var
  curSlot : integer;
  shift   : integer;
begin
  if ((node = NIL) or (key = NIL)) then exit;

  with node^ do
    if (strcomp(key, keys[used-1]) >= 0) then
      begin
        curSlot := used;
        fillchar(keys[curSlot], B_MAX_NAME_LENGTH, 0);
        move(key, keys[curSlot], B_MAX_NAME_LENGTH);
        head[curSlot+1].bPtr := headPtr;
        present[curSlot+1] := TRUE;
        childCount[used] := 0;
      end
    else
      begin
        for curSlot := 0 to used-1 do
          if (strcomp(key, keys[curSlot]) < 0) then break;

        (*
         * note that there is one more item for everything but keys
         * So, make the shift count +1 and just subtract it from the key shift
         * later
         *)

        shift := used - curSlot + 1;

        move(head[curSlot], head[curSlot+1], sizeof(head[0]) * shift);

        move(present[curSlot], present[curSlot+1], sizeof(present[0]) * shift);

        move(childCount[curSlot], childCount[curSlot+1], sizeof(childCount[0]) * shift);

        move(keys[curSlot], keys[curSlot+1], sizeof(keys[0]) * (shift-1));

        fillchar(keys[curSlot], B_MAX_NAME_LENGTH, 0);
        move(key, keys[curSlot], B_MAX_NAME_LENGTH);
        head[curSlot+1].bPtr := headPtr;
        present[curSlot+1] := TRUE;
      end;

  inc(node^.used);
  if (node^.used = B_MAX_KEYS) then splitNode(node);
end; {bTree.insertNode}

procedure bTree.splitNode;
var
  tmpInode : PubixfsInode;
  newNode  : PbNode;
  shift    : integer;
  splitLoc : integer;
  i        : integer;
begin
  tmpInode := NIL;
  if (oldNode = NIL) then halt;
  if (oldNode^.used <> B_MAX_KEYS) then exit;

  newNode := allocEmptyNode;
  if (newNode = NIL) then halt;

  shift := B_MAX_KEYS shr 1;
  splitLoc := B_MAX_KEYS - shift;
  inc(shift);

  newNode^.used := B_MAX_KEYS shr 1;
  oldNode^.used := B_MAX_KEYS shr 1;

  newNode^.parent.bPtr := oldNode^.parent.bPtr;
  newNode^.leaf := oldNode^.leaf;

  move(oldNode^.keys[splitLoc],
       newNode^.keys[0],
       sizeof(newNode^.keys[0]) * (shift-1));

  fillchar(oldNode^.keys[splitLoc], sizeof(newNode^.keys[0]) * (shift-1), 0);

  move(oldNode^.present[splitLoc],
       newNode^.present[0],
       sizeof(newNode^.present[0]) * shift);

  fillchar(oldNode^.present[splitLoc], sizeof(oldNode^.present[0]) * shift, 0);

  move(oldNode^.head[splitLoc], newNode^.head[0], sizeof(newNode^.head[0]) * shift);

  fillchar(oldNode^.head[splitLoc], sizeof(newNode^.head[0]) * shift, 0);

  move(oldNode^.childCount[splitLoc],
       newNode^.childCount[0],
       sizeof(newNode^.childCount[0]) * shift);

  fillchar(oldNode^.childCount[splitLoc], sizeof(oldNode^.childCount[0]) * shift, 0);

  if (not newNode^.leaf) then
    for i := 0 to newNode^.used do
      newNode^.head[i].bPtr^.parent.bPtr := newNode;

  tmpInode := GetFirstNode(newNode);
  if (tmpInode = NIL) then halt;

  if (oldNode = root) then
    begin
      inc(header^.treeDepth);
      root := allocEmptyNode;
      oldNode^.parent.bPtr := root;
      newNode^.parent.bPtr := root;

      with root^ do
        begin
          move(tmpInode^.name, keys[0], B_MAX_NAME_LENGTH);

          head[0].bPtr := oldNode;
          head[1].bPtr := newNode;
          used := 1;
          leaf := FALSE;
          present[0] := TRUE;
          present[1] := TRUE;
          childCount[0] := 0;
          childCount[1] := 0;
        end
    end
  else
    begin
      insertNode(newNode^.parent.bPtr, tmpInode^.name, newNode);
    end; {else}
end; {bTree.splitNode}

function bTree.treeSearch;
var i:integer;
begin
{  writeln('treeSearch(', hex(longint(bnode)), ', "', key, '");');}
  result := NIL;
  if ((bnode = NIL) or (key = NIL) or (bnode^.used = 0)) then exit;

  if (bnode^.leaf) then
    begin
      result := inodeSearch(GetFirstNode(bnode), key);
      exit;
    end;

  if (strcomp(key, bnode^.keys[0]) < 0) then
    begin
      result := treeSearch(bnode^.head[0].bPtr, key);
      exit;
    end;

  if (strcomp(key, bnode^.keys[bnode^.used-1]) >= 0) then
    begin
      result := treeSearch(bnode^.head[bnode^.used].bPtr, key);
      exit;
    end;

  for i := 1 to bnode^.used-1 do
    begin
      if (strcomp(key, bnode^.keys[i]) < 0) then
        begin
          result := treeSearch(bnode^.head[i].bPtr, key);
          exit;
        end; {if}
    end; {for i}
end;

function bTree.Find;
begin
  result := treeSearch(root, key);
end; {bTree.Find}

procedure bTree.Info;
var i:integer;
begin
  if ((node = NIL) or (root = NIL)) then exit;

  writeln(hex(longint(node)), ' | ', hex(longint(node^.parent.bPtr)));

  for i := 0 to node^.used do
    begin
      if (node^.head[i].iPtr <> NIL) then
        write('[', node^.head[i].iPtr^.name, ']');
      if (i <> node^.used) then
        write(' {', node^.keys[i], '} ');
    end; {for i}
  writeln;
end; {bTree.Info}

function bTree.Insert;
var
  bNode:PbNode;
  tmpInode, iptr:PubixfsInode;
  curSlot, i, shift:integer;
begin
  result := FALSE;
  bNode := root;
  tmpInode := NIL;
  curSlot := 0;

  if (inode = NIL) then exit;

  if (root = NIL) then
    begin
      if (header = NIL) then
        begin
          new(header);
          if (header = NIL) then halt;
          fillchar(header^, sizeof(TbTreeHeader), 0);
          with header^ do
            begin
              treeDepth := 1;
              treeWidth := 0;
              treeLeafCount := 0;
              firstDeleted := -1;
              firstNodeOffset := sizeof(TbTreeHeader);
            end; {with}
        end; {if header = NIL}

      root := allocEmptyNode;
      if (root = NIL) then halt;

      with root^ do
        begin
          used := 1;
          parent.bPtr := NIL;
          leaf := true;
          childCount[1] := 1;
          move(inode^.name, keys[0], B_MAX_NAME_LENGTH);
          head[1].iPtr := inode;
          present[1] := TRUE;
        end; {with}

      with inode^ do
        begin
          next.iPtr := NIL;
          prev.iPtr := NIL;
        end; {with}
      result := TRUE;
      exit;
    end; {if root = NIL}

  tmpInode := Find(inode^.name);
  if (tmpInode <> NIL) then exit;
  inc(header^.treeLeafCount);
  if (bnode^.used = 0) then halt;
writeln('---Inserting ', inode^.name, ' @ ', hex(longint(inode)));

  while ((bNode <> NIL) and not bnode^.leaf) do
    begin
      if (strcomp(inode^.name, bnode^.keys[0]) < 0) then
        bnode := bnode^.head[0].bPtr
      else
        begin
          if (strcomp(inode^.name, bnode^.keys[bnode^.used-1]) >= 0) then
            bnode := bnode^.head[bnode^.used].bPtr
          else
            for i := 1 to bnode^.used-1 do
              if (strcomp(inode^.name, bnode^.keys[i]) < 0) then
                begin
                  bnode := bnode^.head[i].bPtr;
                  break
                end {if}
        end {else}
    end; {while}

  if not(bnode^.leaf) then writeln('WARNING: NOT IN LEAF NODE');

  curSlot := 0;

  if (strcomp(inode^.name, bnode^.keys[0]) < 0) then
    tmpInode := bnode^.head[0].iPtr
  else
    begin
      curSlot := bnode^.used;
      if (strcomp(inode^.name, bnode^.keys[curSlot-1]) >= 0) then
        tmpInode := bnode^.head[curSlot].iPtr
      else
        begin
          for curSlot := 1 to bnode^.used-1 do
            if (strcomp(inode^.name, bnode^.keys[curSlot]) < 0) then
              begin
                tmpInode := bnode^.head[curSlot].iPtr;
                break;
              end; {if}
          tmpInode := bnode^.head[curSlot].iPtr;
        end; {else}
    end; {else}

  if (tmpInode = NIL) then
    begin
      (*
       * This is the first node in this leaf
       *)
      bnode^.head[curSlot].iPtr := inode;
      bnode^.present[curSlot] := TRUE;

      if (curSlot = 0) then
        begin

          if (bnode^.head[1].iPtr <> NIL) then
            begin
              iptr := bnode^.head[1].iPtr;
              inode^.prev.iPtr := iptr^.prev.iPtr;
              inode^.next.iPtr := iptr;
              iptr^.prev.iPtr := inode;

              if (inode^.prev.iPtr <> NIL) then
                inode^.prev.iPtr^.next.iPtr := inode;
            end
          else
            begin
              inode^.next.iPtr := NIL;
              inode^.prev.iPtr := NIL;
            end;
        end
      else
        inc(bnode^.used);

      result := TRUE;
      exit;
    end;

  writeln('---- before split ----');
  Info(bnode);

  with bnode^ do
    if (curSlot <> used) then
      begin
        shift := used - curSlot +1;

        move(head[curSlot], head[curSlot+1], sizeof(head[0]) * shift);

        move(present[curSlot], present[curSlot+1], sizeof(present[0]) * shift);

        move(childCount[curSlot], childCount[curSlot+1], sizeof(childCount[0]) * shift);

        move(keys[curSlot], keys[curSlot+1], sizeof(keys[0]) * (shift-1));
        fillchar(keys[curSlot], B_MAX_NAME_LENGTH, 0);
      end
    else
      begin
        head[curSlot+1] := head[curSlot];
        childCount[curSlot+1] := childCount[curSlot];
        present[curSlot+1] := present[curSlot];
      end;

  with bnode^ do
    if (curSlot = 0) then
      begin
        move(head[1].iPtr^.name, keys[curSlot], B_MAX_NAME_LENGTH);
        head[curSlot].iPtr := inode;
      end
    else
      begin
        move(inode^.name, keys[curSlot], B_MAX_NAME_LENGTH);
        head[curSlot+1].iPtr := inode;
      end;
  bnode^.present[curSlot] := TRUE;
  inc(bnode^.used);
  if (bnode^.used = B_MAX_KEYS) then splitNode(bnode);
  writeln('--- after split ---');
  Info(bnode);
  result := TRUE;
end; {bTree.Insert}

procedure bTree.Print;
var i:integer;
begin
  if (node = NIL) then exit;
  Info(node);
  if (not node^.leaf) then
    for i := 0 to node^.used do
      Print(node^.head[i].bPtr);
end; {bTree.Print}

procedure bTree.PrintWholeTree;
begin
  Print(root);
end; {bTree.PrintWholeTree}

destructor bTree.done;
begin
end;
{$endif}
end.