-- Copyright (C) 1982, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- BTree2.mesa, HGM, 17-Sep-85  5:09:30
-- Andrew Birrell	15-Jan-82 11:37:15

DIRECTORY
  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;
  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 = LONG 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-1)[i].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];
    -- Barfo. In the good old MDS days, this used to work because things wrapped around.
    -- Initialization calls this with item = 177777B
    itemPlus1: BTree2Defs.Index ¬ item+1;
    RETURN[foo, next, (foo-1)[next].k, (foo-1)[itemPlus1].k, (foo-2)[itemPlus1].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: LONG POINTER, len, a: NN] =
    BEGIN
    i: NN;
    IF len > 256 THEN ERROR;
    IF LOOPHOLE[to, LONG CARDINAL] > LOOPHOLE[from, LONG 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-1)[i].k) OR (foo[i].v > (foo-1)[i].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.