[squeak-dev] The Trunk: System-ar.140.mczcommits at source.squeak.org commits at source.squeak.orgFri Sep 4 07:12:49 UTC 2009
Andreas Raab uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ar.140.mcz ==================== Summary ==================== Name: System-ar.140 Author: ar Time: 4 September 2009, 12:10:59 pm UUID: f149b02b-e23d-fa48-b523-dfc2539b8878 Ancestors: System-ar.139 http://bugs.squeak.org/view.php?id=7301 Change Set: MessageTallyEnh-ar-jmv Date: 4 March 2009 Author: Andreas Raab Improve MessageTally to provide cross-process profiling. =============== Diff against System-ar.139 =============== Item was changed: ----- Method: MessageTally>>fullPrintOn:tallyExact:orThreshold: (in category 'printing') ----- fullPrintOn: aStream tallyExact: isExact orThreshold: perCent | threshold | + isExact ifFalse: [threshold _ (perCent asFloat / 100 * tally) rounded]. - isExact ifFalse: [threshold := (perCent asFloat / 100 * tally) rounded]. aStream nextPutAll: '**Tree**'; cr. + self rootPrintOn: aStream - self treePrintOn: aStream - tabs: OrderedCollection new - thisTab: '' 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 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. + last process: process. - [last := MessageTally new class: class method: method. ^sons copyWith: (last primitives: hereTally)]. ^sons! Item was changed: ----- Method: MessageTally>>close (in category 'initialize-release') ----- close (Timer isMemberOf: Process) ifTrue: [Timer terminate]. + Timer := nil. - Timer := ObservedProcess := nil. class := method := tally := receivers := nil! Item was added: + ----- 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 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 := [ + [true] whileTrue: [ + startTime := Time millisecondClockValue. + myDelay wait. + observedProcess := Processor preemptedProcess. + 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. + time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>tallyPath:by: (in category 'tallying') ----- tallyPath: context by: count | aMethod path | + 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. - aMethod := context method. - receivers do: - [:aMessageTally | - aMessageTally method == aMethod ifTrue: [path := aMessageTally]]. - path == nil ifTrue: - [path := MessageTally new class: context receiver class method: aMethod; - maxClassNameSize: maxClassNameSize; - maxClassPlusSelectorSize: maxClassPlusSelectorSize; - maxTabs: maxTabs. receivers := receivers copyWith: path]. + ^ path bumpBy: count! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- 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: BlockContext) + ifFalse: [self error: 'spy needs a block here']. + self class: aBlock receiver class method: aBlock method. - | myDelay startTime time0 | - aBlock isBlock - ifTrue: [self class: aBlock receiver class method: aBlock method] - ifFalse: [self class: aBlock 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 := [ + [true] whileTrue: [ + startTime := Time millisecondClockValue. - Timer := - [[true] whileTrue: - [startTime := Time millisecondClockValue. myDelay wait. + self tally: Processor preemptedProcess suspendedContext + in: (ShowProcesses ifTrue: [ + observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]]) - self tally: ObservedProcess suspendedContext "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. + Timer priority: Processor timingPriority-1. - Timer priority: Processor userInterruptPriority. "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))]. - ^ 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. time := Time millisecondClockValue - time0]! Item was added: + ----- Method: MessageTally>>rootPrintOn:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- + rootPrintOn: aStream total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold + | sons groups p | + 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| + 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 changed: ----- Method: MessageTally>>report: (in category 'reporting') ----- report: strm "Print a report, with cutoff percentage of each element of the tree + (leaves, roots, tree), on the stream, strm." - (leaves, roots, tree)=2, on the stream, strm." + self report: strm cutoff: 1! - self report: strm cutoff: 2! Item was changed: Magnitude subclass: #MessageTally + instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' + classVariableNames: 'DefaultPollPeriod ShowProcesses Timer' - instanceVariableNames: 'class method tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' - classVariableNames: 'DefaultPollPeriod ObservedProcess Timer' poolDictionaries: '' category: 'System-Tools'! !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. 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. * 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. * 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. 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 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>>= (in category 'comparing') ----- = aMessageTally self species == aMessageTally species ifFalse: [^ false]. + ^ aMessageTally method == method and:[aMessageTally process == process]! - ^ aMessageTally method == method! Item was changed: ----- Method: MessageTally class>>defaultMaxTabs (in category 'defaults') ----- defaultMaxTabs "Return the default number of tabs after which leading white space is compressed" + ^120! - ^40! Item was changed: ----- Method: MessageTally class>>spyOn: (in category 'spying') ----- + spyOn: aBlock + " + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] + " - spyOn: aBlock "MessageTally spyOn: [100 timesRepeat: [3.14159 printString]]" | node result | + node _ self new. + result _ node spyEvery: self defaultPollPeriod on: aBlock. - 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>>tally:by: (in category 'tallying') ----- tally: context by: count "Explicitly tally the specified context and its stack." + | sender | + + "Add to this node if appropriate" - | root | context method == method ifTrue: [^self bumpBy: count]. + + "No sender? Add new branch to the tree." + (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! - (root := context home sender) == nil - ifTrue: [^ (self bumpBy: count) tallyPath: context by: count]. - ^ (self tally: root by: count) tallyPath: context by: count! 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] + ifFalse: [ + + "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: - ifFalse: [rcvrs do: [:node | node isPrimitives ifTrue: [node leavesInto: leafDict fromSender: senderTally] ifFalse: [node leavesInto: leafDict fromSender: self]]]! Item was added: + ----- 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. + result := node spyAllEvery: self defaultPollPeriod on: aBlock. + (StringHolder new contents: (String streamContents: [:s | node report: s; close])) + openLabel: 'Spy Results'. + ^ result! Item was changed: ----- Method: MessageTally class>>spyOnProcess:forMilliseconds: (in category 'spying') ----- spyOnProcess: aProcess forMilliseconds: msecDuration + " + | p1 p2 | + p1 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. + p2 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. - "| p | - p := [100000 timesRepeat: [3.14159 printString]] fork. (Delay forMilliseconds: 100) wait. + MessageTally spyOnProcess: p1 forMilliseconds: 1000 + " - MessageTally spyOnProcess: p forMilliseconds: 1000" | 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>>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)]. - put: (MessageTally new class: class method: method)]. leafNode bump: tally fromSender: senderTally! Item was added: + ----- 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; + maxClassNameSize: maxClassNameSize; + maxClassPlusSelectorSize: maxClassPlusSelectorSize; + maxTabs: maxTabs. + receivers := receivers copyWith: path]. + + ^ path bumpBy: count! Item was added: + ----- Method: MessageTally>>process: (in category 'private') ----- + process: aProcess + process := aProcess! Item was changed: ----- Method: MessageTally>>copyWithTally: (in category 'private') ----- copyWithTally: hitCount + ^ (MessageTally new class: class method: method) + process: process; + bump: hitCount! - ^ (MessageTally new class: class method: method) bump: hitCount! Item was added: + ----- Method: MessageTally class>>showProcesses (in category 'defaults') ----- + showProcesses + "Indicates whether to show each process separately or cumulatively. + For example, compare the spy results of the following with both values: + + [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] + + " + <preference: 'Show Tally Processes' + category: 'debug' + description: 'When true, show individual processes in MessageTally' + type: #Boolean> + ^ShowProcesses! Item was added: + ----- Method: MessageTally class>>initialize (in category 'class initialization') ----- + initialize + "MessageTally initialize" + "By default, show each process separately" + ShowProcesses := true! Item was added: + ----- Method: MessageTally>>process (in category 'private') ----- + process + ^process! Item was added: + ----- Method: MessageTally class>>showProcesses: (in category 'defaults') ----- + showProcesses: aBool + "Indicates whether to show each process separately or cumulatively. + For example, compare the spy results of the following with both values: + + [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] + + " + ShowProcesses := aBool.! Item was added: + ----- 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: [ + ^ (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 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 sem observedProcess | - | myDelay time0 endTime sem | (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. - ObservedProcess := aProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. endTime := time0 + msecDuration. sem := Semaphore new. + gcStats := SmalltalkImage current getVMParameters. + Timer := [ + [ + startTime := Time millisecondClockValue. + myDelay wait. + 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. - gcStats := SmalltalkImage current getVMParameters. - Timer := [[| startTime | - startTime := Time millisecondClockValue. - myDelay wait. - self tally: ObservedProcess suspendedContext by: Time millisecondClockValue - startTime // millisecs. - startTime < endTime] whileTrue. - sem signal] - forkAt: (ObservedProcess priority + 1 min: Processor highestPriority). "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)]. - SmalltalkImage current getVMParameters keysAndValuesDo: - [:idx :gcVal| gcStats at: idx put: (gcVal - gcStats at: idx)]. time := Time millisecondClockValue - time0!
More information about the Squeak-dev mailing list |