'From Cuis 1.0 of 4 September 2009 [latest update: #290] on 25 September 2009 at 8:51:50 am'!
!classDefinition: #MessageTally category: #'Tools-Debugger'!
Magnitude subclass: #MessageTally
	instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses '
	classVariableNames: 'DefaultPollPeriod ShowProcesses Timer '
	poolDictionaries: ''
	category: 'Tools-Debugger'!

!MessageTally methodsFor: 'collecting leaves' stamp: 'jmv 9/24/2009 16:10'!
into: leafDict fromSender: senderTally
	| leafNode |
	leafNode _ leafDict at: method
		ifAbsent: [leafDict at: method
			put: ((MessageTally new class: class method: method)
				process: process;
				reportOtherProcesses: reportOtherProcesses)].
	leafNode bump: tally fromSender: senderTally! !

!MessageTally methodsFor: 'collecting leaves' stamp: 'jmv 9/24/2009 16:07'!
leavesInto: leafDict fromSender: senderTally

	| rcvrs |
	rcvrs _ self sonsOver: 0.
	rcvrs size = 0
		ifTrue: [ self into: leafDict fromSender: senderTally ]
		ifFalse: [
			
			(reportOtherProcesses not and: [ rcvrs anyOne process isNil ]) ifTrue: [
				^self].
			
			rcvrs do: [ :node |
				node isPrimitives
					ifTrue: [ node leavesInto: leafDict fromSender: senderTally ]
					ifFalse: [ node leavesInto: leafDict fromSender: self ]]]! !

!MessageTally methodsFor: 'comparing' stamp: 'jmv 9/24/2009 16:11'!
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.
			last reportOtherProcesses: reportOtherProcesses.
			^sons copyWith: (last primitives: hereTally)].
	^sons! !

!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 9/25/2009 08:48'!
close

	Timer ifNotNil: [ Timer terminate ].
	Timer _ nil.
	class _ method _ tally _ receivers _ nil! !

!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 9/25/2009 08:49'!
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 _ Smalltalk getVMParameters.
	Timer ifNotNil: [ Timer terminate ].
	Timer _ [
		[true] whileTrue: [
			startTime := Time millisecondClockValue.
			myDelay wait.
			observedProcess := Processor preemptedProcess.
			self
				tally: observedProcess suspendedContext
				in: 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"
		Smalltalk 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]! !

!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 9/25/2009 08:49'!
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 _ Smalltalk getVMParameters.
	Timer ifNotNil: [ Timer terminate ].
	Timer _ [
		[true] whileTrue: [
			startTime := Time millisecondClockValue.
			myDelay wait.
			self
				tally: Processor preemptedProcess suspendedContext
				in: (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"
		Smalltalk 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]! !

!MessageTally methodsFor: 'initialize-release' stamp: 'jmv 9/25/2009 08:49'!
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 |
	(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 _ Smalltalk getVMParameters.
	Timer ifNotNil: [ Timer terminate ].
	Timer _ [
			[
				startTime _ Time millisecondClockValue.
				myDelay wait.
				self
					tally: Processor preemptedProcess suspendedContext
					in: (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"
	Smalltalk getVMParameters keysAndValuesDo: [ :idx :gcVal | 
		gcStats at: idx put: (gcVal - gcStats at: idx)].
	time _ Time millisecondClockValue - time0! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:49'!
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! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:49'!
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! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:47'!
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 ]! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:48'!
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 ]! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 16:07'!
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]].
	]! !

!MessageTally methodsFor: 'reporting' stamp: 'jmv 9/24/2009 15:35'!
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].
		
	time isZero ifFalse:	
		[self reportGCStatsOn: strm].! !

!MessageTally methodsFor: 'tallying' stamp: 'jmv 9/24/2009 16:11'!
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.
		path reportOtherProcesses: reportOtherProcesses.
		receivers _ receivers copyWith: path].
	
	^ path bumpBy: count! !

!MessageTally methodsFor: 'tallying' stamp: 'jmv 9/24/2009 16:11'!
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! !

!MessageTally methodsFor: 'private' stamp: 'jmv 9/24/2009 16:10'!
copyWithTally: hitCount
	^ (MessageTally new class: class method: method)
		reportOtherProcesses: reportOtherProcesses;
		process: process;
		bump: hitCount! !

!MessageTally methodsFor: 'accessing' stamp: 'jmv 9/24/2009 16:02'!
reportOtherProcesses: aBoolean
	reportOtherProcesses _ aBoolean! !


!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:05'!
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.	"Irrelevant in this case. All processes will be reported on their own."
	result _ node spyAllEvery: self defaultPollPeriod on: aBlock.
	(CodeHolder new contents: (String streamContents: [:s | node report: s; close]))
		openLabel: 'Spy Results' wrap: false.
	^ result! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 15:59'!
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: false! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:14'!
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.
	(CodeHolder new contents: (String streamContents: [:s | node report: s; close]))
		openLabel: 'Spy Results' wrap: false.
	^ result! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:02'!
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! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:00'!
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.  
	(Delay forMilliseconds: 100) wait.  
	MessageTally spyOnProcess: p1 forMilliseconds: 1000
	"
	^self spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: false
! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:15'!
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.
	(CodeHolder new
		contents: (String
				streamContents: [:s | node report: s;
						 close]))
		openLabel: 'Spy Results' wrap: false! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:02'!
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! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:17'!
tallySends: aBlock
	"
	MessageTally tallySends: [3.14159 printString]
	"

	^ self tallySendsTo: nil inBlock: aBlock showTree: true! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 16:04'!
tallySendsTo: receiver inBlock: aBlock showTree: treeOption
	"
	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"
	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.
	(CodeHolder 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 ]))
		openLabel: 'Spy Results' wrap: false! !


!TimeProfileBrowser methodsFor: 'private' stamp: 'jmv 9/24/2009 16:12'!
runBlock: aBlock pollingEvery: pollPeriod 
	| stream list result |
	block := MessageSend 
				receiver: self
				selector: #runBlock:pollingEvery:
				arguments: { 
						aBlock.
						pollPeriod}.	"so we can re-run it"
	tally := MessageTally new.
	tally
		reportOtherProcesses: false;
		maxClassNameSize: 1000;
		maxClassPlusSelectorSize: 1000;
		maxTabs: 100.
	result := tally spyEvery: pollPeriod on: aBlock.
	stream := ReadWriteStream 
				with: (String streamContents: 
							[:s | 
							tally
								report: s;
								close]).
	stream reset.
	list := OrderedCollection new.
	[stream atEnd] whileFalse: [list add: stream nextLine].
	self initializeMessageList: list.
	self changed: #messageList.
	self changed: #messageListIndex.
	^result! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'jmv 9/24/2009 16:13'!
runProcess: aProcess forMilliseconds: msecDuration pollingEvery: pollPeriod 
	| stream list result |
	block := MessageSend 
				receiver: self
				selector: #runProcess:forMilliseconds:pollingEvery: 
				arguments: { 
						aProcess.
						msecDuration.
						pollPeriod}.	"so we can re-run it"
	tally := MessageTally new.
	tally
		reportOtherProcesses: false;
		maxClassNameSize: 1000;
		maxClassPlusSelectorSize: 1000;
		maxTabs: 100.
	result := tally 
				spyEvery: pollPeriod
				onProcess: aProcess
				forMilliseconds: msecDuration.
	stream := ReadWriteStream 
				with: (String streamContents: 
							[:s | 
							tally
								report: s;
								close]).
	stream reset.
	list := OrderedCollection new.
	[stream atEnd] whileFalse: [list add: stream nextLine].
	self initializeMessageList: list.
	self changed: #messageList.
	self changed: #messageListIndex.
	^result! !


!Utilities class methodsFor: 'vm statistics' stamp: 'jmv 9/24/2009 16:14'!
reportCPUandRAM
	"Write several text files with useful analysis for profiling purposes.
	Overwrites any existing report.
	Utilities reportCPUandRAM
	"	

	| stream tally |
	
	"VM statistics (Memory use and GC, mainly)"
	stream _ FileStream forceNewFileNamed: 'MemoryStats.txt'.
	[ stream nextPutAll: Utilities vmStatisticsReportString ] 
		ensure: [ stream close ].
	
	"Process list"
	stream _ FileStream forceNewFileNamed: 'ProcessList.txt'.
	[
		ProcessBrowser new processNameList 
			do: [ :each | 
				stream nextPutAll: each; cr ]
	] ensure: [ stream close ].

"Fork all these, so they run in sequence, as the system is back running"
[
	
	"Process taking most CPU"
	stream _ FileStream forceNewFileNamed: 'ThePig.txt'.
	ProcessBrowser dumpPigStackOn: stream andClose: true.
	
	"Tally of all processes"
	stream _ FileStream forceNewFileNamed: 'FullTally.txt'.
	[
		tally _ MessageTally new.
		tally reportOtherProcesses: true.	"actually irrelevant"
		tally spyAllEvery: 1 on: [ (Delay forMilliseconds: 1000) wait ].
		tally report: stream ] ensure: [ stream close ].
	
	"Tally of UI (perhaps not useful when having all processes....)"
	stream _ FileStream forceNewFileNamed: 'UITally.txt'.
	[
		tally _ MessageTally new.
		tally reportOtherProcesses: false.
		tally spyEvery: 1 onProcess: ProjectX uiProcessX forMilliseconds: 1000.
		tally report: stream ] ensure: [ stream close ].
	

	"Memory Analysis"
	stream _ FileStream forceNewFileNamed: 'MemoryAnalysis.txt'.
	[ SpaceTally new printSpaceAnalysis: 1 on: stream ]
		ensure: [ stream close ]

] forkNamed: 'CPU usage analysis'! !

MessageTally class removeSelector: #initialize!
MessageTally class removeSelector: #showProcesses!
MessageTally class removeSelector: #showProcesses:!
MessageTally class removeSelector: #spyOn:toFileNamed:!
MessageTally class removeSelector: #spyOnProcess:forMilliseconds:toFileNamed:!
MessageTally removeSelector: #fullPrintOn:tallyExact:orThreshold:!
MessageTally removeSelector: #leavesPrintOn:tallyExact:orThreshold:!
MessageTally removeSelector: #rootPrintOn:total:totalTime:tallyExact:orThreshold:!
!classDefinition: #MessageTally category: #'Tools-Debugger'!
Magnitude subclass: #MessageTally
	instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses'
	classVariableNames: 'DefaultPollPeriod Timer'
	poolDictionaries: ''
	category: 'Tools-Debugger'!
