-- 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.