<> <> <> <> <> <> <> <> DIRECTORY AMBridge USING [TVForGFHReferent], AMModelPrivate USING [FGIndex, FGIToFirstChar, ProgPCToFGI], AMTypes USING [TV], BasicTime USING [Now], IO USING [Close, Error, Put, PutF, PutF1, PutFR1, PutRope, STREAM], Loader USING [BCDBuildTime], PrincOps USING [GlobalFrameHandle], Process USING [CheckForAbort, Priority], Rope USING [Cat, Concat, Length, ROPE, Substr], RTSymbolDefs USING [CallableBodyIndex, SymbolTableBase], RTSymbolOps USING [AcquireRope, BodyName], RTSymbols USING [AcquireSTBFromGFH, ReleaseSTB], RTTypesPrivate USING [GetCBTI, GetEp], RuntimeError USING [UNCAUGHT], SpyClient USING [ClearBreaks, DataType, InitializeSpy, StartSpy, StopSpy], SpyOps USING [Call, Count, DestroyLog, justMe, modules, PrintBreaks, PrintCount, Procedure, processes, ProcessRef, ReadLog, wakeups, watching], SystemNames USING [LocalDir], ViewerIO USING [CreateViewerStreams]; SpyPrintImpl: PROGRAM IMPORTS AMBridge, AMModelPrivate, BasicTime, IO, Loader, Process, Rope, RTSymbolOps, RTSymbols, RTTypesPrivate, RuntimeError, SpyClient, SpyOps, SystemNames, ViewerIO EXPORTS SpyClient = { OPEN SpyOps; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Error: SIGNAL = CODE; <> procMin, min: Count; printAll: BOOL _ FALSE; current: SpyClient.DataType; spyDir: ROPE ~ SystemNames.LocalDir["Spy"]; -- e.g., "[]<>7.0>Spy>" spyLogName: ROPE ~ Rope.Concat[spyDir, "Spy.log"]; DisplayData: PUBLIC PROC [cutoff: CARDINAL, herald: ROPE, stream: STREAM, spyOnSpyLog: BOOL] = { { ENABLE { ABORTED => {stream.Put[[rope[" . . . aborted.\n"]]]; CONTINUE}; IO.Error => CONTINUE}; localStream: STREAM _ NIL; IF stream = NIL THEN stream _ localStream _ ViewerIO.CreateViewerStreams[ name: "Spy log", backingFile: spyLogName].out; current _ SpyOps.watching; -- if the Spy is watching itself PrintHeader[herald, stream]; IF spyOnSpyLog THEN { SpyClient.ClearBreaks[]; [] _ SpyClient.InitializeSpy[breakProcess, , TRUE]; SpyClient.StartSpy[]}; SpyOps.ReadLog[stream, SpyOps.watching, spyOnSpyLog]; IF cutoff # 0 THEN {min _ MAX[1, SpyOps.wakeups/100]; procMin _ cutoff*min} ELSE {min _ procMin _ 1}; PrintTree[stream]; IF localStream # NIL THEN IO.Close[localStream]; }; SpyOps.DestroyLog[]; IF spyOnSpyLog THEN SpyClient.StopSpy[]; }; PrintHeader: PROC [herald: ROPE, stream: STREAM] = { IO.PutRope[stream, "\n\n==========================================================\n"]; IO.PutF1[stream, "Cedar Spy of: %g.\n", [time[Loader.BCDBuildTime[]]]]; IO.PutF1[stream, "Executed at: %g.\n", [time[BasicTime.Now[]]]]; IF herald # NIL THEN stream.Put[[rope[herald]], [character['\n]]]; IO.PutRope[stream, SELECT current FROM CPU, process, breakProcess => "Measuring CPU usage.\n", pagefaults => "Measuring page faults.\n", allocations => "Measuring allocations.\n", wordsAllocated => "Measuring words allocated.\n", userDefined => "Measuring user breaks.\n", ENDCASE => ERROR]; IF SpyOps.watching IN [process..breakProcess] THEN IO.PutF1[stream, "Watching process: %bb.\n", [cardinal[SpyOps.justMe]]]; SpyOps.PrintBreaks[stream]; stream.Put[[character['\n]]]; }; PrintTree: PROC [stream: STREAM] = { assorted: Count _ 0; next _ " "; <> SortProcesses[processes]; stream.Put[ [rope["~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"]], [rope["Breakdown of interesting processes.\n"]], [rope["~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"]]]; indention _ NIL; FOR p: LIST OF ProcessRef _ processes, p.rest DO IF p = NIL THEN EXIT; IF p.first.calls < min --AND RTProcess.GetPSBIPageFaults[p.first.psb] = 0 THEN {assorted _ assorted + p.first.calls; LOOP}; PrintProcess[stream, p.first]; ENDLOOP; IF assorted > 0 THEN { stream.Put[[character['\n]], [rope["Assorted processes"]]]; SpyOps.PrintCount[stream, assorted, 0, SpyOps.wakeups]; }; <> stream.Put[ [rope["\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"]], [rope["Breakdown of interesting procedures.\n"]], [rope["~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n"]]]; PrintProcs[stream, FindProcs[NIL]]; IF procMin > 1 THEN IO.PutF1[stream, "\nThe remaining procedures had less than %g wakeups.\n", [cardinal[procMin]] ] ELSE IO.PutRope[stream, "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"]; <> stream.Put[ [rope["\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"]], [rope["Breakdown of highly active procedures.\n"]], [rope["~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n"]]]; IF (current IN [CPU..breakProcess]) THEN { procList: LIST OF Procedure _ ActiveProcs[]; FOR each: LIST OF Procedure _ procList, each.rest UNTIL each=NIL DO proc: Procedure ~ each.first; stream.PutF[format: "%g (%g)", v1: [rope[proc.name]], v2: [cardinal[proc.refs]]]; SpyOps.PrintCount[stream, proc.count, proc.calls, SpyOps.wakeups]; FOR p: LIST OF Call _ proc.countLocs, p.rest UNTIL p=NIL DO <> ref: INT ~ Source[gfh: proc.gfh, pc: p.first.pc]; WHILE p.rest#NIL AND ref = Source[gfh: proc.gfh, pc: p.rest.first.pc] DO p.first.calls _ p.first.calls+p.rest.first.calls; p.rest _ p.rest.rest; ENDLOOP; ENDLOOP; FOR p: LIST OF Call _ proc.countLocs, p.rest UNTIL p=NIL DO PrintCall[stream: stream, proc: proc, call: p.first]; ENDLOOP; ENDLOOP; }; }; <> SortProcesses: PROC [list: LIST OF ProcessRef] = { IF list # NIL THEN DO changed: BOOL _ FALSE; l: LIST OF ProcessRef _ list; UNTIL l.rest = NIL DO IF l.first.calls < l.rest.first.calls THEN { temp: ProcessRef _ l.first; l.first _ l.rest.first; l.rest.first _ temp; changed _ TRUE}; l _ l.rest; ENDLOOP; IF ~changed THEN EXIT; ENDLOOP; }; PrintProcess: PROC [stream: STREAM, process: ProcessRef] = { faults: CARD _ 0; Process.CheckForAbort[]; IO.PutF1[stream, "\nProcess %bb", [cardinal[process.psb]] ]; <> stream.Put[ [rope[" running at priority "]], [character['[]], [rope[LevelName[process.level[0]]]]]; IF process.level[1] # 0 THEN FOR i:CARDINAL IN [1..4] DO IF process.level[i] = 0 THEN EXIT; stream.Put[ [rope[", "]], [rope[LevelName[process.level[i]]]]]; ENDLOOP; stream.Put[[character[']]]]; <> <> IF faults > 0 THEN stream.Put[ [rope[" ("]], [integer[faults]], [rope[" page faults)"]]]; SpyOps.PrintCount[stream, process.calls, 0, SpyOps.wakeups]; <> FOR p: LIST OF Call _ process.sons, p.rest DO IF p = NIL THEN EXIT; PrintCall[stream, NIL, p.first]; ENDLOOP; }; LevelName: ARRAY Process.Priority OF ROPE _ [ "idle", "background", "normal", "foreground", "foreforeground", "faultHandlers", "realTime", "swat"]; <> EnumerateProcs: PROC [userProc: PROC [Procedure] RETURNS [BOOL]] RETURNS [last: Procedure] = INLINE { FOR m: LIST OF Procedure _ modules, m.rest WHILE m # NIL DO FOR p: LIST OF Call _ m.first.sons, p.rest WHILE p # NIL DO IF p.first.proc.count = 0 AND p.first.proc.calls = 0 THEN LOOP; IF userProc[p.first.proc] THEN RETURN [p.first.proc]; ENDLOOP; ENDLOOP; RETURN [NIL]; }; FindProcs: PROC [container: Procedure] RETURNS [list: LIST OF Procedure _ NIL] = { FindProc: PROC [next: Procedure] RETURNS [BOOL] = { IF container = NIL THEN IF next.container = next THEN list _ CONS[next, list] ELSE RETURN [FALSE]; IF next.container = container THEN IF next.container = next THEN RETURN [FALSE] ELSE list _ CONS[next, list]; RETURN [FALSE]}; [] _ EnumerateProcs[FindProc]; IF list # NIL THEN SortProcs[list]; }; ActiveProcs: PROC RETURNS [active: LIST OF Procedure _ NIL] ~ { EachProc: PROC [proc: Procedure] RETURNS [BOOL] ~ { IF (proc.count*100/SpyOps.wakeups) > 1 THEN active _ CONS[proc, active]; RETURN [FALSE]; }; [] _ EnumerateProcs[EachProc]; IF active # NIL THEN SortProcs[active]; }; SortProcs: PROC [list: LIST OF Procedure] = { temp: Procedure; changed: BOOL; l: LIST OF Procedure; xCount, yCount: Count; IF list = NIL THEN RETURN; DO changed _ FALSE; l _ list; UNTIL l.rest = NIL DO xCount _ l.first.count + l.first.calls; yCount _ l.rest.first.count + l.rest.first.calls; IF xCount < yCount THEN { temp _ l.first; l.first _ l.rest.first; l.rest.first _ temp; changed _ TRUE}; l _ l.rest; ENDLOOP; IF ~changed THEN EXIT; ENDLOOP; }; indention, next: ROPE _ NIL; PrintProcs: PROC [stream: STREAM, procs: LIST OF Procedure] = { count: NAT _ 0; procsToPrint: BOOL; keepLooping: BOOL; break: BOOL _ FALSE; list, last: LIST OF Procedure; allParentsPrinted: BOOL; Printable: PROC [procs: LIST OF Procedure] RETURNS [BOOL] = INLINE { RETURN [procs # NIL AND procs.first.calls + procs.first.count >= procMin]; }; WHILE procs # NIL DO list _ NIL; <> <> keepLooping _ TRUE; WHILE keepLooping DO last _ NIL; keepLooping _ FALSE; FOR l: LIST OF Procedure _ procs, l.rest WHILE l # NIL DO allParentsPrinted _ TRUE; FOR f: LIST OF Procedure _ l.first.parents, f.rest WHILE f # NIL DO IF ~f.first.marked THEN {allParentsPrinted _ FALSE; EXIT}; ENDLOOP; IF ~allParentsPrinted THEN {last _ l; LOOP}; IF last = NIL THEN procs _ l.rest ELSE last.rest _ l.rest; IF break THEN count _ count + 1; -- a place to break on IF Printable[l] -- 'print' procs that won't be printed THEN list _ CONS[l.first, list] ELSE {PrintProc[stream, l.first]; keepLooping _ TRUE}; ENDLOOP; ENDLOOP; <> IF list = NIL THEN { IF procs = NIL THEN RETURN; list _ CONS[procs.first, NIL]; procs _ procs.rest}; <> IF list.rest # NIL THEN SortProcs[list]; IF break THEN count _ count + 1; -- a place to break on procsToPrint _ Printable[procs]; FOR list _ list, list.rest WHILE list # NIL DO IF Printable[list.rest] THEN next _ "! " ELSE IF procsToPrint THEN next _ ". " ELSE next _ " "; PrintProc[stream, list.first]; ENDLOOP; ENDLOOP; }; PrintProc: PROC [stream: STREAM, proc: Procedure] = { looks: BOOL _ FALSE; length: INT _ 0; list: LIST OF Procedure _ NIL; IF proc = NIL THEN RETURN; IF proc.marked THEN ERROR ELSE proc.marked _ TRUE; IF proc.gfh = NIL AND proc.entryPC = 0 THEN RETURN; -- "source" module IF proc.calls + proc.count >= procMin THEN { <> IF ~proc.named THEN SetName[proc]; stream.Put[[rope[indention]]]; IF proc.count > 0 AND ( ~(current IN [CPU..breakProcess]) --not measuring gross things-- OR (current IN [CPU..breakProcess]) AND (proc.count*100/SpyOps.wakeups) > 1 --AND proc.calls # 0-- --when measuring cpu, process, or breaks, embolden only if > 1%-- ) THEN { looks _ TRUE; stream.PutF["%l", [rope["b"]]]}; IF proc.parents # NIL AND proc.parents.rest # NIL THEN { looks _ TRUE; stream.PutF["%l", [rope["i"]]]}; stream.Put[[rope[proc.name]]]; IF looks THEN stream.PutF["%l", [rope[" "]]]; stream.PutF[" (%g ref%g)", [cardinal[proc.refs]], [rope[IF proc.refs=1 THEN "" ELSE "s"]]]; SpyOps.PrintCount[stream, proc.count, proc.calls, SpyOps.wakeups]; <> FOR p: LIST OF Call _ proc.sons, p.rest DO IF p = NIL THEN EXIT; IF p.first.calls < min THEN LOOP; PrintCall[stream, proc, p.first]; ENDLOOP; stream.Put[[rope[indention]], [rope[next]], [character['\n]]]}; <> list _ FindProcs[proc]; IF list = NIL THEN RETURN; indention _ Rope.Cat[indention, next]; PrintProcs[stream, list]; indention _ Rope.Substr[indention, 0, indention.Length[]-2]; }; PrintCall: PROC [stream: STREAM, proc: Procedure, call: Call] = { stream.Put[[rope[indention]], [rope[next]]]; IF proc # NIL AND proc.symbols THEN stream.Put[[rope["("]], [cardinal[Source[proc.gfh, call.pc]]], [rope[") "]]]; IF call.proc#NIL THEN { IF ~call.proc.named THEN SetName[call.proc]; stream.Put[[rope[call.proc.name]]]; }; SpyOps.PrintCount[stream, call.calls, 0, SpyOps.wakeups]; Process.CheckForAbort[]; }; SetName: PROC [proc: Procedure] = { stb: RTSymbolDefs.SymbolTableBase _ [x[e: NIL]]; { ENABLE { UNWIND => IF stb # [x[e: NIL]] THEN RTSymbols.ReleaseSTB[stb]; RuntimeError.UNCAUGHT => GO TO finish; }; gfh: PrincOps.GlobalFrameHandle _ proc.gfh; name: ROPE; temp: Procedure; stb _ RTSymbols.AcquireSTBFromGFH[gfh ! RuntimeError.UNCAUGHT => CONTINUE]; <> FOR m: LIST OF Procedure _ modules, m.rest WHILE m # NIL DO IF m.first.gfh # proc.gfh THEN LOOP; FOR p: LIST OF Call _ m.first.sons, p.rest WHILE p # NIL DO IF p.first.proc # proc AND p.first.proc.count + p.first.proc.calls < min THEN LOOP; IF p.first.proc.named THEN LOOP; name _ NIL; temp _ p.first.proc; IF stb # [x[e: NIL]] THEN { <> ep: CARDINAL _ RTTypesPrivate.GetEp[[temp.entryPC], gfh, stb].ep; cbti: RTSymbolDefs.CallableBodyIndex _ RTTypesPrivate.GetCBTI[stb, ep]; name _ RTSymbolOps.AcquireRope[stb, RTSymbolOps.BodyName[stb, cbti]]; }; IF name = NIL THEN { temp.symbols _ FALSE; name _ IO.PutFR1["%bb", [cardinal[temp.entryPC]]]; }; temp.name _ Rope.Cat[temp.name, name]; temp.named _ TRUE; ENDLOOP; EXIT; ENDLOOP; GO TO finish; EXITS finish => IF stb # [x[e: NIL]] THEN RTSymbols.ReleaseSTB[stb]; }; }; Sons: PROC [list: LIST OF Call] RETURNS [BOOL] = INLINE { FOR list _ list, list.rest DO IF list = NIL THEN EXIT; IF list.first.calls >= min THEN RETURN [TRUE]; ENDLOOP; RETURN [FALSE]; }; Source: PROC [gfh: PrincOps.GlobalFrameHandle, pc: CARDINAL] RETURNS [source: INT _ 0] = { stb: RTSymbolDefs.SymbolTableBase _ [x[e: NIL]]; { ENABLE { UNWIND => IF stb # [x[e: NIL]] THEN RTSymbols.ReleaseSTB[stb]; RuntimeError.UNCAUGHT => GO TO oops; }; gfTV: AMTypes.TV = AMBridge.TVForGFHReferent[gfh]; fgi: AMModelPrivate.FGIndex = AMModelPrivate.ProgPCToFGI[gfTV, [pc]]; stb _ RTSymbols.AcquireSTBFromGFH[gfh]; source _ AMModelPrivate.FGIToFirstChar[stb, fgi]; RTSymbols.ReleaseSTB[stb]; EXITS oops => IF stb # [x[e: NIL]] THEN RTSymbols.ReleaseSTB[stb]; }; }; }..