LeafySampleCommand.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) December 27, 1991 3:29 pm PST
DIRECTORY
Basics, BasicTime, Commander, CommanderOps, DeltaResource, IO, List, Process, RefText, Rope;
LeafySampleCommand: CEDAR MONITOR
IMPORTS BasicTime, Commander, CommanderOps, DeltaResource, IO, List, Process, RefText, Rope
= BEGIN
Global variables & interesting constants
dumpRequest: CONDITION;
dumpFinish: CONDITION;
dumpWanted: BOOL ¬ FALSE;
dumpBusy: BOOL ¬ FALSE;
registry: Registration ¬ NIL;
freeSamples: AcceptSamplesInstance ¬ NIL;
specialRegistration: Registration ¬ NIL;
resourceActivity: ResourceActivity ¬ NIL;
defaultModCutoff: REAL ¬ 1.0;
defaultProcCutoffRatio: REAL ¬ 0.10;
maxEntries: INT = 20*100;
At current rates, this gives us enough space for at least 20 seconds of samples
dumpRequestMillis: NAT = (maxEntries*10)/4;
This allows us up to four intervals to transfer the samples
maxAcceptSamples: INT = maxEntries/2;
maxValidSize: CARDINAL ¬ 1000000;
Arbitrary validity bound on module text sizes
Types
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
CharPtr: TYPE = POINTER TO Basics.RawChars;
Equivalent to Unix (char *), but be careful about alignment
TimeVal: TYPE = DeltaResource.TimeVal;
RUsage: TYPE = DeltaResource.RUsage;
Stats: TYPE = DeltaResource.Stats;
ILSymEntry: TYPE = POINTER;
Registration: TYPE = LIST OF RegistrationEntry;
RegistrationEntry: TYPE = RECORD [
state: RegistrationState,
proc: EnumSamplesProc,
data: REF];
RegistrationState: TYPE = {waitingActive, active, waitingDead, dead};
EnumSamplesProc: TYPE = PROC [pc: WORD, count: CARDINAL, data: REF];
Callback proc type.
masterProfile: ProfileBuffer ¬ NIL;
globalGen: INT ¬ 0;
ProfileEntryList: TYPE = LIST OF RefProfileEntry;
RefProfileEntry: TYPE = REF ProfileEntry;
ProfileEntry: TYPE = RECORD [
count: CARDINAL,
pc: WORD
];
ProfileBuffer: TYPE = POINTER TO ProfileBufferRep;
ProfileBufferRep: TYPE = RECORD [
nEntries: INT,
offset: INT,
entries: ARRAY [0..maxEntries] OF ProfileEntry];
AcceptSamplesInstance: TYPE = REF AcceptSamplesInstanceRep;
AcceptSamplesInstanceRep: TYPE = RECORD [
link: AcceptSamplesInstance ¬ NIL,
nextIndex: [0..maxAcceptSamples] ¬ 0,
samples: ARRAY [0..maxAcceptSamples) OF ProfileEntry
];
LoadStateList: TYPE = LIST OF LoadStateEntry;
LoadStateEntry: TYPE = REF LoadStateEntryRep;
LoadStateEntryRep: TYPE = RECORD [
ilse: ILSymEntry ¬ NIL,
pc: WORD,
size: CARDINAL];
VisitModules: TYPE = PROC
[ilse: ILSymEntry, name: CharPtr, nameOK: BOOL,
pc: WORD, size: CARDINAL, type: WORD, list: ProcEntryList ¬ NIL]
RETURNS [continue: BOOL ¬ TRUE];
ProcEntryList: TYPE = LIST OF ProcEntry;
ProcEntry: TYPE = REF ProcEntryRep;
ProcEntryRep: TYPE = RECORD [
ilse: ILSymEntry,
count: WORD
];
ModuleEntryList: TYPE = LIST OF ModuleEntry;
ModuleEntry: TYPE = REF ModuleEntryRep;
ModuleEntryRep: TYPE = RECORD [
ilse: ILSymEntry,
name: CharPtr, nameOK: BOOL,
pc: WORD, size: CARDINAL, type: WORD,
count: CARDINAL,
procs: ProcEntryList
];
SwitchArray: TYPE = PACKED ARRAY SwitchIndex OF BOOL;
SwitchIndex: TYPE = CHAR ['a..'z];
ResourceActivity: TYPE = REF ResourceActivityRep;
ResourceActivityRep: TYPE = RECORD [
reg: Registration,
state: ResourceActivityState,
line: ROPE,
changed: CONDITION,
stats: Stats
];
ResourceActivityState: TYPE = {starting, active, stopping, done, error};
C access procedures
DoIncludes: PROC = TRUSTED MACHINE CODE {
"*";
"#include <xr/BasicTypes.h>\n";
"#include <xr/IncrementalLoad.h>\n";
"#include <xr/UIO.h>\n";
"."
};
LocalStartProfile: UNSAFE PROC [p: ProfileBuffer, size: INT] RETURNS [INT]
~ UNCHECKED MACHINE CODE {
"+static word LocalStartProfil (p, s) ptr p; word s; {\n";
" return (profil(p, s+1, 0, 2));\n";
NOTE: should be changed when PCR is fixed to:
" return (XR←Profil(p, s+1, 0, 2));\n";
" };\n";
".LocalStartProfil";
};
LocalStopProfile: UNSAFE PROC [p: ProfileBuffer] ~ UNCHECKED MACHINE CODE {
"+static void LocalStopProfil (p) ptr p; {\n";
" (void) profil(p, 0, 0, 0);\n";
NOTE: should be changed when PCR is fixed to:
" (void) XR←Profil(p, 0, 0, 0);\n";
" };\n";
".LocalStopProfil";
};
LocalNextModule: PROC [last: ILSymEntry] RETURNS [ILSymEntry]
= TRUSTED MACHINE CODE {
"+static word LocalNextModule (last) word last; {\n";
" int skip = 1;\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) last);\n";
" word flags = ILSE←MODULE;\n";
" word ignore = IGNORE←NONE;\n";
" if (last == 0) skip = 0;\n";
" ilse = XR←ILGetMatchingSymEntryByValue(ilse, 0, flags, ignore, skip);\n";
" return ((word) ilse);\n";
" };\n";
".LocalNextModule";
};
LocalNextEntry: PROC [last: ILSymEntry] RETURNS [ILSymEntry]
= TRUSTED MACHINE CODE {
"+static word LocalNextEntry (last) word last; {\n";
" int skip = 1;\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) last);\n";
" word flags = -1;\n";
" word ignore = IGNORE←NONE;\n";
" if (last == 0) skip = 0;\n";
" ilse = XR←ILGetMatchingSymEntryByValue(ilse, 0, flags, ignore, skip);\n";
" return ((word) ilse);\n";
" };\n";
".LocalNextEntry";
};
ValueFromILSymEntry: PROC [ilse: ILSymEntry] RETURNS [WORD]
= TRUSTED MACHINE CODE {
"+static word ValueFromILSymEntry (p) word p; {\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) p);\n";
" return (ilse->ilse←value);\n";
" };\n";
".ValueFromILSymEntry";
};
TypeFromILSymEntry: PROC [ilse: ILSymEntry] RETURNS [WORD]
= TRUSTED MACHINE CODE {
"+static word TypeFromILSymEntry (p) word p; {\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) p);\n";
" return (ilse->ilse←type);\n";
" };\n";
".TypeFromILSymEntry";
};
SizeFromILSymEntry: PROC [ilse: ILSymEntry] RETURNS [WORD]
= TRUSTED MACHINE CODE {
"+static word SizeFromILSymEntry (p) word p; {\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) p);\n";
" return (ilse->ilse←size);\n";
" };\n";
".SizeFromILSymEntry";
};
SymbolNameFromILSymEntry: PROC [ilse: ILSymEntry] RETURNS [CharPtr]
= TRUSTED MACHINE CODE {
"+static word SymbolNameFromILSymEntry (p) word p; {\n";
" XR←ILSymEntry ilse = ((XR←ILSymEntry) p);\n";
" if (ilse == NIL) return (0);\n";
" return ((word) ilse->ilse←name);\n";
" };\n";
".SymbolNameFromILSymEntry";
};
Command procedures
LeafyCommand: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
out: STREAM = cmd.out;
modCutoff: REAL ¬ defaultModCutoff;
procCutoff: REAL ¬ 0.0;
line: ROPE ¬ cmd.commandLine;
switches: SwitchArray ¬ ALL[FALSE];
debug: BOOL ¬ FALSE;
DO
SELECT TRUE FROM
Rope.Match[" *", line] => line ¬ Rope.Substr[line, 1];
Rope.Match["-*", line] => {
pos: INT = Rope.SkipTo[line, 1, " "];
arg: ROPE = Rope.Substr[line, 0, pos];
switches ¬ GetSwitches[arg, switches];
debug ¬ switches['d];
IF switches['v] THEN modCutoff ¬ defaultModCutoff * 0.5;
IF switches['a] THEN modCutoff ¬ 0.0;
line ¬ Rope.Substr[line, MAX[Rope.Length[line], pos+1]];
};
ENDCASE => EXIT;
ENDLOOP;
procCutoff ¬ modCutoff * defaultProcCutoffRatio;
SELECT cmd.procData.clientData FROM
$Start => {
act: ResourceActivity = StartResourceWatcher[line];
msg ¬ "Leafy sampling already running.";
IF act # NIL THEN {
msg ¬ "Leafy sampling started.";
IF act.state = error THEN msg ¬ "-- OOPS! Resource watcher not started!";
};
};
$Stop => {
act: ResourceActivity = StopResourceWatcher[];
msg ¬ "Leafy sampling not running.";
IF act # NIL THEN {
old: Registration = act.reg;
WITH old.first.data SELECT FROM
asd: AcceptSamplesInstance =>
OutputFromSamples[out, asd, act.stats, act.line, modCutoff, procCutoff, debug];
ENDCASE;
msg ¬ NIL;
};
};
$Leafy => {
asd: AcceptSamplesInstance = AllocSamples[];
reg: Registration = StartProfiling[AcceptSamples, asd];
aborted: BOOL ¬ FALSE;
IF reg = NIL
THEN {
msg ¬ "Could not start profiling!";
FreeSamples[asd];
GO TO oops;
}
ELSE {
inner: PROC = {
result ¬ CommanderOps.DoCommand[commandLine: line, parent: cmd];
};
stats: Stats = DeltaResource.TakeDelta[inner
! UNWIND => StopProfiling[reg]; ABORTED => GO TO abort
];
StopProfiling[reg];
OutputFromSamples[out, asd, stats, line, modCutoff, procCutoff, debug];
EXITS abort => {StopProfiling[reg]; aborted ¬ TRUE};
};
IF aborted THEN ERROR ABORTED;
};
ENDCASE => ERROR;
EXITS oops => result ¬ $Failure;
};
ShowSymsInModuleCommand: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
out: STREAM = cmd.out;
argv: CommanderOps.ArgumentVector = CommanderOps.Parse[cmd
! CommanderOps.Failed => {msg ¬ errorMsg; GO TO oops}];
scratch: REF TEXT ¬ RefText.ObtainScratch[60];
FOR i: NAT IN [1..argv.argc) DO
arg: ROPE = argv[i];
text: REF TEXT ¬ RefText.ObtainScratch[Rope.Length[arg]+1];
text ¬ RefText.AppendRope[text, arg];
TRUSTED {
ptr: CharPtr ¬ LOOPHOLE[text, CharPtr] + SIZE[TEXT[0]];
last: ILSymEntry ¬ NIL;
DO
ilse: ILSymEntry ¬ LocalNextModule[last];
IF ilse = NIL
THEN {
IF last = NIL THEN IO.PutF1[out, "No matches for %g\n", [rope[arg]]];
EXIT;
}
ELSE {
name: CharPtr = SymbolNameFromILSymEntry[ilse];
modType: WORD = TypeFromILSymEntry[ilse];
scratch.length ¬ 0;
scratch ¬ AppendCharStar[scratch, name, '., '←];
IF RefText.Match[text, scratch, FALSE] THEN
DO
name: CharPtr ¬ SymbolNameFromILSymEntry[ilse];
PutCharStar[out, name];
IO.PutF1[out, " => val: %g", [cardinal[ValueFromILSymEntry[ilse]]] ];
IF SizeFromILSymEntry[ilse] # 0 THEN
IO.PutF1[out, ", size: %g", [cardinal[SizeFromILSymEntry[ilse]]] ];
IO.PutF1[out, ", type: %g\n", [cardinal[TypeFromILSymEntry[ilse]]] ];
ilse ¬ LocalNextEntry[ilse];
IF ilse = NIL THEN EXIT;
IF TypeFromILSymEntry[ilse] = modType THEN EXIT;
IO.PutRope[out, " "];
ENDLOOP;
};
last ¬ ilse;
ENDLOOP;
};
RefText.ReleaseScratch[text];
ENDLOOP;
RefText.ReleaseScratch[scratch];
EXITS oops => result ¬ $Failure;
};
ShowModulesCommand: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
argv: CommanderOps.ArgumentVector = CommanderOps.Parse[cmd
! CommanderOps.Failed => {msg ¬ errorMsg; GO TO oops}];
out: STREAM = cmd.out;
switches: SwitchArray ¬ ALL[FALSE];
scratch: REF TEXT ¬ RefText.ObtainScratch[60];
FOR i: NAT IN [1..argv.argc) DO
arg: ROPE = argv[i];
text: REF TEXT ¬ RefText.ObtainScratch[Rope.Length[arg]+1];
text ¬ RefText.AppendRope[text, arg];
IF Rope.Match["-*", arg]
THEN switches ¬ GetSwitches[arg, switches]
ELSE {
noFilter: BOOL = switches['a];
each: VisitModules = TRUSTED {
scratch.length ¬ 0;
scratch ¬ AppendCharStar[scratch, name, '., '←];
IF RefText.Match[text, scratch, FALSE] THEN {
PutCharStar[out, name];
IF NOT nameOK THEN IO.PutChar[out, '?];
IO.PutF1[out, " => pc: %g", [cardinal[pc]] ];
IO.PutF1[out, ", size: %g\n", [cardinal[size]] ];
};
};
ScanModules[each, noFilter];
};
RefText.ReleaseScratch[text];
ENDLOOP;
RefText.ReleaseScratch[scratch];
EXITS oops => result ¬ $Failure;
};
SpinCommand: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
argv: CommanderOps.ArgumentVector = CommanderOps.Parse[cmd
! CommanderOps.Failed => {msg ¬ errorMsg; GO TO oops}];
out: STREAM = cmd.out;
start: BasicTime.Pulses = BasicTime.GetClockPulses[];
pulses: BasicTime.Pulses ¬ 0;
IF argv.argc # 2 THEN {
msg ¬ "Usage: Spin <seconds>";
RETURN;
};
{
arg: ROPE = argv[1];
seconds: INT ¬ 0;
FOR i: NAT IN [0..Rope.Length[arg]) DO
c: CHAR = Rope.Fetch[arg, i];
SELECT c FROM
IN ['0..'9] => seconds ¬ seconds * 10 + (c - '0);
ENDCASE => {msg ¬ "Illegal syntax for number"; GO TO oops};
IF seconds > LAST[INT]/1000000 THEN {
msg ¬ "Can't spin accurately for that long";
GO TO oops;
};
ENDLOOP;
pulses ¬ BasicTime.MicrosecondsToPulses[seconds*1000000];
};
DO
now: BasicTime.Pulses = BasicTime.GetClockPulses[];
IF BasicTime.Pulses[now-start] >= pulses THEN EXIT;
THROUGH [0..1000) DO Nothing[]; ENDLOOP;
Process.CheckForAbort[];
ENDLOOP;
EXITS oops => result ¬ $Failure;
};
Iteration procedures
ScanModules: PROC [visit: VisitModules, noFilter: BOOL ¬ FALSE] = TRUSTED {
This procedure iterates through the "modules" in the world, calling visit for each valid module. If noFilter = TRUE, then the information is presented exactly as it is in the basic load state as reflected in IncrementalLoad.h. If noFilter = FALSE, then we try to synthesize the information about the modules so that module names and sizes are reasonable.
ilse: ILSymEntry ¬ LocalNextModule[NIL];
lagIlse: ILSymEntry ¬ NIL;
lagName: CharPtr ¬ NIL;
lagNameOK: BOOL ¬ FALSE;
lagPC: WORD ¬ 0;
lagSize: WORD ¬ 0;
lagType: WORD ¬ 0;
DO
IF ilse = NIL
THEN {
IF lagIlse # NIL THEN
[] ¬ visit[lagIlse, lagName, lagNameOK, lagPC, lagSize, lagType];
EXIT;
}
ELSE {
name: CharPtr ¬ SymbolNameFromILSymEntry[ilse];
nameOK: BOOL ¬ MaxNumericCount[name] < 6;
pc: WORD = ValueFromILSymEntry[ilse];
size: WORD ¬ SizeFromILSymEntry[ilse];
type: WORD = TypeFromILSymEntry[ilse];
IF pc < lagPC THEN ERROR;
Alan promised that this would not happen!
IF pc = 0 OR size > maxValidSize THEN size ¬ 0;
This size does not look very nice, so cancel it
SELECT TRUE FROM
lagIlse = NIL => {};
pc # lagPC, noFilter => {
continue: BOOL ¬ visit[lagIlse, lagName, lagNameOK, lagPC, lagSize, lagType];
IF NOT continue THEN EXIT;
};
ENDCASE => {
Same pc, so try to collapse the lagging info and the current info together to come up with a synthesis that has a valid name and a valid size.
IF NOT nameOK THEN {
This name is not OK, so preserve the previous name
name ¬ lagName;
nameOK ¬ lagNameOK;
};
SELECT TRUE FROM
size = 0 => size ¬ lagSize;
lagSize = 0 => {};
size > lagSize => size ¬ lagSize;
ENDCASE;
};
lagName ¬ name;
lagNameOK ¬ nameOK;
lagPC ¬ pc;
lagSize ¬ size;
lagType ¬ type;
};
lagIlse ¬ ilse;
ilse ¬ LocalNextModule[ilse];
ENDLOOP;
};
ModulesFromSamples: PROC
[profList: ProfileEntryList, eachModule: VisitModules, st: STREAM]
RETURNS [bogusList: ProfileEntryList ¬ NIL] ~ {
Note: if st # NIL then debug output goes to st
visitModule: VisitModules = TRUSTED {
lastProcFound: ILSymEntry ¬ NIL;
limit: CARDINAL = pc+size;
procHead: ProcEntryList ¬ NIL;
procTail: ProcEntryList ¬ NIL;
WHILE profList # NIL DO
first: RefProfileEntry ¬ profList.first;
rest: ProfileEntryList = profList.rest;
fpc: WORD = first.pc;
fc: CARDINAL = first.count;
IF rest # NIL AND rest.first.pc = fpc THEN {
Collapse the counts for equal PCs
rest.first.count ¬ rest.first.count + fc;
profList ¬ rest;
LOOP;
};
IF fpc >= limit THEN EXIT;
We are no longer in the right module, so return to get the next one
{
lagIlse: ILSymEntry ¬ ilse;
lagPC: WORD ¬ 0;
IF fpc < pc THEN GO TO bogus;
Add this one to the bogus list
DO
nextIlse: ILSymEntry = LocalNextEntry[lagIlse];
IF nextIlse = lagIlse THEN ERROR;
This should not happen!
IF nextIlse # NIL THEN {
nextPC: WORD = ValueFromILSymEntry[nextIlse];
IF nextPC IN [pc..limit) THEN
IF nextPC <= fpc THEN {lagIlse ¬ nextIlse; lagPC ¬ nextPC; LOOP};
};
EXIT;
ENDLOOP;
IF lagIlse = ilse THEN GO TO bogus;
No containing procedure found!
IF procTail # NIL AND procTail.first.ilse = lagIlse
THEN {
This just adds to the current procedure
entry: ProcEntry = procTail.first;
entry.count ¬ entry.count + fc;
}
ELSE {
entry: ProcEntry = NEW[ProcEntryRep ¬ [lagIlse, fc]];
new: ProcEntryList = LIST[entry];
IF procTail = NIL THEN procHead ¬ new ELSE procTail.rest ¬ new;
procTail ¬ new;
};
EXITS
bogus => {
profList.rest ¬ bogusList;
bogusList ¬ profList;
};
};
profList ¬ rest;
ENDLOOP;
At this point we are going to exit the module, so yield the results for this module. This is true even for modules that have no entries.
procHead ¬ SortProcEntriesByCount[procHead];
RETURN [eachModule[ilse, name, nameOK, pc, size, type, procHead]];
};
ScanModules[visitModule];
WHILE profList # NIL DO
Splice the rest of the profList onto the bogus list
first: RefProfileEntry ¬ profList.first;
rest: ProfileEntryList ¬ profList.rest;
IF rest # NIL AND first.pc = rest.first.pc THEN {
Collapse the counts
rest.first.count ¬ rest.first.count + first.count;
profList ¬ rest;
LOOP;
};
profList.rest ¬ bogusList;
bogusList ¬ profList;
profList ¬ rest;
ENDLOOP;
RETURN [bogusList];
};
Sorting procedures
SortProfileEntries: PROC [list: ProfileEntryList] RETURNS [ProfileEntryList] = TRUSTED {
list ¬ LOOPHOLE[List.Sort[LOOPHOLE[list, List.LORA], CompareProfileEntries]];
RETURN [list];
};
CompareProfileEntries: List.CompareProc = {
WITH ref1 SELECT FROM
ent1: RefProfileEntry =>
WITH ref2 SELECT FROM
ent2: RefProfileEntry => {
SELECT ent1.pc FROM
< ent2.pc => RETURN [less];
> ent2.pc => RETURN [greater];
ENDCASE => RETURN [equal];
};
ENDCASE;
ENDCASE;
ERROR;
};
SortProcEntriesByCount: PROC
[list: ProcEntryList] RETURNS [ProcEntryList] = TRUSTED {
list ¬ LOOPHOLE[List.Sort[LOOPHOLE[list, List.LORA], CompareProcEntriesByCount]];
RETURN [list];
};
CompareProcEntriesByCount: List.CompareProc = {
WITH ref1 SELECT FROM
ent1: ProcEntry =>
WITH ref2 SELECT FROM
ent2: ProcEntry => {
SELECT ent1.count FROM
< ent2.count => RETURN [greater];
> ent2.count => RETURN [less];
ENDCASE => RETURN [equal];
};
ENDCASE;
ENDCASE;
ERROR;
};
SortModuleEntriesByCount: PROC
[list: ModuleEntryList] RETURNS [ModuleEntryList] = TRUSTED {
list ¬ LOOPHOLE[List.Sort[LOOPHOLE[list, List.LORA], CompareModuleEntriesByCount]];
RETURN [list];
};
CompareModuleEntriesByCount: List.CompareProc = {
WITH ref1 SELECT FROM
ent1: ModuleEntry =>
WITH ref2 SELECT FROM
ent2: ModuleEntry => {
SELECT ent1.count FROM
< ent2.count => RETURN [greater];
> ent2.count => RETURN [less];
ENDCASE => RETURN [equal];
};
ENDCASE;
ENDCASE;
ERROR;
};
Unix string procedures
PutCharStar: UNSAFE PROC
[out: STREAM, ptr: CharPtr, stop: CHAR ¬ 0c, skipLead: CHAR ¬ 0c] = UNCHECKED {
i: NAT ¬ LOOPHOLE[ptr, CARDINAL] MOD UNITS[WORD];
base: CharPtr = LOOPHOLE[LOOPHOLE[ptr, CARDINAL] - i, CharPtr];
output: NAT ¬ 0;
IF base # NIL THEN
DO
c: CHAR = base[i];
IF c = 0c THEN EXIT;
IF c = skipLead AND skipLead # 0c AND output = 0 THEN {i ¬ i + 1; LOOP};
IF c = stop THEN EXIT;
IO.PutChar[out, c];
i ¬ i + 1;
output ¬ output + 1;
ENDLOOP;
IF output = 0 THEN IO.PutRope[out, "??"];
};
AppendCharStar: UNSAFE PROC
[text: REF TEXT, ptr: CharPtr, stop: CHAR ¬ 0c, skipLead: CHAR ¬ 0c]
RETURNS [REF TEXT] = UNCHECKED {
i: NAT ¬ LOOPHOLE[ptr, CARDINAL] MOD UNITS[WORD];
base: CharPtr = LOOPHOLE[LOOPHOLE[ptr, CARDINAL] - i, CharPtr];
output: NAT ¬ 0;
IF base # NIL THEN
DO
c: CHAR = base[i];
IF c = 0c THEN EXIT;
IF c = skipLead AND skipLead # 0c AND output = 0 THEN {i ¬ i + 1; LOOP};
IF c = stop THEN EXIT;
text ¬ RefText.AppendChar[text, c];
i ¬ i + 1;
output ¬ output + 1;
ENDLOOP;
RETURN [text];
};
MaxNumericCount: UNSAFE PROC [ptr: CharPtr] RETURNS [NAT] = UNCHECKED {
i: NAT ¬ LOOPHOLE[ptr, CARDINAL] MOD UNITS[WORD];
base: CharPtr = LOOPHOLE[LOOPHOLE[ptr, CARDINAL] - i, CharPtr];
max: NAT ¬ 0;
count: NAT ¬ 0;
IF base # NIL THEN
DO
c: CHAR = base[i];
SELECT c FROM
IN ['0..'9] => {
count ¬ count + 1;
IF count > max THEN max ¬ count;
};
0c => EXIT;
ENDCASE => count ¬ 0;
i ¬ i + 1;
ENDLOOP;
RETURN [max];
};
Sampling procedures
AcceptSamples: EnumSamplesProc = {
WITH data SELECT FROM
asd: AcceptSamplesInstance => IF pc # 0 THEN {
nextIndex: [0..maxAcceptSamples] ¬ asd.nextIndex;
asd.samples[nextIndex] ¬ [pc: pc, count: count];
nextIndex ¬ nextIndex + 1;
asd.nextIndex ¬ nextIndex;
IF nextIndex = maxAcceptSamples-1 THEN {
Make a new bunch of samples
next: AcceptSamplesInstance ¬ AllocSamples[];
next­ ¬ asd­;
asd.link ¬ next;
asd.samples ¬ ALL [ [0, 0] ];
asd.nextIndex ¬ 0;
};
};
ENDCASE;
};
AllocSamples: ENTRY PROC RETURNS [AcceptSamplesInstance] = {
new: AcceptSamplesInstance ¬ freeSamples;
IF new = NIL
THEN new ¬ NEW[AcceptSamplesInstanceRep]
ELSE freeSamples ¬ new.link;
RETURN [new];
};
FreeSamples: ENTRY PROC [asd: AcceptSamplesInstance] = {
WHILE asd # NIL DO
link: AcceptSamplesInstance = asd.link;
asd.link ¬ freeSamples;
freeSamples ¬ asd.link;
asd ¬ link;
ENDLOOP;
};
StartProfiling: ENTRY PROC [proc: EnumSamplesProc, data: REF] RETURNS [Registration] = {
RETURN [StartProfilingInternal[proc, data]];
};
StartProfilingInternal: INTERNAL PROC
[proc: EnumSamplesProc, data: REF] RETURNS [Registration] = {
IF proc # NIL THEN {
new: Registration = CONS [[state: waitingActive, proc: proc, data: data], registry];
registry ¬ new;
IF masterProfile = NIL THEN {
globalGen ¬ globalGen + 1;
Process.Detach[FORK ProfileWatcher[globalGen]];
};
WHILE new.first.state = waitingActive DO
InternalDumpAndWait[];
ENDLOOP;
RETURN [new];
};
RETURN [NIL];
};
StopProfiling: ENTRY PROC [reg: Registration] = {
StopProfilingInternal[reg];
};
StopProfilingInternal: INTERNAL PROC [reg: Registration] = {
IF reg # NIL AND reg.first.state = active THEN {
lag: Registration ¬ NIL;
reg.first.state ¬ waitingDead;
IF reg = specialRegistration THEN specialRegistration ¬ NIL;
WHILE reg.first.state = waitingDead DO
InternalDumpAndWait[];
ENDLOOP;
reg.first.proc ¬ NIL;
FOR each: Registration ¬ registry, each.rest WHILE each # NIL DO
IF reg = each THEN TRUSTED {
IF lag = NIL THEN registry ¬ each.rest ELSE lag.rest ¬ each.rest;
EXIT;
};
lag ¬ each;
ENDLOOP;
{
prof: ProfileBuffer ¬ masterProfile;
IF prof # NIL THEN TRUSTED {
LocalStopProfile[prof];
masterProfile ¬ NIL;
};
};
};
};
InternalDumpAndWait: INTERNAL PROC = {
dumpWanted ¬ TRUE;
BROADCAST dumpRequest;
WHILE dumpWanted OR dumpBusy DO WAIT dumpFinish; ENDLOOP;
};
FinishDumpAndWait: ENTRY PROC = {
dumpBusy ¬ FALSE;
BROADCAST dumpFinish;
IF NOT dumpWanted THEN WAIT dumpRequest;
dumpWanted ¬ FALSE;
dumpBusy ¬ TRUE;
};
ProfileWatcher: PROC [gen: INT] = TRUSTED {
ProfileWatcher scans the profile buffer every few seconds and reads out the samples deposited since the last time. As the samples are read, the slots are cleared, and each sample is given to the registered callback routines. There is no checking for lost samples.
startIndex: NAT ¬ 0;
profRep: ProfileBufferRep ¬ [maxEntries, 0, ALL[ [0, 0] ]];
We put the profile buffer on the process atsck to avoid unfortunate interactions with the virtual dirty but mechanism in the garbage collector.
prof: ProfileBuffer ¬ @profRep;
IF masterProfile # NIL THEN RETURN;
IF LocalStartProfile[prof, SIZE[ProfileBufferRep]] < 0 THEN RETURN;
masterProfile ¬ prof;
Process.SetTimeout[@dumpRequest, Process.MsecToTicks[dumpRequestMillis]];
DO
FinishDumpAndWait[];
IF prof # masterProfile OR gen # globalGen THEN EXIT;
THROUGH [0..maxEntries] DO
pc: WORD = prof.entries[startIndex].pc;
count: WORD = prof.entries[startIndex].count;
IF pc # 0 OR count # 0 THEN {
prof.entries[startIndex].pc ¬ 0;
prof.entries[startIndex].count ¬ 0;
FOR each: Registration ¬ registry, each.rest WHILE each # NIL DO
SELECT each.first.state FROM
active, waitingDead => {
proc: EnumSamplesProc = each.first.proc;
data: REF = each.first.data;
IF proc # NIL THEN proc[pc: pc, count: count, data: data];
};
ENDCASE;
ENDLOOP;
};
startIndex ¬ IF startIndex = maxEntries THEN 0 ELSE startIndex + 1;
ENDLOOP;
FOR each: Registration ¬ registry, each.rest WHILE each # NIL DO
SELECT each.first.state FROM
waitingActive => each.first.state ¬ active;
waitingDead => each.first.state ¬ dead;
ENDCASE;
ENDLOOP;
ENDLOOP;
};
Utility procedures
Nothing: PROC = {};
ShowPercent: PROC [st: STREAM, count: CARDINAL, perc: REAL, suffix: ROPE ¬ NIL] = {
IO.PutF1[st, "%g ", [cardinal[count]] ];
IO.PutF1[st, "(%4.2f%%)", [real[perc]] ];
IF suffix # NIL THEN IO.PutRope[st, suffix];
};
StartResourceWatcher: ENTRY PROC [line: ROPE] RETURNS [act: ResourceActivity] = {
IF resourceActivity = NIL THEN {
act: ResourceActivity = NEW[ResourceActivityRep];
act.state ¬ starting;
act.line ¬ line;
Process.Detach[FORK ResourceWatcher[act]];
resourceActivity ¬ act;
WHILE act.state = starting DO WAIT act.changed; ENDLOOP;
RETURN [act];
};
RETURN [NIL];
};
ResourceWatcher: PROC [act: ResourceActivity] = {
entryResourceWatcher: ENTRY PROC = {
act.reg ¬ StartProfilingInternal[AcceptSamples, asd];
IF act.reg = NIL
THEN act.state ¬ error
ELSE {
act.state ¬ active;
BROADCAST act.changed;
act.stats ¬ DeltaResource.TakeDelta[internalResourceWatcher];
act.state ¬ done;
};
BROADCAST act.changed;
};
internalResourceWatcher: INTERNAL PROC = {
WHILE act.state = active DO WAIT act.changed; ENDLOOP;
};
asd: AcceptSamplesInstance = AllocSamples[];
entryResourceWatcher[];
IF act.state = error THEN FreeSamples[asd];
};
StopResourceWatcher: ENTRY PROC RETURNS [ResourceActivity] = {
act: ResourceActivity ¬ resourceActivity;
IF act # NIL THEN {
StopProfilingInternal[act.reg];
resourceActivity ¬ NIL;
act.state ¬ stopping;
BROADCAST act.changed;
WHILE act.state # done DO WAIT act.changed; ENDLOOP;
};
RETURN [act];
};
GetSwitches: PROC [arg: ROPE, old: SwitchArray] RETURNS [SwitchArray] = {
switches: SwitchArray ¬ old;
IF Rope.Match["-*", arg] THEN {
sense: BOOL ¬ TRUE;
FOR i: NAT IN [1..Rope.Length[arg]) DO
c: CHAR = Rope.Fetch[arg, i];
SELECT c FROM
IN ['a..'z] => switches[c] ¬ sense;
IN ['A..'Z] => switches[c+('a - 'A)] ¬ sense;
'~ => {sense ¬ NOT sense; LOOP};
ENDCASE;
sense ¬ TRUE;
ENDLOOP;
};
RETURN [switches];
};
ListFromSamples: PROC [asd: AcceptSamplesInstance] RETURNS [ProfileEntryList] = {
ListFromSamples destructively reads the structure produced by AcceptSamples and returns a list of <pc, count> pairs, sorted by increasing pc. The client must not use the old AcceptSamplesInstance instance after this call.
procList: ProfileEntryList ¬ NIL;
FOR next: AcceptSamplesInstance ¬ asd, next.link WHILE next # NIL DO
FOR i: [0..maxAcceptSamples) IN [0..next.nextIndex) DO
sample: ProfileEntry = next.samples[i];
new: RefProfileEntry ¬ NEW[ProfileEntry ¬ [pc: sample.pc, count: sample.count]];
procList ¬ CONS[new, procList];
ENDLOOP;
ENDLOOP;
procList ¬ SortProfileEntries[procList];
FreeSamples[asd];
RETURN [procList];
};
OutputFromSamples: PROC
[out: STREAM, asd: AcceptSamplesInstance, stats: Stats, line: ROPE,
modCutoff: REAL, procCutoff: REAL, debug: BOOL ¬ FALSE] = {
totalProcs: NAT ¬ 0;
totalCount: CARDINAL ¬ 0;
modules: NAT ¬ 0;
eachModule: VisitModules = {
IF list # NIL THEN {
Some counts found in this module
first: ProcEntry = list.first;
mc: CARDINAL ¬ 0;
entry: ModuleEntry = NEW[ModuleEntryRep ¬ [
ilse: ilse,
name: name, nameOK: nameOK,
pc: pc, size: size, type: type,
count: 0,
procs: list]];
WHILE list # NIL DO
first: ProcEntry = list.first;
fc: CARDINAL = first.count;
list ¬ list.rest;
mc ¬ mc + fc;
totalCount ¬ totalCount + fc;
totalProcs ¬ totalProcs + 1;
ENDLOOP;
entry.count ¬ mc;
modList ¬ CONS[entry, modList];
modules ¬ modules + 1;
};
};
modList: ModuleEntryList ¬ NIL;
modSkipped: CARDINAL ¬ 0;
modCountSkipped: CARDINAL ¬ 0;
tryCutoff: BOOL ¬ modCutoff > 0.0;
bogusList: ProfileEntryList ¬ ModulesFromSamples[
ListFromSamples[asd],
eachModule,
IF debug THEN out ELSE NIL];
toPercent: REAL = 100.0/totalCount;
modList ¬ SortModuleEntriesByCount[modList];
IO.PutF1[out, "-- Leafy output on %g for\n", [time[BasicTime.Now[]]] ];
IO.PutF1[out, " -- %g", [rope[line]]];
IO.PutF1[out, "-- Elapsed seconds: %5.3f", [real[stats.elapsed]]];
IO.PutF1[out, ", bytes allocated: %g", [cardinal[stats.bytesAllocated]] ];
IO.PutF1[out, ", utime: %5.3f", [real[stats.utime]] ];
IO.PutF1[out, ", stime: %5.3f\n", [real[stats.stime]] ];
IO.PutF1[out, "-- Total count: %g", [cardinal[totalCount]] ];
IO.PutF1[out, ", modules with counts: %g", [cardinal[modules]] ];
IO.PutF1[out, ", procs with counts: %g\n", [cardinal[totalProcs]] ];
modules ¬ 0;
FOR each: ModuleEntryList ¬ modList, each.rest WHILE each # NIL DO
me: ModuleEntry = each.first;
mc: CARDINAL = me.count;
list: ProcEntryList ¬ me.procs;
modPerc: REAL = mc*toPercent;
procSkipped: CARDINAL ¬ 0;
countSkipped: CARDINAL ¬ 0;
showProcs: BOOL ¬ TRUE;
IF tryCutoff AND (modPerc < modCutoff OR mc < 2)
THEN {
Don't bother to show this module, it's not significant
modSkipped ¬ modSkipped + 1;
modCountSkipped ¬ modCountSkipped + mc;
showProcs ¬ FALSE;
}
ELSE TRUSTED {
ShowPercent[out, mc, modPerc, ": "];
PutCharStar[out, me.name, '., '←];
IO.PutF1[out, ", startPC: %g", [cardinal[me.pc]] ];
IO.PutF1[out, ", size: %g\n", [cardinal[me.size]] ];
};
WHILE list # NIL DO
pe: ProcEntry = list.first;
procName: CharPtr = SymbolNameFromILSymEntry[pe.ilse];
count: CARDINAL = pe.count;
procPerc: REAL = count*toPercent;
list ¬ list.rest;
IF showProcs THEN {
IF tryCutoff
AND (procPerc < procCutoff OR count < 2)
AND (procSkipped # 0 OR list # NIL)
THEN {
Don't show this procedure
procSkipped ¬ procSkipped + 1;
countSkipped ¬ countSkipped + count;
}
ELSE TRUSTED {
IO.PutRope[out, " "];
ShowPercent[out, count, procPerc, ": "];
PutCharStar[out, procName, 0c, '←];
IO.PutRope[out, "\n"];
};
};
ENDLOOP;
IF showProcs AND procSkipped # 0 THEN {
IO.PutF1[out, " -- procs skipped: %g, counts skipped: ", [cardinal[procSkipped]] ];
ShowPercent[out, countSkipped, countSkipped*toPercent, "\n"];
};
modules ¬ modules + 1;
ENDLOOP;
IF modSkipped # 0 THEN {
IO.PutF1[out, "-- Modules not shown: %g, counts not shown: ", [cardinal[modSkipped]] ];
ShowPercent[out, modCountSkipped, modCountSkipped*toPercent, "\n"];
};
IF bogusList # NIL THEN {
We noticed some bogus pc values, so print them out
bogusCount: CARDINAL ¬ 0;
IF debug THEN {
bogusList ¬ SortProfileEntries[bogusList];
IO.PutRope[out, "-- Bogus:"];
};
FOR each: ProfileEntryList ¬ bogusList, each.rest WHILE each # NIL DO
first: RefProfileEntry = each.first;
bogusCount ¬ bogusCount + first.count;
IF debug THEN {
IO.PutF1[out, " %g", [cardinal[first.pc]]];
IF first.count # 1 THEN
IO.PutF1[out, "(%g)", [cardinal[first.count]]];
};
ENDLOOP;
IF debug THEN IO.PutChar[out, '\n];
IO.PutF1[out, "-- Bogus count: %g\n", [cardinal[bogusCount]]];
};
};
Initialization
DoIncludes[];
Commander.Register[
"Leafy", LeafyCommand,
"takes a leafy sample of the command (-a: all, -v: verbose)",
$Leafy,
FALSE];
Commander.Register[
"ShowSymsInModule", ShowSymsInModuleCommand,
"show the symbols in a given module",
$Leafy,
TRUE];
Commander.Register[
"ShowModules", ShowModulesCommand,
"show the loaded modules",
$Leafy,
TRUE];
Commander.Register[
"StartLeafy", LeafyCommand,
"start leafy sampling",
$Start,
TRUE];
Commander.Register[
"StopLeafy", LeafyCommand,
"stop leafy sampling & print results (-a: all, -v: verbose)",
$Stop,
TRUE];
Commander.Register[
"Spin", SpinCommand,
"spin for a given number of seconds",
$Leafy,
TRUE];
END.