-- BTree.mesa		Last edit: KK		November 4, 1980  1:43 PM
 -- Edited by Andrew Birrell 22-May-81 10:19:37

DIRECTORY
BTreeDefs: FROM "BTreeDefs"
USING[BTreeHandle, Call, Desc, KeyNotFound, TestKeys],
BTree2Defs: FROM "BTree2Defs"
USING[Delete, DeletePage, Entry, EntryR, GetAnother, Index, Initialize, Insert, Items, Lookup, Merger, Replace, VArray],
BTreeSupportDefs: FROM "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 = POINTER TO BTreePageRecord;
BTreePageRecord: TYPE = RECORD [b: Tree, 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).

Tree: TYPE = 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: Tree, 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];

registeryOfBTrees: pntrToBTreeReg _ NIL;
pntrToBTreeReg: TYPE = POINTER TO BTreeReg;
BTreeReg: TYPE = RECORD[next: pntrToBTreeReg, tree: Tree, valid: BOOLEAN];

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[];

InvalidTree: PUBLIC ERROR = CODE;

CheckBTreeRegistered: PROCEDURE[b: Tree] RETURNS [inValidTree: BOOLEAN] =
BEGIN
FOR pntr: pntrToBTreeReg _ registeryOfBTrees, pntr.next
DO
IF pntr = NIL THEN Alarm[];
IF pntr.tree = b THEN RETURN [NOT pntr.valid];
ENDLOOP;
END;

RegisterBTree: PROCEDURE[b: Tree] =
BEGIN
oldPntr: POINTER TO pntrToBTreeReg _ @registeryOfBTrees;
pntr: pntrToBTreeReg _ registeryOfBTrees;
DO
IF pntr = NIL
THEN
BEGIN
pntr _ BTreeSupportDefs.AllocateWords[SIZE[BTreeReg]];
pntr^ _ [tree: b, next: NIL, valid: TRUE];
oldPntr^ _ pntr;
RETURN;
END;
oldPntr _ @pntr.next;
pntr _ pntr.next;
ENDLOOP;
END;

RemoveRegistryOfBTree: PROCEDURE[b: Tree] =
BEGIN
oldPntr: POINTER TO pntrToBTreeReg _ @registeryOfBTrees;
pntr: pntrToBTreeReg _ registeryOfBTrees;
DO
IF pntr = NIL THEN Alarm[];
IF pntr.tree = b
THEN
BEGIN
oldPntr^ _ pntr.next;
BTreeSupportDefs.FreeWords[pntr];
RETURN;
END;
oldPntr _ @pntr.next;
pntr _ pntr.next;
ENDLOOP;
END;

MarkBTreeInvalidInRegistry: PROCEDURE[b: Tree] =
BEGIN
pntr: pntrToBTreeReg _ registeryOfBTrees;
DO
IF pntr = NIL THEN Alarm[];
IF pntr.tree = b
THEN BEGIN pntr.valid _ FALSE; RETURN; END;
pntr _ pntr.next;
ENDLOOP;
END;

-- Conventions: Unwinds out of CreateAndInitializeBTree and ReleaseBTree have freed Tree and removed the registry.  Other Unwinds expect someone else to shut down the tree (ReleaseBTree is not the thing to be called to do that; call ShutDownBTree instead).

CreateAndInitializeBTree: PUBLIC PROCEDURE[fileH: BTreeSupportDefs.FileHandle, initializeFile, useDefaultOrderingRoutines: BOOLEAN, isFirstGreaterOrEqual, areTheyEqual: BTreeDefs.TestKeys] RETURNS[bh: BTreeDefs.BTreeHandle] =
BEGIN
b: Tree _ NIL;
BEGIN
ENABLE UNWIND => IF b # NIL THEN BEGIN RemoveRegistryOfBTree[b]; BTreeSupportDefs.FreeWords[b]; END;
b _ BTreeSupportDefs.AllocateWords[SIZE[BTreeRecord]];
RegisterBTree[b];
bh _ LOOPHOLE[b];
IF initializeFile
THEN
BEGIN
b^ _ [version: Version, rootPA: nullPA, freePA: 0, lastPA: 1, pageS: PageSize, depth: 177777B, entries: 0, file: fileH, self: BTreePageRecord[b: b, 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[b, NIL];
END
ELSE
BEGIN
oldB: POINTER TO OldBTreeRecord _ LOOPHOLE[BTreeSupportDefs.ReadPage[fileH, 1 - 1]];
IF oldB.version # Version THEN Malformed;
IF oldB.pageS # PageSize THEN Malformed;
b^ _ [version: oldB.version, rootPA: oldB.rootPA, freePA: oldB.freePA, lastPA: oldB.lastPA, pageS: PageSize, depth: oldB.depth, entries: oldB.entries, file: fileH, self: [b: b, 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;
b.IsFirstGreaterOrEqual _ (IF useDefaultOrderingRoutines THEN MyIsFirstGreaterOrEqual ELSE isFirstGreaterOrEqual);
b.AreTheyEqual _ (IF useDefaultOrderingRoutines THEN MyAreTheyEqual ELSE areTheyEqual);
IF b.version # Version THEN Alarm[];
END;
END;

ReleaseBTree: PUBLIC PROCEDURE[bh: BTreeDefs.BTreeHandle] RETURNS[fileH: BTreeSupportDefs.FileHandle] =
BEGIN
b: Tree = LOOPHOLE[bh];
IF CheckBTreeRegistered[b].inValidTree THEN ERROR InvalidTree;
IF b.version # Version THEN Alarm[];
PushBTreeToDisk[bh ! UNWIND => BEGIN RemoveRegistryOfBTree[b]; BTreeSupportDefs.FreeWords[b]; END];
fileH _ b.file;
RemoveRegistryOfBTree[b];
BTreeSupportDefs.FreeWords[b];
RETURN[fileH];
END;

ShutDownBTree: PUBLIC PROCEDURE[bh: BTreeDefs.BTreeHandle] RETURNS[fileH: BTreeSupportDefs.FileHandle] =
BEGIN
b: Tree = LOOPHOLE[bh];
IF NOT CheckBTreeRegistered[b].inValidTree THEN ERROR InvalidTree;
IF b.version # Version THEN Alarm[];
RemoveRegistryOfBTree[b];
BTreeSupportDefs.FreeWords[b];
RETURN[b.file];
END;

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

PruneBTree: PUBLIC PROCEDURE[bh: BTreeDefs.BTreeHandle] RETURNS[storageFreed: BOOLEAN] =
BEGIN
b: Tree = LOOPHOLE[bh];
IF CheckBTreeRegistered[b].inValidTree THEN ERROR InvalidTree;
RETURN[FALSE];
END;

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

AskDepthOfTree: PUBLIC PROCEDURE[bh: BTreeDefs.BTreeHandle] RETURNS[nLevels: CARDINAL] =
BEGIN
b: Tree = LOOPHOLE[bh];
IF CheckBTreeRegistered[b].inValidTree THEN ERROR InvalidTree;
IF b.version # Version THEN Alarm[];
RETURN[b.depth];
END;

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

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

Next: PROCEDURE[bh: BTreeDefs.BTreeHandle, e: BTree2Defs.Entry] =
BEGIN
seen: CARDINAL _ 0;
bcheck: Tree = LOOPHOLE[bh];
LookupC: CallTree =
BEGIN
b: Tree = LOOPHOLE[bh];
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 CheckBTreeRegistered[bcheck].inValidTree THEN ERROR InvalidTree;
IF bcheck.version # Version THEN Alarm[];
StartEnumerate[bh, e.k, LookupC];
IF bcheck.version # Version THEN Alarm[];
END;

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

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

StartEnumerate: PROCEDURE[bh: BTreeDefs.BTreeHandle, key: BTreeDefs.Desc, c: CallTree] =
BEGIN
b: Tree = LOOPHOLE[bh];
BEGIN ENABLE UNWIND => IF NOT b.sawUserUnwind THEN MarkBTreeInvalidInRegistry[b] ELSE b.sawUserUnwind _ FALSE;
this: Page _ SwapInPage[b, b.rootPA, b.depth];
brother: Page _ NIL;
checkT: BOOLEAN = ((checking >= dontAsk) AND (LENGTH[key] > 0));
GetPageForSplit: PROCEDURE RETURNS[Page] =
BEGIN RETURN[brother _ SwapInPage[b, 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[b, brother ! UNWIND => FreePageDueToUnwind[this]  ];
END;
IF ((ItemsP[this] = 1) AND (b.depth # 0))
THEN -- remove a level.
BEGIN
b.rootPA _ LookupPA[this, 0];
this.deleted _ TRUE;
b.depth _ b.depth - 1;
b.dirtyTree _ TRUE;
END;
SwapOutPage[this];
IF b.version # Version THEN Alarm[];
IF checkT THEN CheckTree[bh];
END;
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: CARDINAL _ ItemsP[this];
low: NN = IF this.level > 0 THEN this.level - 1 ELSE 0;
b: Tree = 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;

NullProc: PUBLIC BTreeDefs.TestKeys =
BEGIN
Alarm[];
RETURN[TRUE]; -- keep compiler happy.
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: Tree, 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: Tree;
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: Tree, 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, 177777B, @eR];
SwapOutPage[brother ! UNWIND => FreePageDueToUnwind[root]];
END;
eR _ [DESCRIPTOR[NIL, 0],DESCRIPTOR[@b.rootPA, 1]];
InsertP[root, 177777B, @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.Entry] =
BEGIN p.dirty _ TRUE;
BTree2Defs.Insert[p.ca, i, e];
END;

ReplaceP: PROCEDURE[p: Page, i: BTree2Defs.Index, e: BTree2Defs.Entry] =
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 [CARDINAL] =
BEGIN RETURN[BTree2Defs.Items[p.ca]]; END;

Check: PROCEDURE[p: Page] =
BEGIN
b: Tree = 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: BTreeDefs.BTreeHandle] =
BEGIN
b: Tree = LOOPHOLE[bh];
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 b.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;
IF CheckBTreeRegistered[b].inValidTree THEN ERROR InvalidTree;
checking _ moderate;
StartEnumerate[bh, d, CheckC];
IF seen # b.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.