-- BTree2.mesa	Last edit: Andrew Birrell	15-Jan-82 11:37:15

DIRECTORY
BTree2Defs : FROM "BTree2Defs"
USING[Entry, EntryR, Index, VArray];

-- A Varray consists of:
-- 1) the number of items (n) stored in the array.
-- 2) a mumble, described below. 
-- 3) n packed descriptors for the items, each consisting of a pointer to the starting place and a length for the key.
-- 4) some empty space perhaps
-- 5) the items themselves, stored backward from the end of array

-- The length of the value part of the item can be deduced from the start of the preceeding item. The mumble is a start for a phony item so it all works without special end tests.

-- The Copy routines make the code smaller by 10%
-- The use of Entry makes the code smaller by 10%

-- A Copy is A[i] _B[i] + x for all i

-- A Slip moves entries startIndex and beyond from this array to newIndex and newData in array other, copying both index and data.

-- A Move appends entries startIndex and beyond from this array to the other array. move updates the entry count, slip doesn't.


BTree2: PROGRAM
EXPORTS BTree2Defs=
PUBLIC
BEGIN

NN: TYPE = CARDINAL;
Desc: TYPE = DESCRIPTOR FOR ARRAY OF WORD;
RealJob: TYPE = {insert, replace, delete};
w, FixedOverhead: CARDINAL= 2;
OverheadPerItem: CARDINAL= 1;
nullER: BTree2Defs.EntryR _ [DESCRIPTOR[NIL, 0], DESCRIPTOR[NIL, 0]];

debug: BOOLEAN _ TRUE;

maxKeyLength: CARDINAL = 63;

Form: TYPE = MACHINE DEPENDENT RECORD[k: [0..1024), v: [0..maxKeyLength]];
Foo: TYPE = POINTER TO ARRAY [0..3) OF Form;

IndexOutOfBounds: SIGNAL = CODE;
GetAnother: SIGNAL RETURNS [BTree2Defs.VArray] = CODE;
Merger: SIGNAL RETURNS [BTree2Defs.VArray, BOOLEAN] = CODE;
DeletePage: SIGNAL = CODE;

Initialize: PROCEDURE[v: BTree2Defs.VArray] =
BEGIN i: CARDINAL;
FOR i IN [0..LENGTH[v^])
DO v[i] _ 0; ENDLOOP;
v[1] _LOOPHOLE[Form[LENGTH[v^], 0]];
END;

Items: PROCEDURE[v: BTree2Defs.VArray] RETURNS[NN] =
BEGIN RETURN[v[0]]; END;

Lookup: PROCEDURE[this: BTree2Defs.VArray, item: BTree2Defs.Index] RETURNS [BTree2Defs.EntryR] =
BEGIN
foo: Foo;
startK, endK, startV, lengthK: NN;
[foo, , , startK, endK] _Unpack[this, item];
IF item >= this[0] THEN SIGNAL IndexOutOfBounds;
startV _ startK + (lengthK _ foo[item].v);
RETURN[[DESCRIPTOR[@this[startK], lengthK],
DESCRIPTOR[@this[startV], endK - startV]]];
END;

Insert: PROCEDURE[this: BTree2Defs.VArray, item: BTree2Defs.Index, e: BTree2Defs.Entry] =
BEGIN
IF ((LENGTH[e.k] > maxKeyLength)
    OR (LENGTH[e.k] + LENGTH[e.v] >80)) THEN ERROR;
ReplaceX[this, item, e, insert];
END;

Delete: PROCEDURE[this: BTree2Defs.VArray, item: BTree2Defs.Index] =
BEGIN ReplaceX[this, item, @nullER, delete]; END;

Replace: PROCEDURE[this: BTree2Defs.VArray, item: BTree2Defs.Index, e: BTree2Defs.Entry] =
BEGIN ReplaceX[this, item, e, replace]; END;

ReplaceX: PROCEDURE[this: BTree2Defs.VArray, item: BTree2Defs.Index, e: BTree2Defs.Entry, r: RealJob] =
BEGIN
diddle: INTEGER = SELECT r FROM replace => 0, insert => 1, ENDCASE => - 1;
foo: Foo;
other: BTree2Defs.VArray;
shrinkage: INTEGER;
nextIndex, startLast, startItem, page, halfPage, sizeKey, sizeVal: NN;
sizeNew, sizeOld, start, used, endItem, i: NN;
[foo, nextIndex, startLast, startItem, endItem] _Unpack[this, item];
page _ (foo - 1)[0].k;
halfPage _ page/2;
sizeNew _ (sizeKey _ LENGTH[e.k]) + (sizeVal _ LENGTH[e.v]);
sizeOld _ IF r = insert THEN 0 ELSE endItem - startItem;
shrinkage _ sizeOld - sizeNew;
start _ startItem + shrinkage;
used _ (page - startLast) - shrinkage + (nextIndex - 1) + OverheadPerItem + w;
IF debug THEN Check[this];
IF nextIndex < item + 1 THEN ERROR IndexOutOfBounds;
IF used + 4 > page
THEN
BEGIN
withoutItem: NN _ halfPage + w;
withItem: NN _ halfPage + w - shrinkage + diddle; 
other _ SIGNAL GetAnother;
FOR i IN [0..nextIndex)
DO -- test is split result to be at >= halfPage.
IF foo[i].k < ((IF i >= item THEN withItem ELSE withoutItem) + (i + 1)*OverheadPerItem)
THEN
BEGIN -- and it better be <= Page.
IF foo[i].k <= ((IF i >= item THEN withItem - halfPage ELSE w) + (i + 1)*OverheadPerItem)
THEN
BEGIN
IF i = 0 THEN ERROR;
i _ i - 1;
END;
Move[this, i + 1, other];
IF i >= item
THEN ReplaceX[this, item, e, r ! Merger, GetAnother => ERROR]
ELSE ReplaceX[other, item - i - 1, e, r ! Merger, GetAnother => ERROR];
RETURN;
END;
ENDLOOP;
ERROR; -- oops
END;
IF shrinkage # 0 THEN Slip[this, this, item + 1, item + 1 + diddle, startLast + shrinkage];
IF r # delete
THEN
BEGIN
foo[item + diddle] _ [start, sizeKey];
Copy[@e.k[0], @this[start], sizeKey, 0];
Copy[@e.v[0], @this[start + sizeKey], sizeVal, 0];
END;
this[0] _ nextIndex + diddle;
IF ((used < halfPage) AND (shrinkage > 0)) THEN Balance[this, used];
IF debug THEN Check[this];
END;


Balance: PROCEDURE[this: BTree2Defs.VArray, used: NN] =
BEGIN
oFoo: Foo;
other: BTree2Defs.VArray;
onRight: BOOLEAN;
page, halfPage, nextIndex, thisEnd: NN;
l, here, nextOther, otherEnd, i, carry: NN;
page _ LOOPHOLE[this[1], Form].k;
halfPage _ page/2;
[other, onRight] _SIGNAL Merger;
IF other = NIL THEN RETURN;
[ , nextIndex, thisEnd, , ] _Unpack[this, 0];
[oFoo, nextOther, otherEnd, , ] _Unpack[other, 0];
IF used + nextOther < otherEnd
THEN
BEGIN
IF onRight THEN Move[other, 0, this] ELSE Move[this, 0, other];
SIGNAL DeletePage;
RETURN;
END;
carry _ halfPage + w + (IF onRight THEN used ELSE 0);
-- magic to leave the page on the left just over half full
i _ 0;
UNTIL carry + i >(here _ oFoo[i - 1].k)
DO
IF i >= nextOther THEN EXIT;
i _ i + 1;
ENDLOOP;
IF carry + i <= here THEN ERROR;
IF onRight
THEN
BEGIN
other[0] _ i;
Move[other, 0, this];
other[0] _ nextOther;
Slip[other, other, i, 0, otherEnd + page - here];
other[0] _ nextOther - i;
END
ELSE
BEGIN
l _ nextOther - i;
Slip[this, this, 0, l, otherEnd + thisEnd - here];
this[0] _ 0;
Move[other, i, this];
this[0] _ l + nextIndex;
END;
END;

--I think this returns the array of pntrs to items, the count of items, and the offsets: of start of first item on the page, of end of requested item, of start of requested item.
Unpack: PROCEDURE[v: BTree2Defs.VArray, item: BTree2Defs.Index] RETURNS[Foo, BTree2Defs.Index, NN, NN, NN] =
BEGIN
next: NN = v[0];
foo: Foo = LOOPHOLE[@v[w]];
RETURN[foo, next, foo[next - 1].k, foo[item].k, foo[item - 1].k];
END;

Move: PROCEDURE[from: BTree2Defs.VArray, at: BTree2Defs.Index, to: BTree2Defs.VArray] =
BEGIN
toNext, fromNext, fromEnd, atEnd, toEnd: NN;
[ , fromNext, fromEnd, , atEnd] _Unpack[from, at];
[ , toNext, toEnd, , ] _Unpack[to, 0];
Slip[from, to, at, toNext, toEnd - atEnd + fromEnd];
to[0] _ toNext + fromNext - at;
from[0] _at;
END;

Slip: PROCEDURE[this, other: BTree2Defs.VArray, startIndex, newIndex, newData: BTree2Defs.Index] =
BEGIN
foo, toFoo: Foo;
endIndex, endData, startData, q: NN;
[foo, endIndex, endData, , startData] _Unpack[this, startIndex];
toFoo _ LOOPHOLE[@other[w]];
q _ LOOPHOLE[Form[newData - endData, 0]];
Copy[@foo[startIndex], @toFoo[newIndex], endIndex - startIndex, q];
Copy[@this[endData], @other[newData], startData - endData, 0];
END;

Copy: PROCEDURE[from, to: POINTER, len, a: NN] =
BEGIN
i: NN;
IF len > 256 THEN ERROR;
IF LOOPHOLE[to, CARDINAL]  > LOOPHOLE[from, CARDINAL]
THEN
FOR i DECREASING IN [0..len)
DO (to + i)^ _ (from + i)^ + a; ENDLOOP
ELSE
FOR i IN [0..len)
DO (to + i)^ _ (from + i)^ + a; ENDLOOP;
END;

Check: PROCEDURE [v: BTree2Defs.VArray] =
BEGIN
foo: Foo = LOOPHOLE[@v[w]];
i: NN;
IF v[0] >= LENGTH[v^] THEN ERROR;
IF (foo - 1)[0].k # LENGTH[v^] THEN ERROR;
FOR i IN [0..v[0])
DO
IF ((foo[i].k >= foo[i - 1].k) OR (foo[i].v > foo[i - 1].k - foo[i].k)) THEN ERROR;
ENDLOOP;
END;

END.

Edit Log

RTE: March 28, 1980  2:47 PM: KK: changed format of program so I could read it.
RTE: April 28, 1980  12:18 PM: KK: bug in replacex, could cause page to overflow after split.
RTE: September 9, 1980  3:44 PM: KK: Nori found loop index in Balance that was depended upon but could be undefined.
RTE: 15-Jan-82 11:36:59: Andrew Birrell: allowed keys up to 63 words long.