Juan Vuletich wrote:
> ...
>
> - 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.
> ...
Thinking better about it, now I believe using any priority but the 
maximum possible is wrong. The new code uses Processor preemptedProcess 
to know which process we are tallying. But #preemptedProcess will never 
answer a process with higher priority than the current. This makes 
sense, otherwise it would be called #previousRunningProcess or something 
like that.

Now, let's suppose that the tally process wakes up after a higher 
priority process ends or yields, after using some cpu. #preemptedProcess 
will answer another process, one with lower priority, and its time slice 
will be added to it. So it will seem as if the higher priority process 
never ran and the lower priority one used all the time. This is an 
incorrect answer.

So this is a real bug. The attached version fixes this, and a couple of 
other bugs, especially when tallying a single process. So, please 
disregard the one I sent earlier. I also added acouple of examples in 
the comment in class methods.

Andreas, please take a look.

Thanks,
Juan Vuletich
-------------- next part --------------
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 4 March 2009 at 3:19:33 pm'!
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: 'collecting leaves' stamp: 'jmv 3/4/2009 13:48'!
into: leafDict fromSender: senderTally
	| leafNode |
	leafNode _ leafDict at: method
		ifAbsent: [leafDict at: method
			put: ((MessageTally new class: class method: method)
				process: process)].
	leafNode bump: tally fromSender: senderTally! !

!MessageTally methodsFor: 'collecting leaves' stamp: 'jmv 3/4/2009 14:33'!
leavesInto: leafDict fromSender: senderTally
	| rcvrs |
	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:
				[:node |
				node isPrimitives
					ifTrue: [node leavesInto: leafDict fromSender: senderTally]
					ifFalse: [node leavesInto: leafDict fromSender: self]]]! !

!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: 'comparing' stamp: 'jmv 3/4/2009 13:48'!
sonsOver: threshold

	| hereTally last sons |
	(receivers == nil or: [receivers size = 0]) ifTrue: [^#()].
	hereTally _ tally.
	sons _ receivers select:  "subtract subNode tallies for primitive hits here"
		[:son |
		hereTally _ hereTally - son tally.
		son tally > threshold].
	hereTally > threshold
		ifTrue: 
			[last _ MessageTally new class: class method: method.
			last process: process.
			^sons copyWith: (last primitives: hereTally)].
	^sons! !

!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 15:16'!
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: [
			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].
		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 15:18'!
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.
				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.
	"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: 'jmv 3/4/2009 15:19'!
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]].
	].! !

!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: 'jmv 3/4/2009 13:47'!
copyWithTally: hitCount
	^ (MessageTally new class: class method: method) 
		process: process;
		bump: hitCount! !

!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: 'spying' stamp: 'jmv 3/4/2009 15:12'!
spyOn: aBlock
	"
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]]
	"
	| 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! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 3/4/2009 15:13'!
spyOnProcess: aProcess forMilliseconds: msecDuration 
	"
	| p1 p2 |  
	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
	"
	| 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'! !

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