[Pkg] The Trunk: Tools-ul.686.mcz

[commits at source.squeak.org]

Levente Uzonyi uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-ul.686.mcz

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

Name: Tools-ul.686
Author: ul
Time: 7 April 2016, 7:54:49.263045 pm
UUID: 6da353d4-ff75-445e-a5f9-037112763617
Ancestors: Tools-mt.685

TimeProfileBrowser changes:
- make #messageHelpAt: work
- calculate and store methodReferences
- use the precreated methodReferences instead of re-parsing the lines all the time
- simplify a few things now that we have methodReferences available
- added a hack to show the tallied block's source when the tally contains a block outside of a method. This is not correct in all cases, but the block itself doesn't seem it be available
- use lazy initialization for methodReference so that existing instances will keep working after update

=============== Diff against Tools-mt.685 ===============

Item was changed:
  MessageSet subclass: #TimeProfileBrowser
+ 	instanceVariableNames: 'block tally methodReferences'
- 	instanceVariableNames: 'selectedClass selectedSelector block tally'
  	classVariableNames: 'TextMenu'
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
  !TimeProfileBrowser commentStamp: '<historical>' prior: 0!
  A TimeProfileBrowser is a browser visualizing the runtime profile of an executed Smalltalk block.  It is useful for finding performance bottlenecks in code. When optimizing code it can
  be hard to know what methods actually constitute the bulk of the execution time. Is it a few
  methods that take very long time to execute or is it perhaps a single method that gets executed a thousand times?
  
  The block is first spied on using a MessageTally instance (which has even more funtionality than used by the TimeProfileBrowser) which samples the block during it's execution and collects the amount of time approximately spent in the methods executed. Then the methods are shown in the browser with their relative execution time in percent.
  
  Example:
  TimeProfileBrowser onBlock: [20 timesRepeat:  [Transcript show: 100 factorial printString]]
  !

Item was added:
+ ----- Method: TimeProfileBrowser>>hasMessageSelected (in category 'message list') -----
+ hasMessageSelected
+ 
+ 	^super hasMessageSelected and: [
+ 		(self methodReferences at: self messageListIndex) notNil ]!

Item was added:
+ ----- Method: TimeProfileBrowser>>messageHelpAt: (in category 'message list') -----
+ messageHelpAt: anIndex
+ 	"Show the first n lines of the sources code of the selected message."
+ 	
+ 	| reference source formatted lineCount |
+ 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ 	self messageList size < anIndex ifTrue: [^ nil].
+ 	
+ 	reference := (self methodReferences at: anIndex) ifNil: [ ^nil ].
+ 	reference isValid ifFalse: [ ^nil ].
+ 	
+ 	source := reference compiledMethod getSource.
+ 	formatted := (Smalltalk classNamed: #SHTextStylerST80)
+ 		ifNil: [ source asText ]
+ 		ifNotNil: [ :SHTextStylerST80 |
+ 			SHTextStylerST80 new
+ 				classOrMetaClass: reference actualClass;
+ 				styledTextFor: source asText ].
+ 	
+ 	lineCount := 0.
+ 	source doWithIndex: [:char :index |
+ 		char = Character cr ifTrue: [lineCount := lineCount + 1].
+ 		lineCount > 10 ifTrue: [
+ 			formatted := formatted copyFrom: 1 to: index-1.
+ 			formatted append: ' [...]'.
+ 			^ formatted]].
+ 
+ 	^ formatted!

Item was added:
+ ----- Method: TimeProfileBrowser>>methodReferenceFrom: (in category 'private') -----
+ methodReferenceFrom: aString
+ 	"Try to create a MethodReference from a line returned by MessageTally. Return nil if the string doesn't have the given format."
+ 
+ 	| stream className selector |
+ 	stream := aString readStream.
+ 	"Skip percentages and timing data."
+ 	stream
+ 		skipTo: $};
+ 		skipSeparators.
+ 	(stream peekFor: $[) ifTrue: [ "Skip block markers."
+ 		stream upToAnyOf: CharacterSet separators ].
+ 	className := stream upToAnyOf: '(>'.
+ 	stream atEnd ifTrue: [ ^nil ].
+ 	stream last == $( ifTrue: [ "Method is defined in a super class"
+ 		className := stream upTo: $).
+ 		(stream peekFor: $>) ifFalse: [ ^nil ] ].
+ 	(stream peekFor: $>) ifFalse: [ ^nil ].
+ 	selector := stream upToEnd.
+ 	^MethodReference
+ 		class: ((Smalltalk classNamed: className) ifNil: [ ^nil ])
+ 		selector: ((Symbol lookup: selector) ifNil: [ ^nil ])!

Item was added:
+ ----- Method: TimeProfileBrowser>>methodReferences (in category 'accessing') -----
+ methodReferences
+ 
+ 	^methodReferences ifNil: [
+ 		methodReferences := messageList collect: [ :each | self methodReferenceFrom: each ] ]
+ !

Item was removed:
- ----- Method: TimeProfileBrowser>>selectedClass (in category 'accessing') -----
- selectedClass
- 	"Answer the receiver's 'selectedClass'."
- 
- 	^selectedClass!

Item was removed:
- ----- Method: TimeProfileBrowser>>selectedClass: (in category 'accessing') -----
- selectedClass: anObject
- 	"Set the receiver's instance variable 'selectedClass' to be anObject."
- 
- 	selectedClass := anObject!

Item was changed:
  ----- Method: TimeProfileBrowser>>selectedMessage (in category 'message list') -----
  selectedMessage
  	"Answer the source method for the currently selected message."
  
+ 	self setClassAndSelectorIn: [ :class :selector |
+ 		| source | 
+ 		source := (class == UndefinedObject and: [ selector == #DoIt ])
+ 			ifTrue: [ 'DoIt', String cr, String cr, block arguments first decompile decompileString ]
+ 			ifFalse: [ class sourceMethodAt: selector ifAbsent: [ ^'Missing' ] ].
+ 		SystemBrowser browseWithPrettyPrint ifTrue: [
+ 			source := class prettyPrinterClass 
+ 				format: source
+ 				in: class
+ 				notifying: nil
+ 				decorated: false ].
+ 		^source asText makeSelectorBoldIn: class ].
- 	
- 	self setClassAndSelectorIn: 
- 			[:class :selector | | source | 
- 			source := class sourceMethodAt: selector ifAbsent: [^'Missing'].
- 			SystemBrowser browseWithPrettyPrint 
- 				ifTrue: 
- 					[source := class prettyPrinterClass 
- 								format: source
- 								in: class
- 								notifying: nil
- 								decorated: false].
- 			self selectedClass: class.
- 			self selectedSelector: selector.
- 			^source asText makeSelectorBoldIn: class].
  	^''!

Item was removed:
- ----- Method: TimeProfileBrowser>>selectedSelector (in category 'accessing') -----
- selectedSelector
- 	"Answer the receiver's 'selectedSelector'."
- 
- 	^selectedSelector!

Item was removed:
- ----- Method: TimeProfileBrowser>>selectedSelector: (in category 'accessing') -----
- selectedSelector: anObject
- 	"Set the receiver's instance variable 'selectedSelector' to be anObject."
- 
- 	selectedSelector := anObject!

Item was changed:
  ----- Method: TimeProfileBrowser>>setClassAndSelectorIn: (in category 'private') -----
  setClassAndSelectorIn: csBlock
+ 	"Evaluate csBlock with the selected methodReference, or return nil if there's nothing selected."
- 	"Decode strings of the form    <selectorName> (<className> [class])  "
  
+ 	^((self methodReferences at: self messageListIndex) ifNil: [ ^nil ])
+ 		setClassAndSelectorIn: csBlock!
- 	self flag: #mref.	"fix for faster references to methods"
- 
- 	^[ | strm string class parens sel |
- 	string := self selection asString.
- 	string first == $* ifTrue: [^contents := nil].		"Ignore lines starting with *"
- 	parens := string includes: $(.					"Does it have open-paren?"
- 	strm := ReadStream on: string.
- 	parens
- 		ifTrue: [strm skipTo: $(.		"easy case"
- 			class := strm upTo: $).
- 			strm next: 2.
- 			sel := strm upToEnd]
- 		ifFalse: [strm position: (string findString: ' class>>').
- 			strm position > 0
- 				ifFalse: [strm position: (string findLast: [ :ch | ch == $ ])]
- 				ifTrue:
- 					[ | subString |  "find the next to last space character"
- 					subString := strm contents copyFrom: 1 to: (string findLast: [ :ch | ch == $ ]) - 1.
- 					strm position: (subString findLast: [ :ch | ch == $ ])].
- 		"ifFalse: [strm position: (string findLast: [ :ch | ch == $ ])."
- 			class := strm upTo: $>.
- 			strm next.
- 			sel := strm upToEnd].
- 	MessageSet parse: (class, ' ', sel) toClassAndSelector: csBlock]
- 		on: Error do: [:ex | contents := nil]!