<> <> <> <> <> <> <> DIRECTORY AMModel USING [Section], AMTypes USING [Error, TV], AMViewerOps USING [SectionFromSelection], Buttons USING [Button, ButtonProc, Create, ReLabel], Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Container, Create], Convert USING [CardFromRope, Error, IntFromRope, RopeFromInt], FS USING [Error, ExpandName], Icons USING [NewIconFromFile], IO USING [Close, Put, PutFR, PutRope, RopeFromROS, ROS, STREAM], Labels USING [Create, Label, Set], PrincOps USING [PsbIndex, PsbNull], Rope USING [Equal, Fetch, Flatten, Length, ROPE, Text], Rules USING [Create], SpyClient USING [ClearBreaks, ClearUserBreaks, DataType, DisplayData, InitializeSpy, SetStartBreak, SetStopBreak, SetTrace, SetUserBreak, StartSpy, StopSpy], ViewerClasses USING [InitProc, Viewer, ViewerClass], ViewerIO USING [CreateViewerStreams], ViewerOps USING [ChangeColumn, CreateViewer, DestroyViewer, MoveViewer, OpenIcon, PaintViewer], ViewerTools USING [GetContents, GetSelectedViewer, GetSelectionContents, MakeNewTextViewer, SelPos, SetContents, SetSelection]; SpyViewerImpl: MONITOR IMPORTS AMTypes, AMViewerOps, Buttons, Commander, Containers, Convert, FS, Icons, IO, Labels, Rope, Rules, SpyClient, ViewerIO, ViewerOps, ViewerTools SHARES IO = { ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; TV: TYPE = AMTypes.TV; <> typescript: IO.STREAM _ NIL; typescriptBox: ViewerClasses.Viewer _ NIL; spyViewer: Containers.Container _ NIL; <<**************************************************>> <> <<**************************************************>> Spy: Commander.CommandProc = TRUSTED { IF spyViewer = NIL OR spyViewer.destroyed THEN { spyViewer _ Containers.Create[info: [name: "Spy", icon: Icons.NewIconFromFile["/Cedar/CedarChest6.1/Spy/Spy.icon", 0], scrollable: FALSE, iconic: TRUE]]; CreateSpyViewer[spyViewer]; } ELSE IF spyViewer.iconic THEN ViewerOps.OpenIcon[spyViewer] ELSE ViewerOps.PaintViewer[spyViewer, all]; IF spyViewer.offDeskTop THEN ViewerOps.ChangeColumn[spyViewer, left]; }; CreateSpyViewer: ViewerClasses.InitProc = TRUSTED { rule: ViewerClasses.Viewer; x:INTEGER = 10; -- upper left corner of commands y:INTEGER = 10; sp:INTEGER = 6; line:INTEGER = 20; -- height of each line <<>> <> rule _ Rules.Create[info: [parent: self, wx: 0, wy: y + 4*line, ww: 100, wh: 1]]; Containers.ChildXBound[self, rule]; typescriptBox _ ViewerOps.CreateViewer[flavor: $Typescript, info: [wx: 0, wy: y + 4*line + 1, ww: 70*sp+x-5, wh: 40*line, border: FALSE, parent: self]]; typescript _ ViewerIO.CreateViewerStreams["Spy.Log", typescriptBox].out; Containers.ChildXBound[self, typescriptBox]; Containers.ChildYBound[self, typescriptBox]; <> spyOnButton _ Buttons.Create[ proc: ToggleSpy, documentation: "Spy records data only when this is 'on'.", info: [name: "Spy: {off} ", wx: x, wy: y, border: FALSE, parent: self]]; SetSpyButton[]; dataTypeButton _ Buttons.Create[ proc: ToggleType, documentation: "Gives the resource to be monitored. Toggle through for list.", info: [name: "Watching: {CPU} ", wx: x + 15*sp, wy: y, border: FALSE, parent: self]]; processBoxX _ 475 - 34*sp; processBoxY _ y + 1; processBoxW _ 8*sp; processBoxH _ line; bracketLabel _ Labels.Create[ info: [name: " ", -- used to print the trailing bracket when dataType = process wx: processBoxX + processBoxW, wy: processBoxY, border: FALSE, parent: self]]; tablesLabel _ Labels.Create[ info: [name: " ", -- indicates when tables are being built wx: processBoxX + processBoxW + 3*sp, wy: y, border: FALSE, parent: self]]; <> displayButton _ Buttons.Create[ fork: TRUE, documentation: "Displays the current data on a separate typescript.", proc: DisplayData, info: [name: "DisplayData!", wx: x, wy: y + line, parent: self]]; divisorButtonX _ x + 15*sp; divisorButton _ Buttons.Create[ proc: ToggleDivisor, documentation: "Manipulates the frequency divisor", info: [name: "Frequency Divisor:", wx: divisorButtonX, wy: y + line, border: FALSE, parent: self]]; divisorBoxX _ x + 35*sp; divisorBox _ ViewerTools.MakeNewTextViewer[ info: [wx: divisorBoxX, wy: y + line, ww: 8*sp, wh: line, data: "1", border: FALSE, scrollable: FALSE, parent: self]]; cutoffButton _ Buttons.Create[ proc: ToggleCutoff, documentation: "Specifies percentage cutoff for printing.", info: [name: "cutoff: {100}", wx: x + 43*sp, wy: y + line, border: FALSE, parent: self]]; SetCutoffButton[]; <<>> <> setStartBreakButton _ Buttons.Create[ proc: SetStartBreak, documentation: "Select a source or a rope of the form ModuleImpl.Proc.", info: [name: "SetStartBreak!", wx: x, wy: y + 2*line, parent: self]]; setStopBreakButton _ Buttons.Create[ proc: SetStopBreak, documentation: "Spy will record data as long as the number of start breaks exceeds the number of stops.", info: [name: "SetStopBreak!", wx: x + 15*sp, wy: y + 2*line, -- 31 parent: self]]; clearBreaksButton _ Buttons.Create[ proc: ClearBreaks, documentation: "Clears the breaks given by user; resets the mode.", info: [name: "ClearBreaks!", wx: x + 31*sp, wy: y + 2*line, -- 47 parent: self]]; <> setUserBreakButton _ Buttons.Create[ proc: SetUserBreak, documentation: "Spy will count the given breaks as they are encountered.", info: [name: "SetUserBreak!", wx: x, wy: y + 3*line, parent: self]]; setTraceButton _ Buttons.Create[ proc: SetUserBreak, clientData: $Trace, documentation: "Logs a trace whenever the break is encountered.", info: [name: "SetTrace!", wx: x + 15*sp, wy: y + 3*line, parent: self]]; clearUserBreaksButton _ Buttons.Create[ documentation: "Clears the user breaks given.", proc: ClearUserBreaks, info: [name: "ClearUserBreaks!", wx: x + 27*sp, wy: y + 3*line, parent: self]]; SetDataType[CPU]; }; <<**************************************************>> <> <<************************************************** >> break: BOOLEAN _ FALSE; spyOn: BOOLEAN _ FALSE; displayButton: Buttons.Button _ NIL; spyOnButton: Buttons.Button _ NIL; tablesLabel: Labels.Label _ NIL; bracketLabel: Labels.Label _ NIL; SetSpyButton: PROC = { SELECT TRUE FROM break AND spyOn => { IF ~Rope.Equal[spyOnButton.name, "Break: {on}"] THEN typescript.Put[[character['\n]], [rope["Start breaks enabled."]], [character['\n]]]; Buttons.ReLabel[spyOnButton, "Break: {on}"]}; break AND ~spyOn => { IF ~Rope.Equal[spyOnButton.name, "Break: {off}"] THEN typescript.Put[[character['\n]], [rope["Start breaks disabled."]], [character['\n]]]; Buttons.ReLabel[spyOnButton, "Break: {off}"]}; ~break AND spyOn => { IF ~Rope.Equal[spyOnButton.name, "Spy: {on}"] THEN typescript.Put[[character['\n]], [rope["Spy started."]], [character['\n]]]; Buttons.ReLabel[spyOnButton, "Spy: {on}"]}; ENDCASE => { IF ~Rope.Equal[spyOnButton.name, "Spy: {off}"] THEN typescript.Put[[character['\n]], [rope["Spy stopped."]], [character['\n]]]; Buttons.ReLabel[spyOnButton, "Spy: {off}"]}; }; ToggleSpy: Buttons.ButtonProc = TRUSTED { SELECT spyOn FROM TRUE => StopSpy[]; FALSE => StartSpy[]; ENDCASE => ERROR; }; StopSpy: PROC = { spyOn _ FALSE; SpyClient.StopSpy[]; SetSpyButton[]; }; StartSpy: PROC = { error: ROPE _ NIL; process: PrincOps.PsbIndex _ PrincOps.PsbNull; divisor: INT _ 1; Labels.Set[tablesLabel,"initializing"]; IF dataType = breakProcess AND ~break THEN error _ "Watching break process but no breaks set!"; IF dataType = process THEN { process _ Convert.CardFromRope[ViewerTools.GetContents[processBox], 8]; IF process = PrincOps.PsbNull THEN error _ "No process specified."}; divisor _ Convert.IntFromRope[ViewerTools.GetContents[divisorBox] !Convert.Error => {error _ "Malformed frequency divisor --- it should be an integer."; CONTINUE}]; IF error = NIL AND divisor NOT IN [1 .. LAST[NAT]] THEN error _ IO.PutFR["Frequency divisor %g is out of range [1 .. %g].", [integer[divisor]], [integer[LAST[NAT]]]]; IF error = NIL THEN error _ SpyClient.InitializeSpy[ dataType: dataType, process: process, frequencyDivisor: divisor]; Labels.Set[tablesLabel, NIL]; IF error # NIL THEN { typescript.Put[[character['\n]], [rope[error]], [character['\n]]]; RETURN}; spyOn _ TRUE; SetSpyButton[]; SpyClient.StartSpy[]; }; <<>> <<**************************************************>> <> <<**************************************************>> divisorButton: Buttons.Button _ NIL; divisorButtonX: NAT; divisorBox: ViewerClasses.Viewer _ NIL; divisorBoxX: NAT; ToggleDivisor: Buttons.ButtonProc = TRUSTED { Set: PROC [divisor: INT] = { ViewerTools.SetContents[divisorBox, Convert.RopeFromInt[divisor]]; }; SELECT mouseButton FROM yellow => Set[1]; red, blue => { ENABLE Convert.Error => { typescript.PutRope["\nMalformed frequency divisor --- it should be an integer.\n"]; CONTINUE}; divisor: INT = Convert.IntFromRope[ViewerTools.GetContents[divisorBox]]; SELECT mouseButton FROM blue => IF divisor >= 5 THEN Set[divisor/5]; yellow => ERROR; red => IF divisor <= LAST[NAT]/5 THEN Set[divisor*5]; ENDCASE => ERROR; }; ENDCASE => ERROR; }; <<**************************************************>> <> <<**************************************************>> dataType: SpyClient.DataType _ CPU; dataTypeButton: Buttons.Button _ NIL; processBox: ViewerClasses.Viewer _ NIL; processBoxX, processBoxY, processBoxW, processBoxH: CARDINAL; SetDataType: PROC [dt: SpyClient.DataType] = { needPaint: BOOL _ FALSE; dataType _ dt; IF dataType = process AND (processBox = NIL OR processBox.destroyed) THEN { processBox _ ViewerTools.MakeNewTextViewer[ info: [wx: processBoxX, wy: processBoxY, ww: processBoxW, wh: processBoxH, border: FALSE, scrollable: FALSE, parent: spyViewer], paint: FALSE]; Labels.Set[bracketLabel, "}", FALSE]; ViewerTools.SetSelection[processBox]; needPaint _ TRUE}; IF dataType # process AND processBox # NIL AND ~processBox.destroyed THEN { ViewerOps.DestroyViewer[processBox, FALSE]; Labels.Set[bracketLabel, " ", FALSE]; needPaint _ TRUE}; SELECT dataType FROM CPU, process, breakProcess, allocations, wordsAllocated => IF divisorButton.wx # divisorButtonX THEN { ViewerOps.MoveViewer[divisorButton, divisorButtonX, divisorButton.wy, divisorButton.ww, divisorButton.wh, FALSE]; ViewerOps.MoveViewer[divisorBox, divisorBoxX, divisorBox.wy, divisorBox.ww, divisorBox.wh, FALSE]; needPaint _ TRUE; }; pagefaults, userDefined => IF divisorBox.wx+divisorBox.ww >= 0 THEN { invisibleX: INTEGER = -100 - divisorBox.ww; ViewerOps.MoveViewer[divisorButton, invisibleX, divisorButton.wy, divisorButton.ww, divisorButton.wh, FALSE]; ViewerOps.MoveViewer[divisorBox, invisibleX, divisorBox.wy, divisorBox.ww, divisorBox.wh, FALSE]; needPaint _ TRUE; }; ENDCASE => ERROR; Buttons.ReLabel[dataTypeButton, SELECT dataType FROM CPU => "Watching: {CPU}", process => "Watching: {process number: ", breakProcess => "Watching: {break process}", pagefaults => "Watching: {pagefaults}", allocations => "Watching: {allocations}", wordsAllocated => "Watching: {wordsAllocated}", userDefined => "Watching: {user breaks}", ENDCASE => ERROR, NOT needPaint]; IF needPaint THEN ViewerOps.PaintViewer[spyViewer, client]; }; ToggleType: Buttons.ButtonProc = TRUSTED { SetDataType[SELECT mouseButton FROM red => IF dataType = LAST[SpyClient.DataType] THEN FIRST[SpyClient.DataType] ELSE SUCC[dataType], blue => IF dataType = FIRST[SpyClient.DataType] THEN LAST[SpyClient.DataType] ELSE PRED[dataType], ENDCASE => CPU]; }; <<**************************************************>> <> <<**************************************************>> cutoff: CARDINAL _ 3; cutoffButton: Buttons.Button; ToggleCutoff: Buttons.ButtonProc = TRUSTED { SELECT mouseButton FROM blue => IF cutoff > 0 THEN cutoff _ cutoff - 1; yellow => cutoff _ 3; red => IF cutoff < 100 THEN cutoff _ cutoff + 1; ENDCASE; SetCutoffButton[]; }; SetCutoffButton: PROC = { stream: IO.STREAM; stream _ IO.ROS[]; stream.Put[[rope["cutoff: {"]], [integer[cutoff]], [rope["}"]]]; Buttons.ReLabel[cutoffButton, IO.RopeFromROS[stream]]; stream.Close[]; }; DisplayData: Buttons.ButtonProc = TRUSTED { IF spyOn THEN StopSpy[]; SpyClient.DisplayData[cutoff, NIL, NIL, control]; IF control THEN SpyClient.DisplayData[cutoff, "Results of spying on Spy log."]; }; <<**************************************************>> <> <<**************************************************>> setStartBreakButton: Buttons.Button _ NIL; setStopBreakButton: Buttons.Button _ NIL; clearBreaksButton: Buttons.Button _ NIL; <> <> <> <> <> ClearBreaks: Buttons.ButtonProc = TRUSTED { SpyClient.ClearBreaks[]; typescript.Put[[rope["\nStart and Stop Breaks cleared.\n"]]]; break _ FALSE; StopSpy[]; }; SetStartBreak: Buttons.ButtonProc = TRUSTED { msg, name: ROPE; ok: BOOLEAN _ FALSE; section: AMModel.Section; [section, name, msg] _ LocationFromSelection[]; IF section # NIL OR name # NIL THEN [ok, msg] _ SpyClient.SetStartBreak[section, name]; typescript.Put[[character['\n]], [rope[msg]], [character['\n]]]; IF ~ok THEN RETURN; break _ TRUE; SetDataType[breakProcess]; StopSpy[]; }; SetStopBreak: Buttons.ButtonProc = TRUSTED { msg, name: ROPE; ok: BOOLEAN _ FALSE; section: AMModel.Section; [section, name, msg] _ LocationFromSelection[]; IF section # NIL OR name # NIL THEN [ok, msg] _ SpyClient.SetStopBreak[section, name]; typescript.Put[[character['\n]], [rope[msg]], [character['\n]]]; IF ~ok THEN RETURN; break _ TRUE; StopSpy[]; }; <<**************************************************>> << setting and clearing user breaks >> <<**************************************************>> setTraceButton: Buttons.Button _ NIL; setUserBreakButton: Buttons.Button _ NIL; clearUserBreaksButton: Buttons.Button _ NIL; ClearUserBreaks: Buttons.ButtonProc = TRUSTED { SpyClient.ClearUserBreaks[]; typescript.Put[[rope["\nUser Breaks cleared.\n"]]]; IF dataType = userDefined THEN StopSpy[]; }; SetUserBreak: Buttons.ButtonProc = TRUSTED { msg, name: ROPE; ok: BOOLEAN _ FALSE; section: AMModel.Section; [section, name, msg] _ LocationFromSelection[]; IF section # NIL OR name # NIL THEN IF clientData = $Trace THEN [ok, msg] _ SpyClient.SetTrace[section, name] ELSE [ok, msg] _ SpyClient.SetUserBreak[section, 1, name]; typescript.Put[[character['\n]], [rope[msg]], [character['\n]]]; IF ~ok THEN RETURN; StopSpy[]; IF dataType = userDefined THEN RETURN; SetDataType[userDefined]; }; LocationFromSelection: PROC RETURNS[section: AMModel.Section _ NIL, name, error: ROPE _ NIL] = { viewer: ViewerClasses.Viewer; viewer _ ViewerTools.GetSelectedViewer[]; IF viewer = NIL THEN RETURN [error: "no selected viewer"]; IF viewer.class.flavor # $Text OR ~Rope.Equal[Split[viewer.file].ext, "mesa"] THEN { module, proc: ROPE; contents: ROPE _ ViewerTools.GetSelectionContents[]; [module, proc] _ Split[contents]; IF module # NIL AND proc # NIL THEN RETURN[name: contents]; }; section _ AMViewerOps.SectionFromSelection[ ! AMTypes.Error => {error _ msg; CONTINUE}].section; }; Split: PROC [name: ROPE] RETURNS [root: Rope.Text, ext: Rope.Text _ NIL] = { name _ FS.ExpandName[name ! FS.Error => {name _ NIL; CONTINUE}].fullFName; IF name # NIL THEN { len: INT = Rope.Length[name]; dotIndex: INT _ len; bangIndex: INT _ len; pos: INT _ len; WHILE pos > 0 DO SELECT Rope.Fetch[name, pos _ pos - 1] FROM '! => bangIndex _ pos; '. => dotIndex _ pos; '], '>, '/ => EXIT; ENDCASE; ENDLOOP; IF dotIndex >= bangIndex THEN root _ Rope.Flatten[name] ELSE { root _ name.Flatten[0, dotIndex]; ext _ name.Flatten[dotIndex+1, bangIndex-dotIndex-1]; }; }; }; Commander.Register[key: "Spy", proc: Spy, doc: "spies on program performance"]; }. <> <> <<>>