CodeTimerImpl.mesa
Copyright Ó 1986, 1992 by Xerox Corporation. All rights reserved.
Bier, November 13, 1992 3:53 pm PST
JKF, February 21, 1990 8:26:15 am PST
Contents: Routines for maintaining a table of average times for user-specified operations. Note: the current implementation does not tabulate statistics well when several processes are executed code that affects the same table. A more advanced version may keep per-process statistics.
Willie-s, February 5, 1992 6:00 pm PST
DIRECTORY
Atom, BasicTime, CodeTimerConcrete, Commander, IO, CodeTimer, Process, RefTab, Rope;
CodeTimerImpl: CEDAR MONITOR
IMPORTS Atom, BasicTime, Commander, IO, Process, RefTab
EXPORTS CodeTimer = BEGIN
ProcessPair: TYPE = CodeTimerConcrete.ProcessPair;
ProcessPairObj: TYPE = CodeTimerConcrete.ProcessPairObj;
Table: TYPE = REF TableObj;
TableObj: PUBLIC TYPE = CodeTimerConcrete.TableObj;
IntervalInContext: TYPE = REF IntervalInContextObj;
IntervalInContextObj: PUBLIC TYPE = CodeTimerConcrete.IntervalInContextObj;
gTablesRef: RefTab.Ref;
intervalPoolMax: CARD32 = 25;
intervalPool: ARRAY [0..intervalPoolMax) OF IntervalInContext;
intervalPoolIndex: INT32 ¬ -1;
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE;
Getting ready to test performance.
CreateIntervalInContext: PROC [intervalName: ATOM] RETURNS [intervalInContext: IntervalInContext] = {
intervalInContext ¬ NEW[IntervalInContextObj];
intervalInContext.name ¬ intervalName;
};
AllocateInterval: ENTRY PROC [intervalName: ATOM] RETURNS [interval: IntervalInContext] = {
IF intervalPoolIndex >= 0 THEN {
interval ← intervalPool[intervalPoolIndex];
ZeroInterval[interval];
interval.children ← NIL;
interval.name ← intervalName;
intervalPoolIndex ← intervalPoolIndex - 1;
}
ELSE interval ← CreateIntervalInContext[intervalName];
};
AllocateIntervalInternal: INTERNAL PROC [intervalName: ATOM] RETURNS [interval: IntervalInContext] = {
IF intervalPoolIndex >= 0 THEN {
interval ¬ intervalPool[intervalPoolIndex];
ZeroInterval[interval];
interval.children ¬ NIL;
interval.name ¬ intervalName;
intervalPoolIndex ¬ intervalPoolIndex - 1;
}
ELSE interval ¬ CreateIntervalInContext[intervalName];
};
FreeInterval: ENTRY PROC [interval: IntervalInContext] = {
IF intervalPoolIndex < intervalPoolMax -1 THEN {
intervalPoolIndex ← intervalPoolIndex + 1;
intervalPool[intervalPoolIndex] ← interval;
};
interval.children ← NIL;
interval.parent ← NIL;
};
FreeIntervalInternal: INTERNAL PROC [interval: IntervalInContext] = {
IF intervalPoolIndex < intervalPoolMax -1 THEN {
intervalPoolIndex ¬ intervalPoolIndex + 1;
intervalPool[intervalPoolIndex] ¬ interval;
};
interval.children ¬ NIL;
interval.parent ¬ NIL;
};
CreateTable: PUBLIC PROC [name: ATOM ¬ NIL] RETURNS [table: Table] = {
oldTable: Table ¬ GetTable[name];
IF oldTable = NIL THEN {
outer: IntervalInContext ← AllocateInterval[$Outer];
table ¬ NEW[TableObj ¬ [name, NIL]];
IF name # NIL THEN AddTableToTables[table];
}
ELSE {
table ¬ oldTable;
ResetTable[table];
};
};
GetTable: PUBLIC PROC [name: ATOM] RETURNS [table: Table] = {
val: RefTab.Val;
found: BOOL ¬ FALSE;
[found, val] ¬ RefTab.Fetch[gTablesRef, name];
IF found THEN table ¬ NARROW[val] ELSE table ¬ NIL;
};
AddTableToTables: PROC [table: Table] = {
new: BOOL ¬ RefTab.Store[gTablesRef, table.name, table];
IF NOT new THEN ERROR;
};
ResetTable: PUBLIC PROC [table: Table] = {
The table is a tree of nested intervals. Return all of these intervals to the interval pool except for the top level interval;
ResetProcess: RefTab.EachPairAction = {
DoResetProcess: RefTab.UpdateAction = {
PROC [found: BOOL, val: Val] RETURNS [op: UpdateOperation ← none, new: Val ← NIL]
IF found THEN {
IF val = NIL THEN RETURN[none, NIL];
pair: ProcessPair ← NARROW[val];
FOR list: LIST OF IntervalInContext ← pair.outer.children, list.rest UNTIL list = NIL DO
FreeIntervalAndChildren[list.first];
ENDLOOP;
pair.outer.children ← NIL;
pair.current ← pair.outer;
op ← none; new ← pair;
};
};
RefTab.Update[table.processes, key, DoResetProcess];
};
RefTab.Pairs[table.processes, ResetProcess];
};
ResetTable: PUBLIC ENTRY PROC [table: Table] = {
The table is a tree of nested intervals. Return all of these intervals to the interval pool except for the top level interval;
FOR lp: LIST OF ProcessPair ¬ table.processes, lp.rest UNTIL lp = NIL DO
pair: ProcessPair ¬ lp.first;
FOR list: LIST OF IntervalInContext ¬ pair.outer.children, list.rest UNTIL list = NIL DO
FreeIntervalAndChildren[list.first];
ENDLOOP;
pair.outer.children ¬ NIL;
pair.current ¬ pair.outer;
ENDLOOP;
table.processes ¬ NIL;
};
FreeIntervalAndChildren: INTERNAL PROC [interval: IntervalInContext] = {
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
FreeIntervalAndChildren[list.first];
ENDLOOP;
FreeIntervalInternal[interval];
};
ResetInterval: PUBLIC PROC [intervalName: ATOM, table: Table] = {
Wherever this interval occurs in the tree, zero it and its children.
ZeroIntervalInProcess: RefTab.EachPairAction = {
DoZeroIntervalInProcess: RefTab.UpdateAction = {
PROC [found: BOOL, val: Val] RETURNS [op: UpdateOperation ← none, new: Val ← NIL]
IF found THEN {
IF val = NIL THEN RETURN[none, NIL];
pair: ProcessPair ← NARROW[val];
ZeroNamedIntervalInTree[intervalName, pair.outer];
op ← none; new ← pair;
};
};
RefTab.Update[table.processes, key, DoZeroIntervalInProcess];
};
RefTab.Pairs[table.processes, ZeroIntervalInProcess];
};
ResetInterval: PUBLIC ENTRY PROC [intervalName: ATOM, table: Table] = {
Wherever this interval occurs in the tree, zero it and its children.
FOR lp: LIST OF ProcessPair ¬ table.processes, lp.rest UNTIL lp = NIL DO
pair: ProcessPair ¬ lp.first;
ZeroNamedIntervalInTree[intervalName, pair.outer];
ENDLOOP;
};
ZeroNamedIntervalInTree: INTERNAL PROC [intervalName: ATOM, interval: IntervalInContext] = {
IF interval.name = intervalName THEN ZeroInterval[interval];
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
ZeroNamedIntervalInTree[intervalName, list.first];
ENDLOOP;
};
ZeroInterval: INTERNAL PROC [interval: IntervalInContext] = {
interval.starts ¬ 0;
interval.stops ¬ 0;
interval.prematureStops ¬ 0;
interval.prematureStopName ¬ NIL;
interval.startTime ¬ 0;
interval.totalTime ¬ 0;
interval.maxTime ¬ 0;
interval.minTime ¬ LAST[LONG CARDINAL]
};
Testing performance.
codeTimerOn: BOOL ¬ FALSE;
noteThreads: BOOL ¬ TRUE;
FindChildIntervalInContext: PROC [intervalName: ATOM, context: IntervalInContext] RETURNS [interval: IntervalInContext ¬ NIL] = {
FOR list: LIST OF IntervalInContext ¬ context.children, list.rest UNTIL list = NIL DO
IF list.first.name = intervalName THEN RETURN[list.first];
ENDLOOP;
};
defaultProcess: PROCESS;
GetPairForProcess: INTERNAL PROC [table: Table] RETURNS [pp: ProcessPair] = {
IF noteThreads THEN {
process: PROCESS ¬ Process.GetCurrent[];
FOR list: LIST OF ProcessPair ¬ table.processes, list.rest UNTIL list = NIL DO
pair: ProcessPair ¬ list.first;
IF pair.process = process THEN RETURN[pair];
ENDLOOP;
pp ¬ AddProcessPair[table, process];
}
ELSE {
IF table.processes = NIL THEN pp ¬ AddProcessPair[table, defaultProcess]
ELSE {
pp ¬ table.processes.first;
};
};
};
AddProcessPair: INTERNAL PROC [table: Table, process: PROCESS] RETURNS [pair: ProcessPair] = {
pair ¬ NEW[ProcessPairObj];
pair.current ¬ pair.outer ¬ AllocateIntervalInternal[$Outer];
pair.process ¬ process;
table.processes ¬ CONS[pair, table.processes];
};
StartInterval: PUBLIC ENTRY PROC [intervalName: ATOM, table: Table] = {
We have encountered the beginning of a new interval. Add a representation for it as a child of the most recently entered active interval.
ENABLE UNWIND => NULL;
interval: IntervalInContext;
current: IntervalInContext;
pair: ProcessPair;
IF NOT codeTimerOn THEN RETURN;
pair ¬ GetPairForProcess[table];
current ¬ pair.current;
interval ¬ FindChildIntervalInContext[intervalName, current];
IF interval = NIL THEN {
interval ¬ AllocateIntervalInternal[intervalName];
current.children ¬ CONS[interval, current.children];
interval.parent ¬ current;
};
interval.starts ¬ interval.starts + 1;
interval.startTime ¬ BasicTime.GetClockPulses[];
pair.current ¬ interval;
};
StartInt: PUBLIC PROC [intervalName: ATOM, tableName: ATOM] = {
table: Table;
IF NOT codeTimerOn THEN RETURN;
table ¬ GetTable[tableName];
IF table = NIL THEN table ¬ CreateTable[tableName];
StartInterval[intervalName, table];
};
StopInterval: PUBLIC ENTRY PROC [intervalName: ATOM, table: Table] = {
ENABLE UNWIND => NULL;
interval: IntervalInContext;
pair: ProcessPair;
stopTime, elapsedTime: BasicTime.Pulses;
IF NOT codeTimerOn THEN RETURN;
stopTime ¬ BasicTime.GetClockPulses[];
pair ¬ GetPairForProcess[table];
interval ¬ pair.current;
IF interval.name = intervalName THEN { -- normal case
The current interval has come to an end.
interval.stops ¬ interval.stops + 1;
elapsedTime ¬ stopTime - interval.startTime;
interval.totalTime ¬ interval.totalTime + elapsedTime;
interval.minTime ¬ IF elapsedTime < interval.minTime THEN elapsedTime ELSE interval.minTime;
IF elapsedTime > interval.maxTime THEN {
interval.maxTime ¬ elapsedTime;
interval.maxIndex ¬ interval.starts;
};
IF interval.parent # NIL THEN pair.current ¬ interval.parent;
}
ELSE { -- encountered a stop while a different interval is active
interval.prematureStops ¬ interval.prematureStops + 1;
IF interval.prematureStops = 1 THEN interval.prematureStopName ¬ intervalName;
};
};
StopInt: PUBLIC PROC [intervalName: ATOM, tableName: ATOM] = {
table: Table;
IF NOT codeTimerOn THEN RETURN;
table ¬ GetTable[tableName];
IF table = NIL THEN table ¬ CreateTable[tableName];
StopInterval[intervalName, table];
};
SetIntMilliseconds: PUBLIC ENTRY PROC [intervalName: ATOM, startTime: CARD32, stopTime: CARD32, tableName: ATOM] = {
This call is equivalent to a StartInt, followed stopTime-startTime later by a StopInt.
period: INT32;
table: Table;
interval: IntervalInContext;
current: IntervalInContext;
pair: ProcessPair;
InnerProc: INTERNAL PROC = { -- workaround for 4.1 C optimizer bug JKF 2/21/90
IF NOT codeTimerOn THEN RETURN;
period ¬ Period[startTime, stopTime];
table ¬ GetTable[tableName];
IF table = NIL THEN table ¬ CreateTable[tableName];
pair ¬ GetPairForProcess[table];
current ¬ pair.current;
interval ¬ FindChildIntervalInContext[intervalName, current];
IF interval = NIL THEN {
interval ¬ AllocateIntervalInternal[intervalName];
current.children ¬ CONS[interval, current.children];
interval.parent ¬ current;
};
IF period > 0 THEN {
posPer: CARD32 ¬ period;
pulses: CARD32 ¬ BasicTime.MicrosecondsToPulses[posPer*1000];
interval.starts ¬ interval.starts + 1;
interval.stops ¬ interval.stops + 1;
interval.totalTime ¬ interval.totalTime + pulses;
interval.minTime ¬ IF pulses < interval.minTime THEN pulses ELSE interval.minTime;
IF pulses > interval.maxTime THEN {
interval.maxTime ¬ pulses;
interval.maxIndex ¬ interval.stops;
};
}
ELSE {
interval.prematureStops ¬ interval.prematureStops + 1;
interval.prematureStopName ¬ $NegativeTimePeriod
};
}; -- InnerProc
InnerProc[];
};
Period: PUBLIC PROC [from, to: CARD32] RETURNS [INT32] ~ { -- in milliseconds
RETURN [LOOPHOLE[to-from]]
};
Printing results.
ForEachTable: PUBLIC PROC [proc: ForEachTableProc] RETURNS [aborted: BOOL ¬ FALSE] = {
Enumerates all of the CodeTimer tables in the current virtual address space. If the proc ever returns done=TRUE, then and only then aborted will be TRUE.
DoForEachTable: RefTab.EachPairAction = {
PROC [key: Key, val: Val] RETURNS [quit: BOOL ← FALSE];
tableName: ATOM ¬ NARROW[key];
table: Table ¬ NARROW[val];
quit ¬ proc[tableName, table];
};
aborted ¬ RefTab.Pairs[gTablesRef, DoForEachTable];
};
ForEachTableProc: TYPE = CodeTimer.ForEachTableProc;
ForEachTableProc: TYPE = PROC [table: Table] RETURNS [done: BOOL ← FALSE];
ForEachIntervalInContext: PUBLIC PROC [table: Table, proc: ForEachIntervalInContextProc] RETURNS [aborted: BOOL ¬ FALSE] = {
Walks the tree of intervals. The first level of this tree consists of those intervals that were called when no other intervals were active. The children of each interval are the intervals that were called while that interval was active. Thus, each named code interval may appear several times in the tree, once for each interval that called it. Each appearance is called an interval-in-context
processCount: CARD ¬ 0;
IF table = NIL THEN RETURN;
FOR lp: LIST OF ProcessPair ¬ table.processes, lp.rest UNTIL lp = NIL DO
pair: ProcessPair ¬ lp.first;
FOR list: LIST OF IntervalInContext ¬ pair.outer.children, list.rest UNTIL list = NIL DO
aborted ¬ WalkInterval[processCount, list.first, proc, 0];
IF aborted THEN RETURN;
ENDLOOP;
processCount ¬ processCount + 1;
ENDLOOP;
};
ForEachIntervalInContextProc: TYPE = CodeTimer.ForEachIntervalInContextProc;
ForEachIntervalInContextProc: TYPE = PROC [intervalName: ATOM, process: CARD, starts, totalMsec, minMsec, maxMsec, maxIndex, startsWithoutStops: CARD, level: NAT ← 0] RETURNS [done: BOOL ← FALSE];
WalkInterval: PROC [process: CARD, interval: IntervalInContext, proc: ForEachIntervalInContextProc, level: CARD] RETURNS [aborted: BOOL ¬ FALSE] = {
totalMsec, minMsec, maxMsec: CARD;
totalMsec ¬ BasicTime.PulsesToMicroseconds[interval.totalTime]/1000;
minMsec ¬ BasicTime.PulsesToMicroseconds[interval.minTime]/1000;
maxMsec ¬ BasicTime.PulsesToMicroseconds[interval.maxTime]/1000;
aborted ¬ proc[interval.name, process, interval.starts, totalMsec, minMsec, maxMsec, interval.maxIndex, interval.prematureStops, level];
IF aborted THEN RETURN;
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
aborted ¬ WalkInterval[process, list.first, proc, level+1];
IF aborted THEN RETURN;
ENDLOOP;
};
PrintTable: PUBLIC PROC [f: IO.STREAM, table: Table] = {
DoPrintIntervalInContext: ForEachIntervalInContextProc = {
PROC [intervalName: ATOM, process: CARD, starts, totalMsec, minMsec, maxMsec, maxIndex, startsWithoutStops: CARD, level: NAT ← 0] RETURNS [done: BOOL ← FALSE];
IF starts # 0 THEN {
avgMsec: CARD;
FOR i: NAT IN [1..level] DO f.PutRope[" "]; ENDLOOP; -- indent
f.PutFL["%g.%g. n: %g. total: %g. ",
LIST[ [cardinal[process]], [atom[intervalName]], [integer[starts]], [integer[totalMsec]]] ];
avgMsec ¬ totalMsec/starts;
IF startsWithoutStops > 0 THEN
f.PutFL["avg: %g. range: [%g..%g], worst: %g, errs: %g\n",
LIST[ [integer[avgMsec]], [integer[minMsec]], [integer[maxMsec]], [integer[maxIndex]], [integer[startsWithoutStops]]] ]
ELSE
f.PutFL["avg: %g. range: [%g..%g], worst: %g\n",
LIST[ [integer[avgMsec]], [integer[minMsec]], [integer[maxMsec]], [integer[maxIndex]]] ];
};
};
IF table = NIL THEN RETURN;
[] ¬ ForEachIntervalInContext[table, DoPrintIntervalInContext];
};
PrintIntervalInContext: PROC [f: IO.STREAM, process: CARD, interval: IntervalInContext, nestingLevel: NAT ¬ 0, children: BOOL ¬ FALSE] = {
name: Rope.ROPE;
totalTime, avgTime, minTime, maxTime: LONG CARDINAL;
IF interval.starts # 0 THEN {
FOR i: NAT IN [1..nestingLevel] DO f.PutRope[" "]; ENDLOOP; -- indent
name ¬ Atom.GetPName[interval.name];
totalTime ¬ BasicTime.PulsesToMicroseconds[interval.totalTime]/1000;
f.PutFL["%g.%g. n: %g. total: %g. ",
LIST[ [cardinal[process]], [rope[name]], [integer[interval.starts]], [integer[totalTime]]]];
avgTime ¬ totalTime/interval.starts;
minTime ¬ BasicTime.PulsesToMicroseconds[interval.minTime]/1000;
maxTime ¬ BasicTime.PulsesToMicroseconds[interval.maxTime]/1000;
IF interval.prematureStops > 0 THEN
f.PutFL["avg: %g. range: [%g..%g], worst: %g, errs: %g",
LIST[ [integer[avgTime]], [integer[minTime]], [integer[maxTime]], [integer[interval.maxIndex]], [integer[interval.prematureStops]]] ]
ELSE
f.PutFL["avg: %g. range: [%g..%g], worst: %g",
LIST[ [integer[avgTime]], [integer[minTime]], [integer[maxTime]], [integer[interval.maxIndex]]] ];
IF interval.starts > interval.stops THEN
f.PutF1[", %g extra starts", [integer[interval.starts - interval.stops]] ];
f.PutRope["\n"];
IF children THEN {
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
PrintIntervalInContext[f, process, list.first, nestingLevel+1, children];
ENDLOOP;
};
};
};
PrintInterval: PUBLIC PROC [f: IO.STREAM, intervalName: ATOM, table: Table, nestingLevel: NAT ¬ 0] = {
Like PrintTable, but prints only that subset of the tree that contains the interval in question.
IF table # NIL THEN {
processCount: CARD ¬ 0;
FOR lp: LIST OF ProcessPair ¬ table.processes, lp.rest UNTIL lp = NIL DO
pair: ProcessPair ¬ lp.first;
FOR list: LIST OF IntervalInContext ¬ pair.outer.children, list.rest UNTIL list = NIL DO
PrintPartsContaining[f, processCount, intervalName, list.first, nestingLevel];
ENDLOOP;
processCount ¬ processCount + 1;
ENDLOOP;
};
};
PrintInt: PUBLIC PROC [f: IO.STREAM, intervalName: ATOM, tableName: ATOM, nestingLevel: NAT ¬ 0] = {
Like PrintInterval but the table is specified by name.
table: Table ¬ GetTable[tableName];
IF table # NIL THEN PrintInterval[f, intervalName, table, nestingLevel];
};
PrintPartsContaining: PROC [f: IO.STREAM, process: CARD, intervalName: ATOM, interval: IntervalInContext, nestingLevel: NAT ¬ 0] = {
IF interval.name = intervalName THEN PrintIntervalInContext[f, process, interval, nestingLevel, TRUE]
ELSE IF ContainsNamedInterval[intervalName, interval] THEN {
PrintIntervalInContext[f, process, interval, nestingLevel, FALSE];
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
PrintPartsContaining[f, process, intervalName, list.first, nestingLevel + 1];
ENDLOOP;
};
};
ContainsNamedInterval: PROC [intervalName: ATOM, tree: IntervalInContext] RETURNS [BOOL] = {
IF tree.name = intervalName THEN RETURN[TRUE];
FOR list: LIST OF IntervalInContext ¬ tree.children, list.rest UNTIL list = NIL DO
IF ContainsNamedInterval[intervalName, list.first] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
IntervalStatistics: TYPE = REF IntervalStatisticsObj;
IntervalStatisticsObj: TYPE = CodeTimer.IntervalStatisticsObj;
GetIntervalTotals: PUBLIC PROC [intervalName: ATOM, table: Table] RETURNS [starts, totalMsec, averageMsec, minMsec, maxMsec, maxIndex, startsWithoutStops: CARD ¬ 0] = {
Returns the total statistics for an interval (totaled over all of the contexts in which it was encountered).
totalPulse, minPulse, maxPulse: CARD;
starts1, totalPulse1, minPulse1, maxPulse1, maxIndex1, prematureStops1: CARD;
IF table = NIL THEN RETURN;
totalPulse ¬ 0;
minPulse ¬ LAST[CARD];
maxPulse ¬ 0;
FOR list: LIST OF ProcessPair ¬ table.processes, list.rest UNTIL list = NIL DO
pair: ProcessPair ¬ list.first;
[starts1, totalPulse1, minPulse1, maxPulse1, maxIndex1, prematureStops1] ¬ NamedIntervalTotals[intervalName, pair.outer];
IF starts1 > 0 THEN {
starts ¬ starts + starts1;
totalPulse ¬ totalPulse + totalPulse1;
IF minPulse1 < minPulse THEN minPulse ¬ minPulse1;
IF maxPulse1 > maxPulse THEN {
maxPulse ¬ maxPulse1;
maxIndex ¬ maxIndex1;
};
startsWithoutStops ¬ startsWithoutStops + prematureStops1;
};
ENDLOOP;
IF starts = 0 THEN RETURN; -- to avoid divide by 0 below
totalMsec ¬ BasicTime.PulsesToMicroseconds[totalPulse]/1000;
averageMsec ¬ totalMsec/starts;
minMsec ¬ BasicTime.PulsesToMicroseconds[minPulse]/1000;
maxMsec ¬ BasicTime.PulsesToMicroseconds[maxPulse]/1000;
};
GetIntervalStats: PUBLIC PROC [intervalName: ATOM, table: Table] RETURNS [stats: LIST OF IntervalStatistics] = {
Returns the statistics individually for each context in which the interval was encountered.
IF table = NIL THEN RETURN;
FOR lp: LIST OF ProcessPair ¬ table.processes, lp.rest UNTIL lp = NIL DO
pair: ProcessPair ¬ lp.first;
theseStats: LIST OF IntervalStatistics ¬ NamedIntervalStats[intervalName, pair.outer];
stats ¬ AppendStatList[theseStats, stats];
ENDLOOP;
};
NamedIntervalTotals: PROC [intervalName: ATOM, interval: IntervalInContext] RETURNS [starts, totalPulse, minPulse, maxPulse, maxIndex, prematureStops: CARD] = {
starts1, totalPulse1, minPulse1, maxPulse1, maxIndex1, prematureStops1: CARD;
starts ¬ totalPulse ¬ maxPulse ¬ maxIndex ¬ prematureStops ¬ 0;
minPulse ¬ LAST[CARD];
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
[starts1, totalPulse1, minPulse1, maxPulse1, maxIndex1, prematureStops1] ¬ NamedIntervalTotals[intervalName, list.first];
IF starts1 > 0 THEN {
starts ¬ starts + starts1;
totalPulse ¬ totalPulse + totalPulse1;
IF minPulse1 < minPulse THEN minPulse ¬ minPulse1;
IF maxPulse1 > maxPulse THEN {
maxPulse ¬ maxPulse1;
maxIndex ¬ maxIndex1;
};
prematureStops ¬ prematureStops + prematureStops1;
};
ENDLOOP;
IF interval.name = intervalName THEN {
IF interval.starts > 0 THEN {
starts ¬ starts + interval.starts;
totalPulse ¬ totalPulse + interval.totalTime;
IF interval.minTime < minPulse THEN minPulse ¬ interval.minTime;
IF interval.maxTime > maxPulse THEN {
maxPulse ¬ interval.maxTime;
maxIndex ¬ interval.maxIndex;
};
prematureStops ¬ prematureStops + interval.prematureStops;
};
};
};
AddAtom: PROC [entity: ATOM, entityList, ptr: LIST OF ATOM] RETURNS [newList, newPtr: LIST OF ATOM] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
AddStats: PROC [entity: IntervalStatistics, entityList, ptr: LIST OF IntervalStatistics] RETURNS [newList, newPtr: LIST OF IntervalStatistics] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
AppendStatList: PROC [list1, list2: LIST OF IntervalStatistics] RETURNS [result: LIST OF IntervalStatistics] = {
pos: LIST OF IntervalStatistics;
newCell: LIST OF IntervalStatistics;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ¬ CONS[list1.first, NIL];
pos ¬ result;
FOR l: LIST OF IntervalStatistics ¬ list1.rest, l.rest UNTIL l = NIL DO
newCell ¬ CONS[l.first, NIL];
pos.rest ¬ newCell;
pos ¬ newCell;
ENDLOOP;
pos.rest ¬ list2;
};
NamedIntervalStats: PROC [intervalName: ATOM, interval: IntervalInContext] RETURNS [stats: LIST OF IntervalStatistics] = {
statTail, childStats: LIST OF IntervalStatistics;
IF interval.name = intervalName THEN {
IF interval.starts > 0 THEN {
tail: LIST OF ATOM;
parent: IntervalInContext;
theseStats: IntervalStatistics;
theseStats ¬ NEW[CodeTimer.IntervalStatisticsObj];
theseStats.process ¬ 0; -- for now
parent ¬ interval.parent;
UNTIL parent.parent = NIL DO
[theseStats.context, tail] ¬ AddAtom[parent.name, theseStats.context, tail];
parent ¬ parent.parent;
ENDLOOP;
theseStats.starts ¬ interval.starts;
theseStats.totalMsec ¬ BasicTime.PulsesToMicroseconds[interval.totalTime]/1000;
theseStats.minMsec ¬ BasicTime.PulsesToMicroseconds[interval.minTime]/1000;
theseStats.maxMsec ¬ BasicTime.PulsesToMicroseconds[interval.maxTime]/1000;
theseStats.maxIndex ¬ interval.maxIndex;
theseStats.startsWithoutStops ¬ interval.prematureStops;
[stats, statTail] ¬ AddStats[theseStats, stats, statTail];
};
};
FOR list: LIST OF IntervalInContext ¬ interval.children, list.rest UNTIL list = NIL DO
childStats ¬ NamedIntervalStats[intervalName, list.first];
stats ¬ AppendStatList[stats, childStats];
ENDLOOP;
};
CodeTimerNoteThreadsOn: Commander.CommandProc = {
noteThreads ¬ TRUE;
};
CodeTimerNoteThreadsOff: Commander.CommandProc = {
noteThreads ¬ FALSE;
};
CodeTimerOn: Commander.CommandProc = {
codeTimerOn ¬ TRUE;
};
CodeTimerOff: Commander.CommandProc = {
codeTimerOn ¬ FALSE;
};
TimerOn: PUBLIC PROC = {
codeTimerOn ¬ TRUE;
};
TimerOff: PUBLIC PROC = {
codeTimerOn ¬ FALSE;
};
PrintCodeTimes: Commander.CommandProc = {
nameStream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
name: Rope.ROPE;
atom: ATOM;
table: Table;
IF cmd.commandLine = "" THEN RETURN[$Failure, "Please specify a table name"];
[] ¬ IO.SkipWhitespace[nameStream];
name ¬ IO.GetLineRope[nameStream];
atom ¬ Atom.MakeAtom[name];
table ¬ GetTable[atom];
IF table # NIL THEN PrintTable[cmd.out, table]
ELSE cmd.out.PutRope["No such table.\n"];
};
ResetCodeTimes: Commander.CommandProc = {
nameStream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
name: Rope.ROPE;
atom: ATOM;
table: Table;
IF cmd.commandLine = "" THEN RETURN[$Failure, "Please specify a table name"];
[] ¬ IO.SkipWhitespace[nameStream];
name ¬ IO.GetLineRope[nameStream];
atom ¬ Atom.MakeAtom[name];
table ¬ GetTable[atom];
IF table # NIL THEN ResetTable[table]
ELSE cmd.out.PutF1["I don't (yet) know of a table named %g.\n", [atom[atom]]];
};
PrintIntervalTimes: Commander.CommandProc = {
nameStream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
name: Rope.ROPE;
tableName, intervalName: ATOM;
table: Table;
IF cmd.commandLine = "" THEN RETURN[$Failure, "Please specify a table name"];
[] ¬ IO.SkipWhitespace[nameStream];
name ¬ IO.GetTokenRope[nameStream].token;
intervalName ¬ Atom.MakeAtom[name];
name ¬ IO.GetTokenRope[nameStream].token;
tableName ¬ Atom.MakeAtom[name];
table ¬ GetTable[tableName];
IF table # NIL THEN PrintInterval[cmd.out, intervalName, table]
ELSE cmd.out.PutF1["I don't (yet) know of a table named %g.\n", [atom[tableName]]];
};
PrintIntervalTotals: Commander.CommandProc = {
nameStream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
tableRope, intervalRope: Rope.ROPE;
tableName, intervalName: ATOM;
table: Table;
IF cmd.commandLine = "" THEN RETURN[$Failure, "Please specify a table name"];
[] ¬ IO.SkipWhitespace[nameStream];
intervalRope ¬ IO.GetTokenRope[nameStream].token;
intervalName ¬ Atom.MakeAtom[intervalRope];
tableRope ¬ IO.GetTokenRope[nameStream].token;
tableName ¬ Atom.MakeAtom[tableRope];
table ¬ GetTable[tableName];
IF table # NIL THEN {
starts, totalMsec, averageMsec, minMsec, maxMsec, maxIndex, prematureStops: CARD;
[starts, totalMsec, averageMsec, minMsec, maxMsec, maxIndex, prematureStops] ¬ GetIntervalTotals[intervalName, table];
cmd.out.PutF["%g. n: %g. total: %g. ", [rope[intervalRope]], [integer[starts]], [integer[totalMsec]]];
IF prematureStops > 0 THEN
cmd.out.PutFL["avg: %g. range: [%g..%g], worst: %g, errs: %g\n",
LIST[ [integer[averageMsec]], [integer[minMsec]], [integer[maxMsec]], [integer[maxIndex]], [integer[prematureStops]]] ]
ELSE
cmd.out.PutFL["avg: %g. range: [%g..%g], worst: %g\n",
LIST[ [integer[averageMsec]], [integer[minMsec]], [integer[maxMsec]], [integer[maxIndex]]] ];
}
ELSE cmd.out.PutF1["I don't (yet) know of a table named %g.\n", [atom[tableName]]];
};
ResetIntervalTimes: Commander.CommandProc = {
nameStream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
name: Rope.ROPE;
tableName, intervalName: ATOM;
table: Table;
IF cmd.commandLine = "" THEN RETURN[$Failure, "Please specify a table name"];
[] ¬ IO.SkipWhitespace[nameStream];
name ¬ IO.GetTokenRope[nameStream].token;
intervalName ¬ Atom.MakeAtom[name];
name ¬ IO.GetTokenRope[nameStream].token;
tableName ¬ Atom.MakeAtom[name];
table ¬ GetTable[tableName];
IF table # NIL THEN ResetInterval[intervalName, table]
ELSE cmd.out.PutF1["I don't (yet) know of a table named %g.\n", [atom[tableName]]];
};
PrintCodeTimeTables: Commander.CommandProc = {
PrintTableName: CodeTimer.ForEachTableProc = {
PROC [tableName: ATOM, table: Table] RETURNS [done: BOOL ← FALSE];
cmd.out.PutF1["\n %g", [atom[tableName]] ];
};
[] ¬ ForEachTable[PrintTableName];
cmd.out.PutRope["\n"];
};
Command Registration
Init: PROC [] = {
gTablesRef ¬ RefTab.Create[7];
defaultProcess ¬ Process.GetCurrent[];
Commander.Register["PrintCodeTimes", PrintCodeTimes, "PrintCodeTimes <tablename> -- prints out the minimum, maximum, and average times taken to execute the marked code blocks in the table named in the first argument"];
Commander.Register["ResetCodeTimes", ResetCodeTimes, "ResetCodeTimes <tablename> -- zeros the code times for all of the intervals in this table"];
Commander.Register["PrintCodeTimeTables", PrintCodeTimeTables, "Prints out all code time tables that CodeTimer currently knows about"];
Commander.Register["PrintIntervalTimes", PrintIntervalTimes, "PrintIntervalTime <intervalname> <tablename> -- prints out the minimum, maximum, and average times taken to execute the named interval (in each context in which in appears) and its children"];
Commander.Register["PrintIntervalTotals", PrintIntervalTotals, "PrintIntervalTotals <intervalname> <tablename> -- prints out the minimum, maximum, and average times taken to execute the named interval (totaled over all contexts in which it appears)"];
Commander.Register["ResetIntervalTimes", ResetIntervalTimes, "ResetIntervalTimes <intervalname> <tablename> -- zeros the code times for the named interval in the named table"];
Commander.Register["codeTimerOn", CodeTimerOn, "Causes CodeTimer to begin timing code intervals that have been marked with StartInt and StopInt calls (use CodeTimerTool to view the results)"];
Commander.Register["codeTimerOff", CodeTimerOff, "Causes CodeTimer to stop timing code intervals that have been marked with StartInt and StopInt calls (use CodeTimerTool to view the results)"];
Commander.Register["codeTimerNoteThreadsOn", CodeTimerNoteThreadsOn, "Causes CodeTimer to distinguish calls to the same interval by different threads"];
Commander.Register["codeTimerNoteThreadsOff", CodeTimerNoteThreadsOff, "Causes CodeTimer to treat calls to an interval identically regardless of which thread makes the call (this is the default)"];
};
Test: PROC [] = {
FOR i: NAT IN [1..9] DO
StartInt[$LoopOnI, $CodeTimer];
Process.PauseMsec[100];
StartInt[$InnerBlock, $CodeTimer];
Process.PauseMsec[53];
StartInt[$InnermostBlock, $CodeTimer];
StopInt[$InnermostBlock, $CodeTimer];
StopInt[$InnerBlock, $CodeTimer];
StartInt[$AnotherBlock, $CodeTimer];
StartInt[$InnermostBlock, $CodeTimer];
Process.PauseMsec[20];
StopInt[$InnermostBlock, $CodeTimer];
StopInt[$AnotherBlock, $CodeTimer];
StopInt[$LoopOnI, $CodeTimer];
ENDLOOP;
};
Init[];
END.