-- Copyright (C) 1981, 1984, 1985 by Xerox Corporation. All rights reserved.
-- BTree.mesa, HGM, 17-Sep-85 9:21:21
-- KK, November 4, 1980 1:43 PM
-- Andrew Birrell 22-May-81 10:19:37
DIRECTORY
BTreeDefs USING [
BTreeHandle, Call, Desc, KeyNotFound, TestKeys],
BTree2Defs USING [
Delete, DeletePage, Entry, EntryR, GetAnother, Index, Initialize, Insert,
Items, Lookup, Merger, Replace, VArray],
BTreeSupportDefs USING [
FileHandle, PageHandle, PageSize, ReadPage,
ReleasePage, UsePage, WritePage],
Heap USING [systemZone];
BTree: PROGRAM IMPORTS BTree2Defs, BTreeSupportDefs, Heap EXPORTS BTreeDefs =
BEGIN
TwoKeysNonLeafSplit: SIGNAL RETURNS [Page] = CODE;
EntryTooSmall: SIGNAL = CODE;
Malformed: SIGNAL = CODE;
Alarm: PROCEDURE = BEGIN SIGNAL AlarmCalled; END;
AlarmCalled: SIGNAL = CODE;
Version: NN ← 1; -- for bug checking.
CallTree: TYPE = PROCEDURE [p: Page, i: BTree2Defs.Index]
RETURNS [more: BOOLEAN];
NN: TYPE = CARDINAL;
Page: TYPE = LONG 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 = 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: 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 = LONG 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: LONG POINTER TO PntrToBTreeReg ← @registeryOfBTrees;
pntr: PntrToBTreeReg ← registeryOfBTrees;
DO
IF pntr = NIL THEN
BEGIN
pntr ← Heap.systemZone.NEW[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: LONG POINTER TO PntrToBTreeReg ← @registeryOfBTrees;
pntr: PntrToBTreeReg ← registeryOfBTrees;
DO
IF pntr = NIL THEN Alarm[];
IF pntr.tree = b THEN
BEGIN oldPntr↑ ← pntr.next; Heap.systemZone.FREE[@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]; Heap.systemZone.FREE[@b]; END;
b ← Heap.systemZone.NEW[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: LONG 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]; Heap.systemZone.FREE[@b]; END];
fileH ← b.file;
RemoveRegistryOfBTree[b];
Heap.systemZone.FREE[@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];
Heap.systemZone.FREE[@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: LONG 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 => 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 ← Heap.systemZone.NEW[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];
Heap.systemZone.FREE[@p];
END]
ELSE BTreeSupportDefs.ReleasePage[temp];
Heap.systemZone.FREE[@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.
Heap.systemZone.FREE[@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.