[squeak-dev] The Trunk: System-eem.491.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 17 00:16:34 UTC 2012


Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.491.mcz

==================== Summary ====================

Name: System-eem.491
Author: eem
Time: 16 July 2012, 5:15:37.638 pm
UUID: 36631b36-5c57-4173-af46-59e4697db35b
Ancestors: System-eem.490

Make MessageTally able to profile across a snapshot.
See MessageTally's class comment for an example.

=============== Diff against System-eem.490 ===============

Item was changed:
  Magnitude subclass: #MessageTally
+ 	instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses time0 startTime endTime preHibernationCopy'
- 	instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses'
  	classVariableNames: 'DefaultPollPeriod ShowProcesses Timer'
  	poolDictionaries: ''
  	category: 'System-Tools'!
  
+ !MessageTally commentStamp: 'eem 7/16/2012 17:10' prior: 0!
- !MessageTally commentStamp: 'StephaneDucasse 9/27/2009 10:42' 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. Note that TimeProfileBrowser was not fancy with the different setting possibilities.
  
  	TimeProfileBrowser spyOn:  [20 timesRepeat: 
  			[Transcript show: 100 factorial printString]]
  	
  
  Strategies
  -----------
  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. See below for an example showing different settings
  
  * 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.
  
  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.
  
  Examples
  ----------
  
  Here you can see all the processes computation time
  	
  		[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] 
  
+ This profiles across a snapshot, writing the output to {imageName}.N.profile
+ 	| fn |
+ 	fn := (FileDirectory baseNameFor: Smalltalk image imageName), '.profile'.
+ 	[MessageTally
+ 			spyOn: [Smalltalk image snapshot: true andQuit: true]
+ 			toFileNamed: fn
+ 			reportOtherProcesses: true]
+ 		on: FileExistsException
+ 		do: [:ex|
+ 			ex resume:
+ 				(FileStream forceNewFileNamed: 
+ 					(FileDirectory default
+ 						nextNameFor:
+ 							(FileDirectory localNameFor: 
+ 								(FileDirectory baseNameFor: fn))
+ 						extension: 'profile'))]
  
  Settings
  ---------
  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
  
  
  To understand the difference
  ----------------------------------
  Here we see all the processes
  	[1000 timesRepeat: [
  		100 timesRepeat: [120 factorial].
  		(Delay forMilliseconds: 10) wait
  		]] forkAt: 45 named: '45'.
  	MessageTally spyAllOn: [10000 timesRepeat: [1.23 printString]]
  	
  	
  Here we only see the execution of the expression [10000 timesRepeat: [1.23 printString]
  	[1000 timesRepeat: [
  		100 timesRepeat: [120 factorial].
  		(Delay forMilliseconds: 10) wait
  		]] forkAt: 45 named: '45'.
  	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]]
  	
  Here we only check the exact message sends: this is not a pc-sampling approach
  	[1000 timesRepeat: [
  		100 timesRepeat: [120 factorial].
  		(Delay forMilliseconds: 10) wait
  		]] forkAt: 45 named: '45'.
  	MessageTally tallySends: [10000 timesRepeat: [1.23 printString]]
  	
  
  
  !

Item was changed:
  ----- Method: MessageTally class>>initialize (in category 'class initialization') -----
  initialize
  	"MessageTally initialize"
  	"By default, show each process separately"
+ 	ShowProcesses ifNil: [ShowProcesses := true].
+ 	Smalltalk
+ 		addToShutDownList: self after: Delay; "i.e. convert to relative times & stats after Delay sleeps."
+ 		addToStartUpList: self before: Delay "i.e. convert back to absolute stats before Delay wakes."!
- 	ShowProcesses := true!

Item was added:
+ ----- Method: MessageTally class>>runningInstance (in category 'system startup') -----
+ runningInstance
+ 	"Answer the running instance if the Timer is running."
+ 	^Timer ifNotNil:
+ 		[((Processor activeProcess == Timer
+ 			ifTrue: [thisContext]
+ 			ifFalse: [Timer suspendedContext]) findContextSuchThat:
+ 				[:ctxt| ctxt receiver isKindOf: self]) ifNotNil:
+ 					[:ctxt| ctxt receiver]]!

Item was added:
+ ----- Method: MessageTally class>>shutDown: (in category 'system startup') -----
+ shutDown: quitting
+ 	"This message is sent on system shutdown to registered classes"
+ 	self runningInstance ifNotNil: [:runningInstance| runningInstance hibernate]!

Item was added:
+ ----- Method: MessageTally class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ 	"This message is sent to registered classes when the system is coming up."
+ 	self runningInstance ifNotNil: [:runningInstance| runningInstance unhibernate: resuming]!

Item was added:
+ ----- Method: MessageTally>>computeGCStats (in category 'private') -----
+ computeGCStats
+ 	"Compute the deltas in the GC stats.  Serves for reporting, hibernating and unhibernating."
+ 	SmalltalkImage current getVMParameters keysAndValuesDo:
+ 		[ :idx :gcVal |
+ 		gcVal ifNotNil: [gcStats at: idx put: (gcVal - (gcStats at: idx))]]!

Item was added:
+ ----- Method: MessageTally>>convertToOrFromDeltaForHibernation (in category 'private') -----
+ convertToOrFromDeltaForHibernation
+ 	"Convert between absolute and relative times and stats (and back!!)."
+ 	| now |
+ 	now := Time millisecondClockValue.
+ 	startTime ifNotNil: [startTime := now - startTime].
+ 	time0 ifNotNil: [time0 := now - time0].
+ 	endTime ifNotNil: [endTime := now - endTime].
+ 	self computeGCStats!

Item was added:
+ ----- Method: MessageTally>>hibernate (in category 'private') -----
+ hibernate
+ 	"Sent before snapshot.  Convert absolute times and stats into relative times and stats
+ 	 Also copy the receiver for the non-snapshot path."
+ 	preHibernationCopy := self shallowCopy.
+ 	gcStats := gcStats copy. "So as to leave preHibernationCopy's alone."
+ 	self convertToOrFromDeltaForHibernation!

Item was changed:
  ----- 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 |
- 	| myDelay time0 |
  	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 ifNotNil: [ self error: 'it seems a tally is already running' ].
  	Timer := [
+ 		[true] whileTrue: [
+ 			| observedProcess |
- 		[
- 			| observedProcess startTime |
  			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].
- 				by: (Time millisecondClockValue - startTime) // millisecs] repeat.
  		nil] newProcess.
  	Timer priority: Processor timingPriority-1.
  		"activate the probe and evaluate the block"
  	Timer resume.
  	^ aBlock ensure: [
  		"cancel the probe and return the value"
  		"Could have already been terminated. See #terminateTimerProcess"
+ 		self class terminateTimerProcess.
+ 		self computeGCStats.
- 		Timer ifNotNil: [
- 			Timer terminate.
- 			Timer := nil ].
- 		"Collect gc statistics"
- 			SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
- 				gcVal ifNotNil: [ gcStats at: idx put: (gcVal - (gcStats at: idx)) ] ].
  		time := Time millisecondClockValue - time0]!

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 observedProcess |
- 	| myDelay time0 observedProcess |
  	aBlock isBlock
  		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 ifNotNil: [ self error: 'it seems a tally is already running' ].
+ 	time0 := Time millisecondClockValue.
  	Timer := [
+ 		[ true ] whileTrue: [
- 		[
- 			| startTime |
  			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].
- 				by: (Time millisecondClockValue - startTime) // millisecs] repeat.
  		nil] newProcess.
  	Timer priority: Processor timingPriority-1.
  		"activate the probe and evaluate the block"
  	Timer resume.
  	^ aBlock ensure: [
  		"cancel the probe and return the value"
  		"Could have already been terminated. See #terminateTimerProcess"
+ 		self class terminateTimerProcess.
+ 		self computeGCStats.
+ 		time := Time millisecondClockValue - time0]!
- 		Timer ifNotNil: [
- 			Timer terminate.
- 			Timer := nil ].
- 		"Collect gc statistics"
- 		SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
- 			gcVal ifNotNil: [ gcStats at: idx put: (gcVal - (gcStats at: idx)) ] ].
- 		time := Time millisecondClockValue - time0 ]!

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 observedProcess sem |
- 	| myDelay 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 := SmalltalkImage current getVMParameters.
  	Timer ifNotNil: [ self error: 'it seems a tally is already running' ].
  	Timer := [
  			[
- 				| startTime |
  				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.
+ 	self computeGCStats.
- 	"Collect gc statistics"
- 	SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
- 		gcVal ifNotNil: [ gcStats at: idx put: (gcVal - (gcStats at: idx)) ] ].
  	time := Time millisecondClockValue - time0!

Item was added:
+ ----- Method: MessageTally>>unhibernate: (in category 'private') -----
+ unhibernate: resuming
+ 	"Sent after snapshot.  If resuming (starting a shapshot), then convert relative
+ 	 times back into absolute times.  If not, revert to pre-hibernation state."
+ 	resuming
+ 		ifTrue: [self convertToOrFromDeltaForHibernation]
+ 		ifFalse: [self copyFrom: preHibernationCopy]!



More information about the Squeak-dev mailing list