-- BTree.mesa
-- Edited by Levin:   29-Jan-82 15:34:58

DIRECTORY
  BTreeDefs USING [Call, Desc, KeyNotFound, TestKeys],
  BTree2Defs USING [
    Delete, DeletePage, EntryR, GetAnother, Index, Initialize, Insert,
    Items, Lookup, Merger, Replace, VArray],
  BTreeSupportDefs USING [
    AllocateWords, FileHandle, FreeWords, PageHandle, PageSize, ReadPage,
    ReleasePage, UsePage, WritePage];

BTree: PROGRAM
  IMPORTS BTree2Defs, BTreeSupportDefs
  EXPORTS BTreeDefs =

  BEGIN

  TwoKeysNonLeafSplit: SIGNAL RETURNS [Page] = CODE;
  EntryTooSmall: SIGNAL = CODE;
  Malformed: SIGNAL = CODE;

  Alarm: PROCEDURE = BEGIN AlarmCalled END;
  AlarmCalled: SIGNAL = CODE;

  Version: NN _ 1;  -- for bug checking.
  Juniper: BOOLEAN = FALSE;

  CallTree: TYPE = PROCEDURE [p: Page, i: BTree2Defs.Index]
    RETURNS [more: BOOLEAN];

  NN: TYPE = CARDINAL;

  Page: TYPE = LONG POINTER TO BTreePageRecord;
  BTreePageRecord: TYPE = RECORD [
    b: BTreeHandle,
    pa: NN,
    ca: BTree2Defs.VArray,
    c: BTreeDefs.Desc,
    level: NN,
    dirty, deleted, rekey: BOOLEAN];  -- pa is the number of this page in the file (starts at 1).

  BTreeHandle: PUBLIC TYPE = LONG POINTER TO BTreeRecord;
  BTreeRecord: TYPE = RECORD [
    version, rootPA, freePA, lastPA, pageS, depth, entries: NN,
    file: BTreeSupportDefs.FileHandle,
    self: BTreePageRecord,
    IsFirstGreaterOrEqual, AreTheyEqual: BTreeDefs.TestKeys,
    dirtyTree, sawUserUnwind: BOOLEAN];

  OldBTreePageRecord: TYPE = RECORD [
    b: BTreeHandle,
    pa: NN,
    ca: BTree2Defs.VArray,
    c: BTreeDefs.Desc,
    level: NN,
    nul1: Page,
    nul2: NN,
    dirty, deleted, rekey: BOOLEAN];
  OldBTreeRecord: TYPE = RECORD [
    version, nlu1, nlu2, nlu3, rootPA, freePA, lastPA, pageS, depth, entries: NN,
    file: BTreeSupportDefs.FileHandle,
    oldSelf: OldBTreePageRecord,
    IsFirstGreaterOrEqual, AreTheyEqual: BTreeDefs.TestKeys,
    nlu4, dirtyTree: BOOLEAN,
    nlu5: CARDINAL];


  nullPA: NN = 177777B;

  CheckAmount: TYPE = {little, moderate, lots, dontAsk};
  checking: CheckAmount _ little;

  -- there should be a check about pagesize vs. max. item size;
  PageSize: CARDINAL = BTreeSupportDefs.PageSize[];

  CreateAndInitializeBTree: PUBLIC PROCEDURE [
    fileH: BTreeSupportDefs.FileHandle, initializeFile: BOOLEAN,
    isFirstGreaterOrEqual, areTheyEqual: BTreeDefs.TestKeys _ NIL]
    RETURNS [bh: BTreeHandle] =
    BEGIN
    ENABLE
      UNWIND => IF bh # NIL THEN BTreeSupportDefs.FreeWords[bh];
    bh _ BTreeSupportDefs.AllocateWords[SIZE[BTreeRecord]];
    IF initializeFile THEN
      BEGIN
      bh^ _ [
        version: Version, rootPA: nullPA, freePA: 0, lastPA: 1, pageS: PageSize,
        depth: 177777B, entries: 0, file: fileH,
        self: BTreePageRecord[
        b: bh, pa: 1, ca:, c:, level: 1, dirty: TRUE, deleted: FALSE,
        rekey: FALSE], IsFirstGreaterOrEqual:, AreTheyEqual:, dirtyTree: TRUE,
        sawUserUnwind: FALSE];
      PushBTreeToDisk[bh];  -- just to keep WritePage happy about order of writes.
      BuildARoot[bh, NIL];
      END
    ELSE
      BEGIN
      oldB: LONG POINTER TO OldBTreeRecord _ LOOPHOLE[BTreeSupportDefs.ReadPage[
        fileH, 1 - 1]];
      IF oldB.version # Version THEN Malformed;
      IF oldB.pageS # PageSize THEN Malformed;
      bh^ _ [
        version: oldB.version, rootPA: oldB.rootPA, freePA: oldB.freePA,
        lastPA: oldB.lastPA, pageS: PageSize, depth: oldB.depth,
        entries: oldB.entries, file: fileH,
        self: [
        b: bh, pa: oldB.oldSelf.pa, ca: oldB.oldSelf.ca, c: oldB.oldSelf.c,
        level: oldB.oldSelf.level, dirty: FALSE, deleted: FALSE, rekey: FALSE],
        IsFirstGreaterOrEqual:, AreTheyEqual:, dirtyTree: FALSE,
        sawUserUnwind: FALSE];
      BTreeSupportDefs.ReleasePage[LOOPHOLE[oldB, BTreeSupportDefs.PageHandle]];
      END;
    bh.IsFirstGreaterOrEqual _
      (IF isFirstGreaterOrEqual = NIL THEN MyIsFirstGreaterOrEqual
       ELSE isFirstGreaterOrEqual);
    bh.AreTheyEqual _
      (IF areTheyEqual = NIL THEN MyAreTheyEqual ELSE areTheyEqual);
    IF bh.version # Version THEN Alarm[];
    END;

  ReleaseBTree: PUBLIC PROCEDURE [bh: BTreeHandle]
    RETURNS [fileH: BTreeSupportDefs.FileHandle] =
    BEGIN
    IF bh.version # Version THEN Alarm[];
    PushBTreeToDisk[bh ! UNWIND => BTreeSupportDefs.FreeWords[bh]];
    fileH _ bh.file;
    BTreeSupportDefs.FreeWords[bh];
    END;

  ShutDownBTree: PUBLIC PROCEDURE [bh: BTreeHandle]
    RETURNS [fileH: BTreeSupportDefs.FileHandle] =
    BEGIN
    IF bh.version # Version THEN Alarm[];
    fileH _ bh.file;
    BTreeSupportDefs.FreeWords[bh];
    END;

  PushBTreeToDisk: PUBLIC PROCEDURE [bh: BTreeHandle] =
    BEGIN
    IF bh.version # Version THEN Alarm[];
    IF bh.dirtyTree THEN
      BEGIN
      oldB: LONG POINTER TO OldBTreeRecord _ LOOPHOLE[BTreeSupportDefs.UsePage[
        bh.file, 0]];
      oldB^ _ [
        version: bh.version, nlu1:, nlu2:, nlu3:, rootPA: bh.rootPA,
        freePA: bh.freePA, lastPA: bh.lastPA, pageS: bh.pageS, depth: bh.depth,
        entries: bh.entries, file:,
        oldSelf: [
        b:, pa: bh.self.pa, ca: bh.self.ca, c: bh.self.c, level: bh.self.level, nul1:,
        nul2:, dirty:, deleted:, rekey:], IsFirstGreaterOrEqual:, AreTheyEqual:,
        nlu4:, dirtyTree:, nlu5:];
      BTreeSupportDefs.WritePage[
        bh.file, 0, LOOPHOLE[oldB, BTreeSupportDefs.PageHandle] !
        UNWIND =>
          BEGIN
          BTreeSupportDefs.ReleasePage[
            LOOPHOLE[oldB, BTreeSupportDefs.PageHandle]];
          END];
      bh.dirtyTree _ FALSE;
      END;
    IF bh.version # Version THEN Alarm[];
    END;

  PruneBTree: PUBLIC PROCEDURE [bh: BTreeHandle]
    RETURNS [storageFreed: BOOLEAN] =
    BEGIN
    RETURN[FALSE];
    END;

  AskNumberOfEntriesInTree: PUBLIC PROCEDURE [bh: BTreeHandle]
    RETURNS [nEntries: CARDINAL] =
    BEGIN
    IF bh.version # Version THEN Alarm[];
    IF ((bh.entries = 0) OR (checking >= lots)) THEN CheckTree[bh];
    RETURN[bh.entries];
    END;

  AskDepthOfTree: PUBLIC PROCEDURE [bh: BTreeHandle]
    RETURNS [nLevels: CARDINAL] =
    BEGIN
    IF bh.version # Version THEN Alarm[];
    RETURN[bh.depth];
    END;

  Insert: PUBLIC PROCEDURE [
    bh: BTreeHandle, key: BTreeDefs.Desc, value: BTreeDefs.Desc] =
    BEGIN
    eR: BTree2Defs.EntryR _ [key, value];
    InsertC: CallTree =
      BEGIN
      IF bh.AreTheyEqual[key, LookupP[p, i].k] THEN ReplaceP[p, i, eR]
      ELSE BEGIN InsertP[p, i, eR]; bh.entries _ bh.entries + 1; END;
      bh.dirtyTree _ TRUE;
      RETURN[more: FALSE];
      END;
    IF bh.version # Version THEN Alarm[];
    IF LENGTH[key] = 0 THEN ERROR;
    StartEnumerate[bh, key, InsertC];
    IF bh.version # Version THEN Alarm[];
    END;

  Lookup: PUBLIC PROCEDURE [bh: BTreeHandle, key, value: BTreeDefs.Desc]
    RETURNS [lengthValue: CARDINAL] =
    BEGIN
    bcheck: BTreeHandle = bh;
    LookupC: CallTree =
      BEGIN
      eR: BTree2Defs.EntryR _ LookupP[p, i];
      lengthValue _ LENGTH[eR.v];
      IF bh.AreTheyEqual[key, eR.k] THEN Copy[from: eR.v, to: value]
      ELSE lengthValue _ BTreeDefs.KeyNotFound;
      RETURN[more: FALSE];
      END;
    IF bcheck.version # Version THEN Alarm[];
    StartEnumerate[bh, key, LookupC];
    IF bcheck.version # Version THEN Alarm[];
    END;

  Next: PROCEDURE [bh: BTreeHandle, e: BTree2Defs.EntryR] =
    BEGIN
    seen: CARDINAL _ 0;
    LookupC: CallTree =
      BEGIN
      eR: BTree2Defs.EntryR;
      IF (seen _ seen + 1) = 1 THEN RETURN[more: TRUE];
      eR _ LookupP[p, i];
      IF ((LENGTH[eR.v] > LENGTH[e.v]) OR (LENGTH[eR.k] > LENGTH[e.k])) THEN
        SIGNAL EntryTooSmall;
      Copy[from: eR.v, to: e.v];
      Copy[from: eR.k, to: e.k];
      e.k _ DESCRIPTOR[BASE[e.k], LENGTH[eR.k]];
      e.v _ DESCRIPTOR[BASE[e.v], LENGTH[eR.v]];
      RETURN[more: FALSE];
      END;
    IF bh.version # Version THEN Alarm[];
    StartEnumerate[bh, e.k, LookupC];
    IF bh.version # Version THEN Alarm[];
    END;

  Delete: PUBLIC PROCEDURE [bh: BTreeHandle, key: BTreeDefs.Desc] =
    BEGIN
    DeleteC: CallTree =
      BEGIN
      IF bh.AreTheyEqual[key, LookupP[p, i].k] THEN
        BEGIN
        DeleteP[p, i];
        IF i = 0 THEN p.rekey _ TRUE;
        bh.entries _ bh.entries - 1;
        bh.dirtyTree _ TRUE;
        END;
      RETURN[more: FALSE];
      END;
    IF bh.version # Version THEN Alarm[];
    IF LENGTH[key] # 0 THEN StartEnumerate[bh, key, DeleteC];
    IF bh.version # Version THEN Alarm[];
    END;

  EnumerateFrom: PUBLIC PROCEDURE [
    bh: BTreeHandle, key: BTreeDefs.Desc, c: BTreeDefs.Call] =
    BEGIN
    seen: CARDINAL _ 0;
    EnumC: CallTree =
      BEGIN
      eR: BTree2Defs.EntryR _ LookupP[p, i];
      dirty: BOOLEAN;
      seen _ seen + 1;
      IF ((seen = 1) AND (~bh.AreTheyEqual[key, eR.k])) THEN RETURN[more: TRUE];
      [more, dirty] _ c[
        eR.k, eR.v ! UNWIND => IF (NOT Juniper) THEN bh.sawUserUnwind _ TRUE];
      IF dirty THEN
        BEGIN
        p.dirty _ TRUE;
        IF i = 0 THEN p.rekey _ TRUE;
        bh.dirtyTree _ TRUE;
        END;
      RETURN[more];
      END;
    IF bh.version # Version THEN Alarm[];
    StartEnumerate[bh, key, EnumC];
    IF bh.version # Version THEN Alarm[];
    END;

  StartEnumerate: PROCEDURE [
    bh: BTreeHandle, key: BTreeDefs.Desc, c: CallTree] =
    BEGIN
    ENABLE
      UNWIND =>
        IF bh.sawUserUnwind THEN bh.sawUserUnwind _ FALSE;
    this: Page _ SwapInPage[bh, bh.rootPA, bh.depth];
    brother: Page _ NIL;
    checkT: BOOLEAN = ((checking >= dontAsk) AND (LENGTH[key] > 0));
    GetPageForSplit: PROCEDURE RETURNS [Page] =
      BEGIN RETURN[brother _ SwapInPage[bh, nullPA, this.level]]; END;
    IF checkT THEN CheckTree[bh];
    BEGIN
    ENABLE
      UNWIND =>
        BEGIN
        FreePageDueToUnwind[this];
        IF brother # NIL THEN FreePageDueToUnwind[brother];
        END;
    [] _ EnumerateFromTree[
      this, key, c ! BTree2Defs.GetAnother => RESUME [GetPageForSplit[].ca];
      TwoKeysNonLeafSplit => RESUME [GetPageForSplit[]];
      BTree2Defs.Merger => RESUME [NIL, TRUE]];
    END;
    IF brother # NIL THEN  -- add a new level.
      BEGIN
      brother.dirty _ TRUE;
      BuildARoot[bh, brother ! UNWIND => FreePageDueToUnwind[this]];
      END;
    IF ((ItemsP[this] = 1) AND (bh.depth # 0)) THEN  -- remove a level.
      BEGIN
      bh.rootPA _ LookupPA[this, 0];
      this.deleted _ TRUE;
      bh.depth _ bh.depth - 1;
      bh.dirtyTree _ TRUE;
      END;
    SwapOutPage[this];
    IF bh.version # Version THEN Alarm[];
    IF checkT THEN CheckTree[bh];
    END;

  EnumerateFromTree: PROCEDURE [this: Page, key: BTreeDefs.Desc, c: CallTree]
    RETURNS [go: BOOLEAN] =
    BEGIN
    index: BTree2Defs.Index;
    son, sonssib, right: Page;
    onRight, reallySplit: BOOLEAN;
    end: INTEGER _ ItemsP[this];
    low: NN = IF this.level > 0 THEN this.level - 1 ELSE 0;
    b: BTreeHandle = this.b;
    delta: NN;
    GetPageForMerge: PROCEDURE RETURNS [Page] =
      BEGIN
      onRight _ (end > index + 1);  -- get the page to the right of the son unless the son is already our rightmost descendent.
      delta _ IF onRight THEN 1 ELSE -1;
      IF ((index = 0) AND (NOT onRight)) THEN RETURN[NIL];
      sonssib _ SwapInPage[b, LookupPA[this, index + delta], low];
      (right _ IF onRight THEN sonssib ELSE son).rekey _ TRUE;
      RETURN[sonssib];
      END;
    GetPageForSplit: PROCEDURE RETURNS [Page] =
      BEGIN reallySplit _ TRUE; RETURN[sonssib _ SwapInPage[b, nullPA, low]]; END;
    IF b.version # Version THEN Alarm[];
    FOR index _ FindIndexOnPage[this, key], index + 1 UNTIL index >= end DO
      IF this.level = 0 THEN [go] _ c[this, index]
      ELSE
        BEGIN
        sonssib _ NIL;
        reallySplit _ FALSE;
        delta _ 0;
        son _ SwapInPage[b, LookupPA[this, index], low];
        BEGIN
        ENABLE
          UNWIND =>
            BEGIN
            FreePageDueToUnwind[son];
            IF sonssib # NIL THEN FreePageDueToUnwind[sonssib];
            END;
        [go] _ EnumerateFromTree[
          son, key, c ! BTree2Defs.GetAnother => RESUME [GetPageForSplit[].ca];
          BTree2Defs.Merger =>
            BEGIN
            tempPage: Page _ GetPageForMerge[];
            RESUME [(IF tempPage = NIL THEN NIL ELSE tempPage.ca), onRight];
            END;
          BTree2Defs.DeletePage => BEGIN right.deleted _ TRUE; RESUME ; END;
          TwoKeysNonLeafSplit => RESUME [GetPageForSplit[]]];
        IF sonssib # NIL THEN
          BEGIN
          -- if we have two keys to twitch, we must avoid causing two inter-page actions at the next higher level, as the routine is not expecting more than one.  Therefore the first key twitch can cause a split, and if so the second is not allowed to merge or balance.  Also the first cannot merge or balance as the second may want to split.
          twoKeysToEnter: BOOLEAN _
            ((son.deleted OR son.rekey) AND (sonssib.deleted OR sonssib.rekey));
          split: Page _ NIL;
          sonssib.dirty _ TRUE;
          ChangeKeys[
            this, index + delta, sonssib, (NOT reallySplit) !
            BTree2Defs.GetAnother =>
              IF twoKeysToEnter THEN
                BEGIN split _ SIGNAL TwoKeysNonLeafSplit; RESUME [split.ca]; END;
            BTree2Defs.Merger => IF twoKeysToEnter THEN RESUME [NIL, TRUE]];
          IF split # NIL THEN
            BEGIN
            t: INTEGER _ index - ItemsP[this];
            IF t >= 0 THEN BEGIN index _ t; this _ split; END;
            END;
          ChangeKeys[
            this, index, son, TRUE !
            BTree2Defs.Merger =>
              IF ((twoKeysToEnter) AND (split # NIL)) THEN RESUME [NIL, TRUE]];
          END
        ELSE IF son.rekey THEN ChangeKeys[this, index, son, TRUE];
        END;
        SwapOutPage[sonssib ! UNWIND => FreePageDueToUnwind[son]; ];
        SwapOutPage[son];
        END;
      IF NOT go THEN EXIT;
      ENDLOOP;
    IF b.version # Version THEN Alarm[];
    END;

  ChangeKeys: PROCEDURE [
    this: Page, i: BTree2Defs.Index, son: Page, replace: BOOLEAN] =
    BEGIN
    eR: BTree2Defs.EntryR;
    this.dirty _ TRUE;
    IF ((i = 0) AND (son.deleted OR son.rekey)) THEN this.rekey _ TRUE;
    IF son.deleted THEN DeleteP[this, i]
    ELSE
      IF son.rekey THEN
        BEGIN
        son.rekey _ FALSE;
        eR _ LookupP[son, 0];
        eR.v _ DESCRIPTOR[@son.pa, 1];
        IF replace THEN BTree2Defs.Replace[this.ca, i, eR]
        ELSE InsertP[this, i, eR];
        END;
    END;

  FindIndexOnPage: PROCEDURE [p: Page, key: BTreeDefs.Desc]
    RETURNS [m: BTree2Defs.Index] =
    BEGIN
    GreaterOrEqual: BTreeDefs.TestKeys _ p.b.IsFirstGreaterOrEqual;
    numItemsOnPage: BTree2Defs.Index _ ItemsP[p];
    h: BTree2Defs.Index _ m _ 128;
    t: BOOLEAN;
    DO
      t _
        IF (m >= numItemsOnPage) THEN FALSE
        ELSE GreaterOrEqual[key, LookupP[p, m].k];
      h _ h/2;
      IF h = 0 THEN EXIT ELSE m _ IF t THEN m + h ELSE m - h;
      ENDLOOP;
    IF NOT t THEN m _ m - 1;
    END;

  -- Does it matter that for two empty args this returns TRUE?
  MyIsFirstGreaterOrEqual: BTreeDefs.TestKeys =
    BEGIN
    i: CARDINAL;
    t: CARDINAL = MIN[LENGTH[b], LENGTH[a]];
    g: INTEGER _ 0;
    FOR i IN [0..t) UNTIL ((g _ a[i] - b[i]) # 0) DO ENDLOOP;
    RETURN[((g > 0) OR ((g = 0) AND (LENGTH[a] >= LENGTH[b])))];
    END;

  MyAreTheyEqual: BTreeDefs.TestKeys =
    BEGIN
    i: CARDINAL;
    t: CARDINAL = LENGTH[a];
    IF LENGTH[b] # t THEN RETURN[FALSE];
    FOR i IN [0..t) DO IF a[i] # b[i] THEN RETURN[FALSE]; ENDLOOP;
    RETURN[TRUE];
    END;

  Copy: PROCEDURE [from: BTreeDefs.Desc, to: BTreeDefs.Desc] =
    BEGIN
    i, l: CARDINAL;
    l _ MIN[LENGTH[from], LENGTH[to]];
    FOR i IN [0..l) DO to[i] _ from[i]; ENDLOOP;
    END;

  SwapInPage: PROCEDURE [b: BTreeHandle, p: NN, l: CARDINAL] RETURNS [bp: Page] =
    BEGIN
    place: BTreeSupportDefs.PageHandle _ NIL;
    new: BOOLEAN _ (p = nullPA);
    reuse: BOOLEAN _ (new AND (b.freePA # 0));
    IF new THEN
      BEGIN
      p _ IF reuse THEN b.freePA ELSE b.lastPA _ b.lastPA + 1;
      b.dirtyTree _ TRUE;
      END;
    place _
      (IF ((NOT new) OR reuse) THEN BTreeSupportDefs.ReadPage
       ELSE BTreeSupportDefs.UsePage)[b.file, p - 1];
    bp _ BTreeSupportDefs.AllocateWords[SIZE[BTreePageRecord]];
    bp.pa _ p;
    bp.b _ b;
    bp.ca _ @bp.c;
    bp.dirty _ FALSE;
    bp.c _ DESCRIPTOR[place, b.pageS];
    bp.level _ l;
    bp.rekey _ new;
    bp.deleted _ FALSE;
    IF reuse THEN b.freePA _ bp.ca[0];
    IF new THEN BEGIN bp.dirty _ FALSE; BTree2Defs.Initialize[bp.ca]; END;
    IF checking >= moderate THEN Check[bp];
    END;

  SwapOutPage: PROCEDURE [p: Page] =
    BEGIN
    b: BTreeHandle;
    temp: BTreeSupportDefs.PageHandle;
    IF p = NIL THEN RETURN;
    IF checking >= moderate THEN Check[p];
    b _ p.b;
    temp _ LOOPHOLE[BASE[p.c]];
    IF p.deleted THEN
      BEGIN
      p.ca[0] _ b.freePA;
      b.freePA _ p.pa;
      b.dirtyTree _ p.dirty _ TRUE;
      END;
    IF p.dirty THEN
      BTreeSupportDefs.WritePage[
        p.b.file, p.pa - 1, temp !
        UNWIND =>
          BEGIN
          BTreeSupportDefs.ReleasePage[temp];
          BTreeSupportDefs.FreeWords[p];
          END]
    ELSE BTreeSupportDefs.ReleasePage[temp];
    BTreeSupportDefs.FreeWords[p];
    END;

  FreePageDueToUnwind: PROCEDURE [p: Page] =
    BEGIN
    temp: BTreeSupportDefs.PageHandle _ LOOPHOLE[BASE[p.c]];  --this is the only way 
    BTreeSupportDefs.ReleasePage[temp];  -- the compiler will accept this.
    BTreeSupportDefs.FreeWords[p];
    END;

  BuildARoot: PROCEDURE [b: BTreeHandle, brother: Page] =
    BEGIN
    eR: BTree2Defs.EntryR;
    root: Page _ SwapInPage[
      b, nullPA, b.depth _ b.depth + 1 !
      UNWIND => IF brother # NIL THEN FreePageDueToUnwind[brother]];
    IF brother # NIL THEN
      BEGIN
      eR _ LookupP[brother, 0];
      eR.v _ DESCRIPTOR[@brother.pa, 1];
      InsertP[root, -1, eR];
      SwapOutPage[brother ! UNWIND => FreePageDueToUnwind[root]];
      END;
    eR _ [DESCRIPTOR[NIL, 0], DESCRIPTOR[@b.rootPA, 1]];
    InsertP[root, -1, eR];
    b.rootPA _ root.pa;
    b.dirtyTree _ TRUE;
    SwapOutPage[root];
    END;

  LookupPA: PROCEDURE [p: Page, i: BTree2Defs.Index] RETURNS [NN] =
    BEGIN RETURN[LookupP[p, i].v[0]]; END;

  InsertP: PROCEDURE [p: Page, i: BTree2Defs.Index, e: BTree2Defs.EntryR] =
    BEGIN p.dirty _ TRUE; BTree2Defs.Insert[p.ca, i, e]; END;

  ReplaceP: PROCEDURE [p: Page, i: BTree2Defs.Index, e: BTree2Defs.EntryR] =
    BEGIN p.dirty _ TRUE; BTree2Defs.Replace[p.ca, i, e]; END;

  LookupP: PROCEDURE [p: Page, i: BTree2Defs.Index] RETURNS [BTree2Defs.EntryR] =
    BEGIN RETURN[BTree2Defs.Lookup[p.ca, i]]; END;

  DeleteP: PROCEDURE [p: Page, i: BTree2Defs.Index] =
    BEGIN p.dirty _ TRUE; BTree2Defs.Delete[p.ca, i]; END;

  ItemsP: PROCEDURE [p: Page] RETURNS [INTEGER] =
    BEGIN RETURN[BTree2Defs.Items[p.ca]]; END;

  Check: PROCEDURE [p: Page] =
    BEGIN
    b: BTreeHandle = p.b;
    i: NN;
    n: NN = ItemsP[p];
    e: BTree2Defs.EntryR;
    thisIsPageOne: BOOLEAN = (p = @b.self);
    IF b.version # Version THEN Alarm[];
    SELECT thisIsPageOne FROM
      TRUE => IF p.pa # 1 THEN Malformed;
      ENDCASE => IF p.pa NOT IN [2..b.lastPA] THEN Malformed;
    IF ((p.ca # @p.c) OR (LENGTH[p.c] # b.pageS)) THEN Malformed;
    IF ((p.level > b.depth) AND (NOT p.deleted)) THEN Malformed;
    IF
      ((b.rootPA NOT IN [2..b.lastPA])
        AND ~(b.rootPA = nullPA AND p.level = b.depth)) THEN Malformed;
    IF ((b.freePA > b.lastPA) OR (b.freePA = 1)) THEN Malformed;
    IF n >= 2 THEN
      IF b.IsFirstGreaterOrEqual[LookupP[p, 0].k, LookupP[p, n - 1].k] THEN
        Malformed;  -- Spot check
    IF n >= 4 THEN
      IF b.AreTheyEqual[LookupP[p, n/2].k, LookupP[p, n/2 - 1].k] THEN Malformed;
    -- Spot check
    IF p.level > 0 THEN
      FOR i IN [0..n) DO
        e _ LookupP[p, i];
        IF ((LENGTH[e.v] # 1) OR (e.v[0] NOT IN [2..b.lastPA])) THEN Malformed;
        IF ((LENGTH[e.k] = 0) AND (i > 0)) THEN Malformed;
        ENDLOOP;
    END;

  CheckTree: PUBLIC PROCEDURE [bh: BTreeHandle] =
    BEGIN
    seen: CARDINAL _ 0;
    was: CheckAmount = checking;
    previous: ARRAY [0..32) OF UNSPECIFIED;
    d: BTreeDefs.Desc _ DESCRIPTOR[NIL, 0];
    CheckC: CallTree =
      BEGIN
      k: BTreeDefs.Desc _ LookupP[p, i].k;
      SELECT LENGTH[k] FROM
        > LENGTH[previous] => Malformed;
        > 0 =>
          BEGIN
          seen _ seen + 1;
          IF bh.IsFirstGreaterOrEqual[d, k] THEN Malformed;
          END;
        ENDCASE;
      d _ DESCRIPTOR[@previous, LENGTH[k]];
      FOR i IN [0..LENGTH[k]) DO d[i] _ k[i]; ENDLOOP;
      RETURN[more: TRUE];
      END;
    checking _ moderate;
    StartEnumerate[bh, d, CheckC];
    IF seen # bh.entries THEN Malformed;
    checking _ was;
    END;


  END.

Edit Log

RTE: March 14, 1980 5:47 PM: KK: edited in Will's second fix for the split page - key problem.
Comment: March 28, 1980  7:13 PM: KK: changed the format of this program so that I could read it.
RTE: April 15, 1980  3:04 PM: KK: fixes in ChangeKeys and EnumFromTree for "two operations at once" bugs and delete not propagating the key bug.
RTE: May 1, 1980  5:12 PM: KK: insert didn't call replace for identical keys.
Comment: May 9, 1980  2:54 PM: KK: began changes to reflect changes to interface and removing caching.
RTE: September 8, 1980  1:14 PM: KK:  Mike Schroeder's fix: UNWIND in Enumerate.
RTE: September 25, 1980  4:20 PM: KK:  Unwind catches for transaction reset signals.  Also take out the two bV and bB things.
Comment: October 17, 1980  11:51 AM: KK:  added checks on version to catch bugs. 
Comment: October 21, 1980  7:02 PM: KK:  added registry of btrees.
RTE: October 27, 1980  12:40 PM: KK:  bug fix plus cleanup to above.
RTE: November 4, 1980  3:54 PM: KK: changed alarms to InvalidTree errors.  Also userUnwind fix.