Hi Andreas,
Andreas Raab wrote:
Juan Vuletich wrote:
I understand that for a server having an variable (and big) number of processes it is not useful. But for our case, an application with a small and fixed set of processes, the first question we want to answer is "which is the process using all the cpu?". Please see the message I just sent on this thread to see an example of what I want.
Okay, I cracked ;-) Attached you'll find patches for a message tally version which does per-process reporting if so desired. I've moved this out of the arguments and into class variables so you get/set either priority or preference via, e.g.:
MessageTally spyPriority: <new priority> MessageTally showProcesses: <true/false>
The defaults are such that the priority is TimerPriority-1 and showProcesses is on. With it, your example gives the result shown below.
Let me know if this works for you (or anyone else). Comments welcome.
Cheers,
- Andreas
Thank you! After wasting many hours on the idea of attaching the firstContext to each process, I also realized it is not necessary at all. But before I could get the tallies properly built, I went to sleep, and you did it! Thanks! I found a small bug, though. You forgot to actually use the class var SpyPriority.
The attached change is based on yours, but with a few differences (some of them you might like, some others you might not like :)
- If you tally a single process via #spyEvery:onProcess:forMilliseconds: (for example using the option in the ProcessBrowser) you'll get bogus results, as all tallies are captured as if they belonged to the observed process. I fixed it. This one is important.
- I left the old #spyOn: for spying on a single process, with the fix I just mentioned to report realistic results. I added #spyAllOn: to spy on all the running processes. I believe many times one might want to spy on just one process.
- I removed the SpyPriority classVar. If spying on all processes, I use a really high priority. If spying on single process, I use a slightly higher priority than his (using a a really high priority would not hurt, though). This is just a matter of taste.
- I removed the old ObservedProcess class var, as it is no longer necessary.
- Allowed for more visible tabs (just cosmetic).
- Show nodes using more than 1% (instead of 2%). Not very important.
- Modified the menu options in World menu / Debug, to allow for both tallyin the UI or all the system, and to make this clear.
That's all. I hope you and others find it useful.
Cheers, Juan Vuletich
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 4 March 2009 at 10:44:49 am'! Magnitude subclass: #MessageTally instanceVariableNames: 'class method tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs process ' classVariableNames: 'DefaultPollPeriod ObservedProcess Timer ShowProcesses ' poolDictionaries: '' category: 'System-Tools'!
!MessageTally methodsFor: 'comparing' stamp: 'ar 3/3/2009 19:36'! = aMessageTally
self species == aMessageTally species ifFalse: [^ false]. ^ aMessageTally method == method and:[aMessageTally process == process]! !
!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 3/4/2009 10:35'! close
(Timer isMemberOf: Process) ifTrue: [Timer terminate]. Timer := nil. class := method := tally := receivers := nil! !
!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 3/4/2009 10:40'! 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: BlockContext) 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]! !
!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 3/4/2009 10:41'! 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. "set up the probe" observedProcess _ Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. gcStats := SmalltalkImage current getVMParameters. Timer := [ [true] whileTrue: [ Processor preemptedProcess == observedProcess ifTrue: [ startTime _ Time millisecondClockValue. myDelay wait. self tally: observedProcess suspendedContext in: observedProcess "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]]. nil] newProcess. Timer priority: (observedProcess priority + 1 min: Processor highestPriority). "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]! !
!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 3/4/2009 10:42'! 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 | (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 := [ [ startTime _ Time millisecondClockValue. Processor preemptedProcess == observedProcess ifTrue: [ myDelay wait. self tally: observedProcess suspendedContext in: observedProcess 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)]. time := Time millisecondClockValue - time0! !
!MessageTally methodsFor: 'printing' stamp: 'ar 3/3/2009 19:43'! 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! !
!MessageTally methodsFor: 'printing' stamp: 'ar 3/3/2009 19:47'! rootPrintOn: aStream total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold | sons groups | 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. aStream nextPutAll: '--------------------------------'; cr. aStream nextPutAll: 'Process: ', g anyOne process 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]. ].! !
!MessageTally methodsFor: 'reporting' stamp: 'jmv 3/4/2009 09:27'! report: strm "Print a report, with cutoff percentage of each element of the tree (leaves, roots, tree), on the stream, strm."
self report: strm cutoff: 1! !
!MessageTally methodsFor: 'tallying' stamp: 'jmv 3/4/2009 10:36'! 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: [ ^ (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! !
!MessageTally methodsFor: 'tallying' stamp: 'jmv 3/4/2009 09:42'! 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! !
!MessageTally methodsFor: 'tallying' stamp: 'jmv 3/4/2009 10:36'! 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. receivers := receivers copyWith: path]. ^ path bumpBy: count! !
!MessageTally methodsFor: 'tallying' stamp: 'jmv 3/4/2009 10:38'! 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! !
!MessageTally methodsFor: 'private' stamp: 'ar 3/3/2009 19:29'! process ^process! !
!MessageTally methodsFor: 'private' stamp: 'ar 3/3/2009 19:29'! process: aProcess process := aProcess! !
!MessageTally class methodsFor: 'defaults' stamp: 'jmv 3/2/2009 12:32'! defaultMaxTabs "Return the default number of tabs after which leading white space is compressed" ^120! !
!MessageTally class methodsFor: 'defaults' stamp: 'jmv 3/4/2009 10:29'! 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]
" ^ShowProcesses! !
!MessageTally class methodsFor: 'defaults' stamp: 'jmv 3/4/2009 10:29'! 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.! !
!MessageTally class methodsFor: 'spying' stamp: 'jmv 3/4/2009 10:42'! 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! !
!MessageTally class methodsFor: 'class initialization' stamp: 'jmv 3/4/2009 09:24'! initialize "MessageTally initialize" "By default, show each process separately" ShowProcesses := true! !
!TheWorldMenu methodsFor: 'commands' stamp: 'jmv 3/4/2009 10:43'! startMessageTally "Tally on all the processes in the system, and not only the UI" (self confirm: 'MessageTally all the processes in the system, until the mouse pointer goes to the top of the screen') ifTrue: [ MessageTally spyAllOn: [ [Sensor peekMousePt y > 0] whileTrue: [World doOneCycle]]]! !
!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 3/4/2009 10:44'! debugMenu
| menu |
menu _ self menu: 'debug...'. self fillIn: menu from: { { 'inspect world' . { #myWorld . #inspect } }. { 'explore world' . { #myWorld . #explore } }. { 'inspect model' . { self . #inspectWorldModel } }. " { 'talk to world...' . { self . #typeInMessageToWorld } }." { 'MessageTally all Processes' . { self . #startMessageTally } }. { 'MessageTally UI and browse' . { self . #startThenBrowseMessageTally } }. { 'open process browser' . { self . #openProcessBrowser } }. nil. "(self hasProperty: #errorOnDraw) ifTrue: Later make this come up only when needed." { 'start drawing again' . { #myWorld . #resumeAfterDrawError } }. { 'start stepping again' . { #myWorld . #resumeAfterStepError } }. nil. { 'call #tempCommand' . { #myWorld . #tempCommand } }. { 'define #tempCommand' . { #myWorld . #defineTempCommand } }. }. self haltOnceEnabled ifTrue: [menu add: 'disable halt/inspect once' translated target: menu action: #clearHaltOnce] ifFalse: [menu add: 'enable halt/inspect once' translated target: menu action: #setHaltOnce]. ^menu ! !
!TheWorldMenu methodsFor: '*Tools' stamp: 'jmv 3/4/2009 10:43'! startThenBrowseMessageTally "Tally only the UI process" (self confirm: 'MessageTally the UI process until the mouse pointer goes to the top of the screen') ifTrue: [TimeProfileBrowser onBlock: [[Sensor peekMousePt y > 10] whileTrue: [World doOneCycle]]]! !
MessageTally initialize! Magnitude subclass: #MessageTally instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' classVariableNames: 'DefaultPollPeriod ShowProcesses Timer' poolDictionaries: '' category: 'System-Tools'!