
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

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;
dumpRequestMillis: NAT = (maxEntries*10)/4;
maxAcceptSamples: INT = maxEntries/2;

maxValidSize: CARDINAL Ź 1000000;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;

CharPtr: TYPE = POINTER TO Basics.RawChars;

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];
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};

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";
"    };\n";
".LocalStartProfil";
};

LocalStopProfile: UNSAFE PROC [p: ProfileBuffer] ~ UNCHECKED MACHINE CODE {
"+static void LocalStopProfil (p) ptr p; {\n";
"    (void) 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";
};

LeafyCommand: Commander.CommandProc = {
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 = {
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 = {
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 = {
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;
};

ScanModules: PROC [visit: VisitModules, noFilter: BOOL Ź FALSE] = TRUSTED {
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;
IF pc = 0 OR size > maxValidSize THEN size Ź 0;
SELECT TRUE FROM
lagIlse = NIL => {};
pc # lagPC, noFilter => {
continue: BOOL Ź visit[lagIlse, lagName, lagNameOK, lagPC, lagSize, lagType];
IF NOT continue THEN EXIT;
};
ENDCASE => {
IF NOT nameOK THEN {
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] ~ {
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 {
rest.first.count Ź rest.first.count + fc;
profList Ź rest;
LOOP;
};
IF fpc >= limit THEN EXIT;
{
lagIlse: ILSymEntry Ź ilse;
lagPC: WORD Ź 0;
IF fpc < pc THEN GO TO bogus;
DO
nextIlse: ILSymEntry = LocalNextEntry[lagIlse];
IF nextIlse = lagIlse THEN ERROR;
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;
IF procTail # NIL AND procTail.first.ilse = lagIlse
THEN {
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;
procHead Ź SortProcEntriesByCount[procHead];
RETURN [eachModule[ilse, name, nameOK, pc, size, type, procHead]];
};
ScanModules[visitModule];
WHILE profList # NIL DO
first: RefProfileEntry Ź profList.first;
rest: ProfileEntryList Ź profList.rest;
IF rest # NIL AND first.pc = rest.first.pc THEN {
rest.first.count Ź rest.first.count + first.count;
profList Ź rest;
LOOP;
};
profList.rest Ź bogusList;
bogusList Ź profList;
profList Ź rest;
ENDLOOP;
RETURN [bogusList];
};

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;
};

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];
};

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 {
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 {
startIndex: NAT Ź 0;
profRep: ProfileBufferRep Ź [maxEntries, 0, ALL[ [0, 0] ]];
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;
};

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] = {
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 {
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 {
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 {
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 {
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]]];
};
};

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.

     
LeafySampleCommand.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) December 27, 1991 3:29 pm PST
Global variables & interesting constants
At current rates, this gives us enough space for at least 20 seconds of samples

This allows us up to four intervals to transfer the samples

Arbitrary validity bound on module text sizes
Types
Equivalent to Unix (char *), but be careful about alignment
Callback proc type.

C access procedures
NOTE: should be changed when PCR is fixed to:
"    return (XR_Profil(p, s+1, 0, 2));\n";
NOTE: should be changed when PCR is fixed to:
"    (void) XR_Profil(p, 0, 0, 0);\n";
Command procedures
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
Iteration procedures
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.
Alan promised that this would not happen!
This size does not look very nice, so cancel it
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.
This name is not OK, so preserve the previous name
Note: if st # NIL then debug output goes to st
Collapse the counts for equal PCs
We are no longer in the right module, so return to get the next one
Add this one to the bogus list
This should not happen!
No containing procedure found!
This just adds to the current procedure
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.
Splice the rest of the profList onto the bogus list
Collapse the counts
Sorting procedures
Unix string procedures
Sampling procedures
Make a new bunch of samples
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.
We put the profile buffer on the process atsck to avoid unfortunate interactions with the virtual dirty but mechanism in the garbage collector.
Utility procedures
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.
Some counts found in this module
Don't bother to show this module, it's not significant
Don't show this procedure
We noticed some bogus pc values, so print them out
Initialization
Ę'?  (cedarcode) styleNewlineDelimiter
 headĎnIcode
Ďe=HL1 Ďk		L;\!L4[LL 2.2 in tabStops(L2.2 in tabStops	L2.2 in tabStops	L2.2 in tabStopsL2.2 in tabStops
LL%)L L$(L%)L LL$L 
L1ĎbOL 2.2 in tabStops+L2.2 in tabStops;L2.2 in tabStops %L !L-LLL 	+L;L L	&L2.2 in tabStops$L2.2 in tabStops"L2.2 in tabStops 2.2 in tabStopsL2.2 in tabStops L/"LLL.EL 	DLL L#L L1L)LLLL2!L
LL	0L L;)L"L%L	4LL L-L-"LL	LL L+ŹL L(L#LLLL L,L'LLL%LLLL L5L
"L L1$LLLL		LLL-HL 

)LLL$$LLLL 	eL:: '-L**LLLL 	KL.. #L-L&&LLLL VL55LL55L""L##L!!LNNLLLLL UL44LL55LL##L!!LNNLLLLL TL33L22L##LLLL SL22L22L""LLLL SL22L22L""LLLL \L88L22L%%L))LLLL 'L
:L1L66LL#LLL#LL L6L%L&L&LL$8L%L8LLLL L0L #L33L(L L0ILL
L..L$LLOOLL
LLL,,L77L	L#LLLL@L,,L	6LLLGGL)4LL	LLL LL 2L
:L1L66L::L*7L	.LL-;L%	L7LL)L0ELLL//L	)LL0+L/LLCE$LACLCELLL$0LLLLLLLLL  L LL -L
:L1L66::L*7LL#L	.LL-;L%L&*L
LL0-LL'L+-L/1LLLLLLL  L LL &L
:L1L66::L*7LL55LLLLLL	&LL/1L(;
%L,LLLL9LL33L'3L(LLL LL 
!KLääL#(LLLLL	L	LALLL/L)L%L&L&L)
/L/L
L
?ML
LLL2LLLLLL!LLLLLLLLLLLLL 
< L.%L LLLL(L''LL,L!L)LLLLCLL
LL//!LL!-L&ALLL#L3L'L""LLL5L!L?LL

LLLLLLLL,L<BLLL3L(L'1LL2LLLLLLLLLL XLMLLL +	LLL	LLLLLL VLQLLL /L!LL	LLLLLL \L!SLLL 1L!LL	LLLLLL 		hL1L?LLLL
HL
LL
LLL)LL 	L1L?LLLL
HL
L#L
LLLLL 	GL1L?LLLLL LLLL
LLLL ".L1L0LL (LL-LLLLLLLLL <L)L(LLLL !8L''LLLLLL 
XL&,LL 
cL<TLLL/L!(LLLLLLL 1LLL <0LLL<&LLL*@LALLLLL$LLLLLLL &LL	L

9LL !LL	L(LLLL +LL,;LLL#LCLLIILL5L'L"-L L#*@L((LL(:LLLLLCL*@L+L'LLLLL L 	
SL&(L')L
,LL 
Q L1LLL*LL8LLLLL 1$L5LLL	L=LLL	L*L6LL,,LL+LL >L)LLLL	L4LLLL ILL&LL!#L+-L LLLLLLL QLŢŢL!.D6L''L6PLLLL(LLLL 2	LLL	L LL+LLLL		LLLLLLLLLL
LLLLLLL"L	TpL#L,LEGL%'L@BLHJL46L68L;=L?ALBDL,BLLLL	LLL0L6LL'LLL$$L""L13L24LLL66LL
!LYLLL$LLL((L##LLLL'LTVL==LLLLUWLCCLL2LL*LL/EL$$L&L)+L-/LLL#L<>LLL L LL==LLL L,,L%%LLL L""LLLL LLLLL LL==LLL LL%%LLL L LL      i  W  