[squeak-dev] The Trunk: System-ar.242.mczcommits at source.squeak.org commits at source.squeak.orgThu Feb 4 05:35:49 UTC 2010
Andreas Raab uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ar.242.mcz ==================== Summary ==================== Name: System-ar.242 Author: ar Time: 3 February 2010, 9:34:48.402 pm UUID: f0907bbe-46a2-a840-bcd8-afb5a10f16b0 Ancestors: System-dtl.241 Merge latest MessageTally changes from Cuis. =============== Diff against System-dtl.241 =============== Item was added: + ----- Method: MessageTally>>leavesPrintExactOn: (in category 'printing') ----- + leavesPrintExactOn: aStream + | dict | + dict := IdentityDictionary new: 100. + self leavesInto: dict fromSender: nil. + dict asSortedCollection + do: [ :node | + node printOn: aStream total: tally totalTime: nil tallyExact: true. + node printSenderCountsOn: aStream ]! Item was changed: ----- Method: MessageTally>>spyEvery:onProcess:forMilliseconds: (in category 'initialize-release') ----- spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration "Create a spy and spy on the given process at the specified rate." + | myDelay startTime time0 endTime observedProcess sem | - | myDelay time0 endTime sem observedProcess | (aProcess isKindOf: Process) ifFalse: [self error: 'spy needs a Process here']. self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method. "set up the probe" observedProcess := aProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. endTime := time0 + msecDuration. sem := Semaphore new. gcStats := SmalltalkImage current getVMParameters. + Timer ifNotNil: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime | [ startTime := Time millisecondClockValue. myDelay wait. + self + tally: Processor preemptedProcess suspendedContext + in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) - self tally: Processor preemptedProcess suspendedContext - in: (ShowProcesses ifTrue: [ - observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs. startTime < endTime ] whileTrue. sem signal. ] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. "activate the probe and wait for it to finish" sem wait. "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - gcStats at: idx)]. time := Time millisecondClockValue - time0! Item was changed: ----- Method: MessageTally>>tally:by: (in category 'tallying') ----- tally: context by: count "Explicitly tally the specified context and its stack." | sender | "Add to this node if appropriate" context method == method ifTrue: [^self bumpBy: count]. "No sender? Add new branch to the tree." + (sender := context home sender)ifNil: [ - (sender := context home sender)ifNil: [ ^ (self bumpBy: count) tallyPath: context by: count]. "Find the node for the sending context (or add it if necessary)" ^ (self tally: sender by: count) tallyPath: context by: count! Item was changed: ----- Method: MessageTally class>>tallySendsTo:inBlock:showTree: (in category 'spying') ----- tallySendsTo: receiver inBlock: aBlock showTree: treeOption + " + MessageTally tallySends: [3.14159 printString] + " - "MessageTally tallySends: [3.14159 printString]" "This method uses the simulator to count the number of calls on each method invoked in evaluating aBlock. If receiver is not nil, then only sends to that receiver are tallied. Results are presented as leaves, sorted by frequency, preceded, optionally, by the whole tree." | prev tallies startTime totalTime | startTime := Time millisecondClockValue. + tallies := MessageTally new class: aBlock receiver class method: aBlock method. + tallies reportOtherProcesses: true. "Do NOT filter nodes with nil process" - tallies := MessageTally new class: aBlock receiver class - method: aBlock method. prev := aBlock. thisContext sender runSimulated: aBlock contextAtEachStep: [:current | current == prev ifFalse: ["call or return" prev sender == nil ifFalse: ["call only" (receiver == nil or: [current receiver == receiver]) ifTrue: [tallies tally: current by: 1]]. prev := current]]. totalTime := Time millisecondClockValue - startTime // 1000.0 roundTo: 0.01. (StringHolder new contents: (String streamContents: [:s | s nextPutAll: 'This simulation took ' , totalTime printString , ' seconds.'; cr. treeOption + ifTrue: [ tallies fullPrintExactOn: s ] + ifFalse: [ tallies leavesPrintExactOn: s ]. + tallies close ])) - ifTrue: [tallies fullPrintOn: s tallyExact: true orThreshold: 0] - ifFalse: [tallies leavesPrintOn: s tallyExact: true orThreshold: 0]. - tallies close])) openLabel: 'Spy Results'! Item was added: + ----- Method: MessageTally>>rootPrintOn:total:totalTime:threshold: (in category 'printing') ----- + rootPrintOn: aStream total: total totalTime: totalTime threshold: threshold + + | sons groups p | + sons := self sonsOver: threshold. + groups := sons groupBy: [ :aTally | aTally process] having: [ :g | true]. + groups do:[:g| + sons := g asSortedCollection. + p := g anyOne process. + (reportOtherProcesses or: [ p notNil ]) ifTrue: [ + aStream nextPutAll: '--------------------------------'; cr. + aStream nextPutAll: 'Process: ', (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr. + aStream nextPutAll: '--------------------------------'; cr. + (1 to: sons size) do:[:i | + (sons at: i) + treePrintOn: aStream + tabs: OrderedCollection new + thisTab: '' + total: total + totalTime: totalTime + tallyExact: false + orThreshold: threshold]]. + ]! Item was added: + ----- Method: MessageTally class>>spyOn:toFileNamed:reportOtherProcesses: (in category 'spying') ----- + spyOn: aBlock toFileNamed: fileName reportOtherProcesses: aBoolean + "Spy on the evaluation of aBlock. Write the data collected on a file + named fileName." + + | file value node | + node := self new. + node reportOtherProcesses: aBoolean. + value := node spyEvery: self defaultPollPeriod on: aBlock. + file := FileStream newFileNamed: fileName. + node report: file; close. + file close. + ^value! Item was changed: ----- Method: MessageTally>>spyAllEvery:on: (in category 'initialize-release') ----- spyAllEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy all the system processes" + | myDelay startTime time0 observedProcess | + (aBlock isMemberOf: BlockClosure) - | myDelay time0 | - (aBlock isBlock) ifFalse: [self error: 'spy needs a block here']. self class: aBlock receiver class method: aBlock method. "set up the probe" myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. gcStats := SmalltalkImage current getVMParameters. + Timer ifNotNil: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime observedProcess | [true] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. observedProcess := Processor preemptedProcess. + self + tally: observedProcess suspendedContext + in: observedProcess - self tally: observedProcess suspendedContext - in: (ShowProcesses ifTrue: [observedProcess]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - (gcStats at: idx))]. "cancel the probe and return the value" Timer terminate. + Timer := nil. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>leavesInto:fromSender: (in category 'collecting leaves') ----- leavesInto: leafDict fromSender: senderTally + | rcvrs | + rcvrs := self sonsOver: 0. - rcvrs _ self sonsOver: 0. rcvrs size = 0 + ifTrue: [ self into: leafDict fromSender: senderTally ] - ifTrue: [self into: leafDict fromSender: senderTally] ifFalse: [ + (reportOtherProcesses not and: [ rcvrs anyOne process isNil ]) ifTrue: [ + ^self]. - "Do not show 'other processes' " - "Please keep consistency with #rootPrintOn:total:totalTime:tallyExact:orThreshold: - on showing them or not!!" - rcvrs anyOne process ifNil: [^self]. + rcvrs do: [ :node | - rcvrs do: - [:node | node isPrimitives + ifTrue: [ node leavesInto: leafDict fromSender: senderTally ] + ifFalse: [ node leavesInto: leafDict fromSender: self ]]]! - ifTrue: [node leavesInto: leafDict fromSender: senderTally] - ifFalse: [node leavesInto: leafDict fromSender: self]]]! Item was changed: ----- Method: MessageTally>>printSenderCountsOn: (in category 'printing') ----- printSenderCountsOn: aStream + | mergedSenders mergedNode | - | mergedSenders | mergedSenders := IdentityDictionary new. senders do: + [:node | - [:node | | mergedNode | mergedNode := mergedSenders at: node method ifAbsent: [nil]. mergedNode == nil ifTrue: [mergedSenders at: node method put: node] ifFalse: [mergedNode bump: node tally]]. mergedSenders asSortedCollection do: [:node | 10 to: node tally printString size by: -1 do: [:i | aStream space]. node printOn: aStream total: tally totalTime: nil tallyExact: true]! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- + spyEvery: millisecs on: aBlock - spyEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy only on the active process (in which aBlock is run)" + | myDelay startTime time0 observedProcess | + (aBlock isMemberOf: BlockClosure) - | myDelay time0 observedProcess | - aBlock isBlock ifFalse: [self error: 'spy needs a block here']. self class: aBlock receiver class method: aBlock method. "set up the probe" + observedProcess := Processor activeProcess. - observedProcess _ Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. gcStats := SmalltalkImage current getVMParameters. + Timer ifNotNil: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime | [true] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. + self + tally: Processor preemptedProcess suspendedContext + in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) - self tally: Processor preemptedProcess suspendedContext - in: (ShowProcesses ifTrue: [ - observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - (gcStats at: idx))]. "cancel the probe and return the value" + Timer terminate. + Timer := nil. - Timer ifNotNil: [ Timer terminate ]. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>treePrintOn:tabs:thisTab:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold + | sons sonTab | - | sons | tabs do: [:tab | aStream nextPutAll: tab]. tabs size > 0 ifTrue: [self printOn: aStream total: total totalTime: totalTime tallyExact: isExact]. sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold]. sons isEmpty ifFalse: [tabs addLast: myTab. sons := sons asSortedCollection. (1 to: sons size) do: + [:i | - [:i | | sonTab | sonTab := i < sons size ifTrue: [' |'] ifFalse: [' ']. (sons at: i) treePrintOn: aStream tabs: (tabs size < self maxTabs ifTrue: [tabs] ifFalse: [(tabs select: [:x | x = '[']) copyWith: '[']) thisTab: sonTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold]. tabs removeLast]! Item was changed: ----- Method: MessageTally class>>spyOnProcess:forMilliseconds: (in category 'spying') ----- spyOnProcess: aProcess forMilliseconds: msecDuration + "Spy on aProcess for a certain amount of time - " | p1 p2 | + p1 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess. + p2 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess. + p1 resume. + p2 resume. - p1 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. - p2 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. (Delay forMilliseconds: 100) wait. MessageTally spyOnProcess: p1 forMilliseconds: 1000 " + ^self spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: ShowProcesses + ! - | node | - node := self new. - node - spyEvery: self defaultPollPeriod - onProcess: aProcess - forMilliseconds: msecDuration. - (StringHolder new - contents: (String - streamContents: [:s | node report: s; - close])) - openLabel: 'Spy Results'! Item was changed: ----- Method: MessageTally class>>spyAllOn: (in category 'spying') ----- spyAllOn: aBlock "Spy on all the processes in the system [1000 timesRepeat: [3.14159 printString. Processor yield]] fork. [1000 timesRepeat: [20 factorial. Processor yield]] fork. [1000 timesRepeat: [20 factorial. Processor yield]] fork. MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] " | node result | node := self new. + node reportOtherProcesses: true. result := node spyAllEvery: self defaultPollPeriod on: aBlock. + self showReport: node. - (StringHolder new contents: (String streamContents: [:s | node report: s; close])) - openLabel: 'Spy Results'. ^ result! Item was changed: Magnitude subclass: #MessageTally + instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses' - instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' classVariableNames: 'DefaultPollPeriod ShowProcesses Timer' poolDictionaries: '' category: 'System-Tools'! + !MessageTally commentStamp: 'StephaneDucasse 9/27/2009 10:42' prior: 0! - !MessageTally commentStamp: 'nk 3/8/2004 12:43' prior: 0! My instances observe and report the amount of time spent in methods. + NOTE: a higher-level user interface (combining the MessageTally result tree with a method browser) is available from TimeProfileBrowser. Note that TimeProfileBrowser was not fancy with the different setting possibilities. - NOTE: a higher-level user interface (combining the MessageTally result tree with a method browser) is available from TimeProfileBrowser. + TimeProfileBrowser spyOn: [20 timesRepeat: + [Transcript show: 100 factorial printString]] + + + Strategies + ----------- MessageTally provides two different strategies available for profiling: + * spyOn: and friends use a high-priority Process to interrupt the block or process being spied on at periodic intervals. The interrupted call stack is then examined for caller information. See below for an example showing different settings - * spyOn: and friends use a high-priority Process to interrupt the block or process being spied on at periodic intervals. The interrupted call stack is then examined for caller information. * tallySends: and friends use the interpreter simulator to run the block, recording every method call. The two give you different results: + * spyOn: gives you a view of where the time is being spent in your program, at least on a rough statistical level (assuming you've run the block for long enough and have a high enough poll rate). If you're trying to optimize your code, start here and optimize the methods where most of the time is being spent first. - * spyOn: gives you a view of where the time is being spent in your program, at least on a rough statistical level (assuming you've run the block for long enough and have a high enough poll rate). If you're trying to optimize your code, start here and optimize the methods where most of the time is being spent first. + * tallySends: gives you accurate counts of how many times methods get called, and by exactly which route. If you're debugging, or trying to figure out if a given method is getting called too many times, this is your tool. - * tallySends: gives you accurate counts of how many times methods get called, and by exactly which route. If you're debugging, or trying to figure out if a given method is getting called too many times, this is your tool. + Q: How do you interpret MessageTally>>tallySends + A: The methods #tallySends and #spyOn: measure two very different quantities, but broken down in the same who-called-who format. #spyOn: is approximate, but more indicative of real time spent, whereas #tallySends is exact and a precise record of how many times each method got executed. + + Examples + ---------- + + Here you can see all the processes computation time + + [1000 timesRepeat: [3.14159 printString. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] + + + Settings + --------- You can change the printing format (that is, the whitespace and string compression) by using these instance methods: maxClassNameSize: maxClassPlusSelectorSize: maxTabs: You can change the default polling period (initially set to 1) by calling MessageTally defaultPollPeriod: numberOfMilliseconds + + To understand the difference + ---------------------------------- + Here we see all the processes + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally spyAllOn: [10000 timesRepeat: [1.23 printString]] + + + Here we only see the execution of the expression [10000 timesRepeat: [1.23 printString] + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] + + Here we only check the exact message sends: this is not a pc-sampling approach + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally tallySends: [10000 timesRepeat: [1.23 printString]] + + + + ! - Q: How do you interpret MessageTally>>tallySends - A: The methods #tallySends and #spyOn: measure two very different quantities, but broken down in the same who-called-who format. #spyOn: is approximate, but more indicative of real time spent, whereas #tallySends is exact and a precise record of how many times each method got executed.! Item was changed: ----- Method: MessageTally>>tally:in:by: (in category 'tallying') ----- tally: context in: aProcess by: count "Explicitly tally the specified context and its stack." | sender | "Add to this node if appropriate" context method == method ifTrue: [^self bumpBy: count]. "No sender? Add new branch to the tree." + (sender := context home sender) ifNil: [ - (sender := context home sender) ifNil: [ ^ (self bumpBy: count) tallyPath: context in: aProcess by: count]. "Find the node for the sending context (or add it if necessary)" ^ (self tally: sender in: aProcess by: count) tallyPath: context in: aProcess by: count! Item was added: + ----- Method: MessageTally>>reportOtherProcesses (in category 'accessing') ----- + reportOtherProcesses + "If true, reports all processes in the system" + ^reportOtherProcesses! Item was changed: ----- Method: MessageTally>>into:fromSender: (in category 'collecting leaves') ----- into: leafDict fromSender: senderTally | leafNode | + leafNode := leafDict at: method - leafNode _ leafDict at: method ifAbsent: [leafDict at: method put: ((MessageTally new class: class method: method) + process: process; + reportOtherProcesses: reportOtherProcesses)]. - process: process)]. leafNode bump: tally fromSender: senderTally! Item was changed: ----- Method: MessageTally>>tallyPath:in:by: (in category 'tallying') ----- tallyPath: context in: aProcess by: count | aMethod path | aMethod := context method. "Find the correct child (if there)" receivers do: [ :oldTally | (oldTally method == aMethod and: [oldTally process == aProcess]) ifTrue: [path := oldTally]]. "Add new child if needed" path ifNil:[ path := MessageTally new class: context receiver class method: aMethod; process: aProcess; + reportOtherProcesses: reportOtherProcesses; maxClassNameSize: maxClassNameSize; maxClassPlusSelectorSize: maxClassPlusSelectorSize; maxTabs: maxTabs. receivers := receivers copyWith: path]. ^ path bumpBy: count! Item was changed: + ----- Method: MessageTally>>initialize (in category 'initialization') ----- - ----- Method: MessageTally>>initialize (in category 'initialize-release') ----- initialize + "Initialize the receiver" + super initialize. maxClassNameSize := self class defaultMaxClassNameSize. maxClassPlusSelectorSize := self class defaultMaxClassPlusSelectorSize. + maxTabs := self class defaultMaxTabs. + reportOtherProcesses := false. + ! - maxTabs := self class defaultMaxTabs.! Item was changed: ----- Method: MessageTally>>copyWithTally: (in category 'private') ----- copyWithTally: hitCount + ^ (MessageTally new class: class method: method) + reportOtherProcesses: reportOtherProcesses; - ^ (MessageTally new class: class method: method) process: process; bump: hitCount! Item was added: + ----- Method: MessageTally>>fullPrintOn:threshold: (in category 'printing') ----- + fullPrintOn: aStream threshold: perCent + | threshold | + threshold := (perCent asFloat / 100 * tally) rounded. + aStream nextPutAll: '**Tree**'; cr. + self + rootPrintOn: aStream + total: tally + totalTime: time + threshold: threshold. + aStream nextPut: Character newPage; cr. + aStream nextPutAll: '**Leaves**'; cr. + self + leavesPrintOn: aStream + threshold: threshold! Item was added: + ----- Method: MessageTally>>fullPrintExactOn: (in category 'printing') ----- + fullPrintExactOn: aStream + aStream nextPutAll: '**Tree**'; cr. + self + treePrintOn: aStream + tabs: OrderedCollection new + thisTab: '' + total: tally + totalTime: time + tallyExact: true + orThreshold: nil. + aStream nextPut: Character newPage; cr. + aStream nextPutAll: '**Leaves**'; cr. + self leavesPrintExactOn: aStream! Item was added: + ----- Method: MessageTally class>>spyOnProcess:forMilliseconds:toFileNamed:reportOtherProcesses: (in category 'spying') ----- + spyOnProcess: aProcess forMilliseconds: msecDuration toFileNamed: fileName reportOtherProcesses: aBoolean + "Spy on the evaluation of aProcess. Write the data collected on a file + named fileName. Will overwrite fileName" + | file node | + node := self new. + node reportOtherProcesses: aBoolean. + node + spyEvery: self defaultPollPeriod + onProcess: aProcess + forMilliseconds: msecDuration. + file := FileStream fileNamed: fileName. + node report: file; + close. + file close! Item was changed: ----- Method: MessageTally class>>tallySends: (in category 'spying') ----- + tallySends: aBlock + " + MessageTally tallySends: [3.14159 printString] + " + - tallySends: aBlock "MessageTally tallySends: [3.14159 printString]" ^ self tallySendsTo: nil inBlock: aBlock showTree: true! Item was changed: ----- Method: MessageTally>>report:cutoff: (in category 'reporting') ----- report: strm cutoff: threshold tally = 0 ifTrue: [strm nextPutAll: ' - no tallies obtained'] ifFalse: [strm nextPutAll: ' - '; print: tally; nextPutAll: ' tallies, ', time printString, ' msec.'; cr; cr. + self fullPrintOn: strm threshold: threshold]. - self fullPrintOn: strm tallyExact: false orThreshold: threshold]. time isZero ifFalse: [self reportGCStatsOn: strm].! Item was added: + ----- Method: MessageTally class>>showReport: (in category 'spying') ----- + showReport: node + "Open a string holder with the reports from the given node" + (StringHolder new contents: + (String streamContents: [:s | node report: s; close])) + openLabel: 'Spy Results'! Item was added: + ----- Method: MessageTally>>reportOtherProcesses: (in category 'accessing') ----- + reportOtherProcesses: aBoolean + "If true, reports all processes in the system" + reportOtherProcesses := aBoolean! Item was added: + ----- Method: MessageTally class>>spyOnProcess:forMilliseconds:reportOtherProcesses: (in category 'spying') ----- + spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: aBoolean + "Spy on aProcess for a certain amount of time + | p1 p2 | + p1 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess. + p2 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess. + p1 resume. + p2 resume. + (Delay forMilliseconds: 100) wait. + MessageTally spyOnProcess: p1 forMilliseconds: 1000 reportOtherProcesses: true + " + | node | + node := self new. + node reportOtherProcesses: aBoolean. + node + spyEvery: self defaultPollPeriod + onProcess: aProcess + forMilliseconds: msecDuration. + self showReport: node.! Item was added: + ----- Method: MessageTally class>>spyOn:reportOtherProcesses: (in category 'spying') ----- + spyOn: aBlock reportOtherProcesses: aBoolean + "Spy on aBlock, in the current process. Can include or not statistics on other processes in the report. + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] reportOtherProcesses: true + " + | node result | + node := self new. + node reportOtherProcesses: aBoolean. + result := node spyEvery: self defaultPollPeriod on: aBlock. + self showReport: node. + ^ result! Item was changed: ----- Method: MessageTally>>sonsOver: (in category 'comparing') ----- sonsOver: threshold | hereTally last sons | (receivers == nil or: [receivers size = 0]) ifTrue: [^#()]. + hereTally := tally. + sons := receivers select: "subtract subNode tallies for primitive hits here" - hereTally _ tally. - sons _ receivers select: "subtract subNode tallies for primitive hits here" [:son | + hereTally := hereTally - son tally. - hereTally _ hereTally - son tally. son tally > threshold]. hereTally > threshold + ifTrue: [ + last := MessageTally new class: class method: method. - ifTrue: - [last _ MessageTally new class: class method: method. last process: process. + last reportOtherProcesses: reportOtherProcesses. ^sons copyWith: (last primitives: hereTally)]. ^sons! Item was changed: ----- Method: MessageTally class>>spyOn: (in category 'spying') ----- spyOn: aBlock + "Spy on aBlock, in the current process. Can include or not statistics on other processes in the report. - " [1000 timesRepeat: [ 100 timesRepeat: [120 factorial]. (Delay forMilliseconds: 10) wait ]] forkAt: 45 named: '45'. MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] " + ^self spyOn: aBlock reportOtherProcesses: ShowProcesses! - | node result | - node _ self new. - result _ node spyEvery: self defaultPollPeriod on: aBlock. - (StringHolder new contents: (String streamContents: [:s | node report: s; close])) - openLabel: 'Spy Results'. - ^ result! Item was changed: ----- Method: MessageTally>>close (in category 'initialize-release') ----- close + Timer ifNotNil: [ Timer terminate ]. - (Timer isMemberOf: Process) ifTrue: [Timer terminate]. Timer := nil. class := method := tally := receivers := nil! Item was changed: ----- Method: MessageTally>>tallyPath:by: (in category 'tallying') ----- tallyPath: context by: count | aMethod path | + aMethod := context method. - aMethod :=context method. "Find the correct child (if there)" receivers do: [ :oldTally | oldTally method == aMethod ifTrue: [path := oldTally]]. "Add new child if needed" path ifNil: [ path := MessageTally new class: context receiver class method: aMethod. + path reportOtherProcesses: reportOtherProcesses. receivers := receivers copyWith: path]. ^ path bumpBy: count! Item was added: + ----- Method: MessageTally>>leavesPrintOn:threshold: (in category 'printing') ----- + leavesPrintOn: aStream threshold: threshold + | dict | + dict := IdentityDictionary new: 100. + self leavesInto: dict fromSender: nil. + (dict asOrderedCollection + select: [:node | node tally > threshold]) + asSortedCollection do: [:node | + node printOn: aStream total: tally totalTime: time tallyExact: false ]! Item was removed: - ----- Method: MessageTally>>fullPrintOn:tallyExact:orThreshold: (in category 'printing') ----- - fullPrintOn: aStream tallyExact: isExact orThreshold: perCent - | threshold | - isExact ifFalse: [threshold _ (perCent asFloat / 100 * tally) rounded]. - aStream nextPutAll: '**Tree**'; cr. - self rootPrintOn: aStream - total: tally - totalTime: time - tallyExact: isExact - orThreshold: threshold. - aStream nextPut: Character newPage; cr. - aStream nextPutAll: '**Leaves**'; cr. - self leavesPrintOn: aStream - tallyExact: isExact - orThreshold: threshold! Item was removed: - ----- Method: MessageTally>>rootPrintOn:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- - rootPrintOn: aStream total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold - | groups sons | - ShowProcesses ifFalse:[ - ^self treePrintOn: aStream - tabs: OrderedCollection new - thisTab: '' - total: total - totalTime: totalTime - tallyExact: isExact - orThreshold: threshold. - ]. - sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold]. - groups := sons groupBy:[:aTally| aTally process] having:[:g| true]. - groups do:[:g| | p | - sons := g asSortedCollection. - p := g anyOne process. - "Do not show 'other processes' " - "Please keep consistency with #leavesInto:fromSender: - on showing them or not!!" - p ifNotNil: [ - aStream nextPutAll: '--------------------------------'; cr. - aStream nextPutAll: 'Process: ', (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr. - aStream nextPutAll: '--------------------------------'; cr. - (1 to: sons size) do:[:i | - (sons at: i) - treePrintOn: aStream - tabs: OrderedCollection new - thisTab: '' - total: total - totalTime: totalTime - tallyExact: isExact - orThreshold: threshold]]. - ].! Item was removed: - ----- Method: MessageTally>>leavesPrintOn:tallyExact:orThreshold: (in category 'printing') ----- - leavesPrintOn: aStream tallyExact: isExact orThreshold: threshold - | dict | - dict := IdentityDictionary new: 100. - self leavesInto: dict fromSender: nil. - isExact ifTrue: - [dict asSortedCollection - do: [:node | - node printOn: aStream total: tally totalTime: nil tallyExact: isExact. - node printSenderCountsOn: aStream]] - ifFalse: - [(dict asOrderedCollection - select: [:node | node tally > threshold]) - asSortedCollection - do: [:node | - node printOn: aStream total: tally totalTime: time tallyExact: isExact]]!
More information about the Squeak-dev mailing list |