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
-------------- next part --------------
'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'!