DIRECTORY
BasicTime USING [GetClockPulses, MicrosecondsToPulses, Pulses],
BTree USING [GetState, SetUpdateInProgress, Tree, Validate],
BTreeTestOps,
BTreeVM,
Buttons USING [Button, ButtonProc, Create, ReLabel],
Containers USING [Container, Create],
Convert USING [Error, IntFromRope, RopeFromCard, RopeFromReal],
IO USING [PutFR],
Labels USING [Create, Label, Set],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
MessageWindow USING [Append, Blink],
Process USING [Detach, GetCurrent],
RandomCard USING [Init],
Real USING [Float],
Rope USING [Concat, Length, ROPE, Substr],
VFonts USING [CharWidth, StringWidth],
ViewerClasses USING [Viewer, ViewerClassRec],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [AddProp, CreateViewer, FetchProp, SetMenu],
ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection];
BTreeTestTool:
CEDAR
PROGRAM
IMPORTS BasicTime, BTree, BTreeTestOps, BTreeVM, Buttons, Containers, Convert, IO, Labels, Menus, MessageWindow, Process, RandomCard, Real, Rope, VFonts, ViewerEvents, ViewerOps, ViewerTools =
BEGIN
entryHeight: CARDINAL = 15; -- how tall to make each line of items
entryVSpace: CARDINAL = 8; -- vertical leading space between lines
entryHSpace: CARDINAL = 8; -- horizontal space between items in a line
Handle: TYPE = REF BTreeTestToolRec;
BTreeTestToolRec:
TYPE =
RECORD [
-- the data for a particular tool instance
outer: Containers.Container ← NIL, -- handle for the enclosing container
height: CARDINAL ← 0, -- height measured from the top of the container
idleMenu, activeMenu: Menus.Menu,
parV: ParametersViewer, -- viewer containing user input parameters
resV: ResultsViewer, -- viewer containing test results
params: Params, -- parameters for setting up BTree
results: Results, -- record of result values
tree: BTree.Tree ← NIL,
storage: BTreeVM.Handle ← NIL,
initTree: BOOLEAN ← TRUE,
process: PROCESS ← NIL,
pleaseStop, pleaseDestroy: BOOLEAN ← FALSE];
MakeBTreeTestTool:
PROCEDURE =
BEGIN
handle: Handle ← NEW[BTreeTestToolRec];
handle.idleMenu ← Menus.CreateMenu[];
Menus.AppendMenuEntry[
menu: handle.idleMenu,
entry: Menus.CreateEntry[
name: "Start",
proc: StartCommand,
clientData: handle]
];
Menus.AppendMenuEntry[
menu: handle.idleMenu,
entry: Menus.CreateEntry[
name: "InitTree",
proc: InitTreeCommand,
clientData: handle]
];
Menus.AppendMenuEntry[
menu: handle.idleMenu,
entry: Menus.CreateEntry[
name: "ResetStats",
proc: ResetStatsCommand,
clientData: handle]
];
handle.activeMenu ← Menus.CreateMenu[];
Menus.AppendMenuEntry[
menu: handle.activeMenu,
entry: Menus.CreateEntry[
name: "Stop",
proc: StopCommand,
clientData: handle]
];
handle.outer ← Containers.Create[[
name: "BTreeTest",
iconic: FALSE,
column: left,
menu: handle.idleMenu,
scrollable: TRUE ]];
MakeParametersViewer[handle];
MakeResultsViewer[handle];
ViewerOps.AddProp[viewer: handle.outer, prop: $handle, val: handle];
[] ← ViewerEvents.RegisterEventProc[proc: DestroyEvent, event: destroy, filter: handle.outer, before: TRUE];
END;
DestroyEvent: ViewerEvents.EventProc
--[viewer: ViewerClasses.Viewer, event: ViewerEvent, before:
BOOL]
RETURNS[abort:
BOOL ←
FALSE]-- =
BEGIN
handle: Handle = NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $handle]];
handle.pleaseStop ← handle.pleaseDestroy ← TRUE;
IF handle.process=NIL THEN TRUSTED { Process.Detach[FORK BTreeTestOps.Destroy[]] };
END;
ParametersViewer:
TYPE =
RECORD [
pageSizeButton: Buttons.Button ← NIL, pageSize: ViewerClasses.Viewer ← NIL,
cacheSizeButton: Buttons.Button ← NIL, cacheSize: ViewerClasses.Viewer ← NIL,
maxTreeSizeButton: Buttons.Button ← NIL, maxTreeSize: ViewerClasses.Viewer ← NIL,
longUpdate: Buttons.Button ← NIL, validateEveryUpdate: Buttons.Button ← NIL];
MakeParametersViewer:
PROCEDURE [handle: Handle] =
BEGIN OPEN par: handle.parV;
MakePromptButton:
PROCEDURE [name, initialValue: Rope.
ROPE]
RETURNS [button: Buttons.Button, viewer: ViewerClasses.Viewer] =
BEGIN
button ← Buttons.Create[
info: [
name: name,
wx: xPos,
wy: handle.height,
default the width so that it will be computed for us
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE ],
proc: Prompt];
viewer ← ViewerTools.MakeNewTextViewer[ [
parent: handle.outer,
wx: button.wx + button.ww + entryHSpace,
wy: handle.height+2,
ww: 7*VFonts.CharWidth['0],
wh: entryHeight,
data: initialValue, -- initial contents
scrollable: FALSE,
border: FALSE]];
ViewerOps.AddProp[viewer: button, prop: $value, val: viewer];
xPos ← viewer.wx + viewer.ww + entryHSpace;
END;
MakeBoolButton:
PROCEDURE [name: Rope.
ROPE, initialValue:
BOOLEAN]
RETURNS [button: Buttons.Button] =
BEGIN
button ← Buttons.Create[
info: [
name: Rope.Concat[name, IF initialValue THEN ": Yes" ELSE ": No "],
wx: xPos,
wy: handle.height,
default the width so that it will be computed for us
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE ],
proc: BoolButton];
ViewerOps.AddProp[viewer: button, prop: $value, val: NEW [BOOLEAN ← initialValue]];
xPos ← button.wx + button.ww + entryHSpace;
END;
xPos: CARDINAL ← 0;
handle.height ← handle.height + entryVSpace; -- space down from the top of the viewer
[button: par.pageSizeButton, viewer: par.pageSize] ← MakePromptButton[name: "DiskPages/BTreePage:", initialValue: "1"];
[button: par.cacheSizeButton, viewer: par.cacheSize] ← MakePromptButton[name: "CacheSize:", initialValue: "20"];
[button: par.maxTreeSizeButton, viewer: par.maxTreeSize] ← MakePromptButton[name: "MaxTreeEntries:", initialValue: "10000"];
xPos ← 0;
handle.height ← handle.height + entryHeight + entryVSpace;
par.longUpdate ← MakeBoolButton[name: "LongUpdate", initialValue: FALSE];
par.validateEveryUpdate ← MakeBoolButton[name: "ValidateEveryUpdate", initialValue: FALSE];
handle.height ← handle.height + entryHeight + entryVSpace; -- interline spacing
END;
Prompt: Buttons.ButtonProc =
BEGIN
force the selection into the user input field
viewer: ViewerClasses.Viewer ← NARROW[ViewerOps.FetchProp[viewer: NARROW[parent], prop: $value]];
ViewerTools.SetSelection[viewer]; -- force the selection
END;
BoolButton: Buttons.ButtonProc =
BEGIN
button: Buttons.Button = NARROW[parent];
value: REF BOOLEAN = NARROW[ViewerOps.FetchProp[viewer: button, prop: $value]];
name: Rope.ROPE = Rope.Substr[base: button.name, len: Rope.Length[button.name]-3];
value^ ← ~value^;
Buttons.ReLabel[button: button, newName: Rope.Concat[name, IF value^ THEN "Yes" ELSE "No "]];
END;
Params:
TYPE =
RECORD [
cacheSize: BTreeVM.CacheSize ← 20,
filePagesPerPage: BTreeVM.FilePagesPerPage ← 1,
maxEntries: BTreeTestOps.KeyIndex ← 10000,
longUpdate, validateEveryUpdate: BOOLEAN ← FALSE];
ParamError: ERROR [message: Rope.ROPE] = CODE;
ParseParams:
PROCEDURE [handle: Handle]
RETURNS [params: Params] =
BEGIN OPEN pv: handle.parV;
IntervalFromRope:
PROCEDURE [r: Rope.
ROPE, min, max:
INT]
RETURNS [result:
INT] =
BEGIN
result ← Convert.IntFromRope[r ! Convert.Error => GOTO notNumber];
IF result NOT IN [min..max] THEN ERROR ParamError[IO.PutFR["\"%g\" is out of bounds; must be in the range [%g..%g]", [rope[r]], [integer[min]], [integer[max]]]];
EXITS
notNumber => ERROR ParamError[IO.PutFR["\"%g\" is not a number", [rope[r]]]];
END;
params.cacheSize ← IntervalFromRope[r: ViewerTools.GetContents[pv.cacheSize], min: FIRST[BTreeVM.CacheSize], max: LAST[BTreeVM.CacheSize]];
params.filePagesPerPage ← IntervalFromRope[r: ViewerTools.GetContents[pv.pageSize], min: FIRST[BTreeVM.FilePagesPerPage], max: LAST[BTreeVM.FilePagesPerPage]];
params.maxEntries ← IntervalFromRope[r: ViewerTools.GetContents[pv.maxTreeSize], min: 100, max: LAST[BTreeTestOps.KeyIndex]];
params.longUpdate ← NARROW[ViewerOps.FetchProp[viewer: pv.longUpdate, prop: $value], REF BOOLEAN]^;
params.validateEveryUpdate ← NARROW[ViewerOps.FetchProp[viewer: pv.validateEveryUpdate, prop: $value], REF BOOLEAN]^;
END;
ResultsViewer:
TYPE =
RECORD [
treePages, treeLevels, treeEntries: Labels.Label,
operations: ARRAY Operation OF Labels.Label,
totalOperations: Labels.Label,
msPerOp: ARRAY Operation OF Labels.Label,
cacheRefs, hitPercent, reads, writes, writesPerUpdate: Labels.Label,
elapsed, percentRW, msPerReadWrite: Labels.Label];
Operation: TYPE = BTreeTestOps.Operation;
MakeResultsViewer:
PROCEDURE [handle: Handle] =
BEGIN OPEN res: handle.resV;
MakeLabel:
PROCEDURE [value: Rope.
ROPE, width:
CARDINAL ← 0]
RETURNS [label: Labels.Label] =
BEGIN
label ← Labels.Create[ [
name: value,
wx: xPos,
wy: handle.height,
ww: IF width#0 THEN width ELSE VFonts.StringWidth[value],
wh: entryHeight,
parent: handle.outer,
border: FALSE]];
xPos ← label.wx + label.ww + entryHSpace;
END;
charWidth: CARDINAL = VFonts.CharWidth['0];
itemWidth: CARDINAL = 12*charWidth;
xPos: CARDINAL ← 0;
handle.height ← handle.height + entryVSpace;
[] ← MakeLabel["Tree size: Pages:"];
res.treePages ← MakeLabel["0", 6*charWidth];
[] ← MakeLabel["Levels:"];
res.treeLevels ← MakeLabel["0", 4*charWidth];
[] ← MakeLabel["Entries:"];
res.treeEntries ← MakeLabel["0", 8*charWidth];
handle.height ← handle.height + entryHeight + entryVSpace;
xPos ← itemWidth + entryHSpace;
[] ← MakeLabel["Lookup", itemWidth];
[] ← MakeLabel["Enumerate", itemWidth];
[] ← MakeLabel["Insert", itemWidth];
[] ← MakeLabel["Delete", itemWidth];
[] ← MakeLabel["Replace", itemWidth];
[] ← MakeLabel["Total", itemWidth];
xPos ← 0;
handle.height ← handle.height + entryHeight + entryVSpace;
[] ← MakeLabel["Operations", itemWidth];
FOR op: Operation
IN Operation
DO
res.operations[op] ← MakeLabel["0", itemWidth];
ENDLOOP;
res.totalOperations ← MakeLabel["0", itemWidth];
xPos ← 0;
handle.height ← handle.height + entryHeight;
[] ← MakeLabel["ms/op", itemWidth];
FOR op: Operation
IN Operation
DO
res.msPerOp[op] ← MakeLabel["0", itemWidth];
ENDLOOP;
handle.height ← handle.height + entryHeight + entryVSpace;
xPos ← 0;
[] ← MakeLabel["CacheRefs: "];
res.cacheRefs ← MakeLabel["0", 9*charWidth];
[] ← MakeLabel["Hit%: "];
res.hitPercent ← MakeLabel["0", 5*charWidth];
handle.height ← handle.height + entryHeight + entryVSpace;
xPos ← 0;
[] ← MakeLabel["Storage Reads: "];
res.reads ← MakeLabel["0", 9*charWidth];
[] ← MakeLabel["Writes: "];
res.writes ← MakeLabel["0", 9*charWidth];
[] ← MakeLabel["Writes/update: "];
res.writesPerUpdate ← MakeLabel["0", 7*charWidth];
handle.height ← handle.height + entryHeight + entryVSpace;
xPos ← 0;
[] ← MakeLabel["Total elapsed time (sec): "];
res.elapsed ← MakeLabel["0", 9*charWidth];
[] ← MakeLabel["% R+W time: "];
res.percentRW ← MakeLabel["0", 5*charWidth];
[] ← MakeLabel["ms/(R or W): "];
res.msPerReadWrite ← MakeLabel["0", 5*charWidth];
handle.height ← handle.height + entryHeight + entryVSpace;
END;
Results:
TYPE =
RECORD [
counts: ARRAY Operation OF LONG CARDINAL ← ALL [0],
times: ARRAY Operation OF BasicTime.Pulses ← ALL [0],
seedUsed: INTEGER ← RandomCard.Init[0],
treePages, treeLevels: CARDINAL ← 0,
treeEntries: LONG CARDINAL ← 0,
hits, misses, reads, writes: LONG CARDINAL ← 0,
cumReadWriteTime: BasicTime.Pulses ← 0];
DisplayResults:
PROCEDURE [handle: Handle] =
BEGIN OPEN rv: handle.resV, res: handle.results;
totalOperations: LONG CARDINAL ← 0;
totalTime: BasicTime.Pulses ← 0;
millisecondsPerPulse: REAL = 1000.0 / Real.Float[BasicTime.MicrosecondsToPulses[1000000]];
Labels.Set[rv.treePages, Convert.RopeFromCard[res.treePages]];
Labels.Set[rv.treeLevels, Convert.RopeFromCard[res.treeLevels]];
Labels.Set[rv.treeEntries, Convert.RopeFromCard[res.treeEntries]];
FOR op: Operation
IN Operation
DO
Labels.Set[rv.operations[op], Convert.RopeFromCard[res.counts[op]]];
totalOperations ← totalOperations+res.counts[op];
totalTime ← totalTime+res.times[op];
ENDLOOP;
Labels.Set[rv.totalOperations, Convert.RopeFromCard[totalOperations]];
FOR op: Operation
IN Operation
DO
msPerOp: REAL = (Real.Float[res.times[op]] / Real.Float[MAX[res.counts[op], 1]]) * millisecondsPerPulse;
Labels.Set[rv.msPerOp[op], Convert.RopeFromReal[from: msPerOp, precision: 3]];
ENDLOOP;
Labels.Set[rv.cacheRefs, Convert.RopeFromCard[res.hits+res.misses]];
Labels.Set[rv.hitPercent, Convert.RopeFromReal[from: Real.Float[res.hits]*100.0 / Real.Float[MAX[res.hits+res.misses, 1]], precision: 3]];
Labels.Set[rv.reads, Convert.RopeFromCard[res.reads]];
Labels.Set[rv.writes, Convert.RopeFromCard[res.writes]];
Labels.Set[rv.writesPerUpdate, Convert.RopeFromReal[from: Real.Float[res.writes] / Real.Float[MAX[res.counts[insert]+res.counts[delete]+res.counts[replace], 1]], precision: 3]];
Labels.Set[rv.elapsed, Convert.RopeFromReal[from: Real.Float[totalTime] * millisecondsPerPulse/1000.0, precision: 3]];
Labels.Set[rv.percentRW, Convert.RopeFromReal[from: Real.Float[res.cumReadWriteTime]*100.0 / Real.Float[MAX[totalTime, 1]], precision: 3]];
Labels.Set[rv.msPerReadWrite, Convert.RopeFromReal[from: (Real.Float[res.cumReadWriteTime] / Real.Float[MAX[res.reads+res.writes, 1]]) * millisecondsPerPulse, precision: 3]];
END;
StartCommand: Menus.MenuProc =
BEGIN
handle: Handle = NARROW [clientData];
params: Params ← ParseParams[handle !
ParamError =>
{ MessageWindow.Append[message: message, clearFirst: TRUE]; GOTO paramError }];
IF ~handle.initTree
AND params#handle.params
THEN
BEGIN
IF params.filePagesPerPage#handle.params.filePagesPerPage
OR params.maxEntries#handle.params.maxEntries
THEN
BEGIN
MessageWindow.Append[message: "Parameters changed; you must InitTree first", clearFirst: TRUE];
GOTO paramError;
END;
handle.tree ← NIL;
handle.storage ← NIL;
END;
handle.params ← params;
IF handle.tree=
NIL
THEN
[tree: handle.tree, storage: handle.storage] ← BTreeTestOps.Create[cacheSize: params.cacheSize, initialize: handle.initTree, filePagesPerPage: params.filePagesPerPage, maxEntries: params.maxEntries];
handle.initTree ← FALSE;
IF params.longUpdate THEN handle.tree.SetUpdateInProgress[TRUE];
handle.pleaseStop ← FALSE;
handle.process ← FORK TestProc[handle];
ViewerOps.SetMenu[viewer: handle.outer, menu: handle.activeMenu];
EXITS
paramError => MessageWindow.Blink[];
END;
StopCommand: Menus.MenuProc =
BEGIN
handle: Handle = NARROW [clientData];
handle.pleaseStop ← TRUE;
TRUSTED { JOIN handle.process };
handle.process ← NIL;
ViewerOps.SetMenu[viewer: handle.outer, menu: handle.idleMenu];
END;
InitTreeCommand: Menus.MenuProc =
BEGIN
handle: Handle = NARROW [clientData];
handle.tree ← NIL;
handle.storage ← NIL;
handle.initTree ← TRUE;
handle.results ← [];
DisplayResults[handle];
END;
ResetStatsCommand: Menus.MenuProc =
BEGIN
handle: Handle = NARROW [clientData];
handle.tree ← NIL;
handle.storage ← NIL;
handle.results ← [];
DisplayResults[handle];
END;
TestProc:
PROCEDURE [handle: Handle] =
BEGIN OPEN res: handle.results;
ENABLE
UNWIND =>
IF ~handle.pleaseStop
THEN
BEGIN
ViewerOps.SetMenu[viewer: handle.outer, menu: handle.idleMenu];
TRUSTED { Process.Detach[Process.GetCurrent[]] };
END;
lastUpdateTime: BasicTime.Pulses ← BasicTime.GetClockPulses[];
updateInterval: LONG CARDINAL = 3*BasicTime.MicrosecondsToPulses[1000000];
UNTIL handle.pleaseStop
DO
operation: BTreeTestOps.Operation;
k: BTreeTestOps.KeyIndex;
then: BasicTime.Pulses ← BasicTime.GetClockPulses[];
now: BasicTime.Pulses;
[operation: operation, key: k] ← BTreeTestOps.PerformRandomOperation[];
now ← BasicTime.GetClockPulses[];
res.times[operation] ← res.times[operation] + (now - then);
res.counts[operation] ← res.counts[operation]+(IF operation=validate THEN handle.tree.GetState[].entryCount ELSE 1);
IF handle.params.validateEveryUpdate
THEN
BEGIN
myCount: LONG CARDINAL = BTreeTestOps.GetEntryCount[];
then ← BasicTime.GetClockPulses[];
handle.tree.Validate[];
now ← BasicTime.GetClockPulses[];
res.times[validate] ← res.times[validate] + (now - then);
res.counts[validate] ← res.counts[validate] + myCount;
IF handle.tree.GetState[].entryCount # myCount THEN ERROR; -- entry count disagrees. Call BTreeTestImpl.FindMissingEntries to find the missing ones.
END;
IF now-lastUpdateTime > updateInterval
OR handle.pleaseStop
THEN
BEGIN
[entryCount: res.treeEntries, greatestPage: res.treePages, depth: res.treeLevels] ← handle.tree.GetState[];
[hits: res.hits, misses: res.misses, reads: res.reads, writes: res.writes, cumReadWriteTime: res.cumReadWriteTime] ← handle.storage.GetStats[];
DisplayResults[handle];
lastUpdateTime ← now;
END;
ENDLOOP;
IF handle.params.longUpdate THEN handle.tree.SetUpdateInProgress[FALSE];
IF handle.pleaseDestroy
THEN
BEGIN
BTreeTestOps.Destroy[];
TRUSTED { Process.Detach[Process.GetCurrent[]] };
END;
END;
Initialization
MakeBTreeTestTool[];
END.