--------------F166D6E78CAE4087C40DEB18
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit



The attached file-in is a stand-alone version of the TimeProfileBrowser.

For a description, see http://www.create.ucsb.edu/squeak/STP12.html.

-- 
stp

Stephen Travis Pope  --  http://www.create.ucsb.edu/~stp
stp at expertcity.com   --  stp9 at cornell.edu
--------------F166D6E78CAE4087C40DEB18
Content-Type: text/plain; charset=us-ascii;
 name="TimeProfileView.2Dece1209pm.cs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="TimeProfileView.2Dece1209pm.cs"


'From Squeak2.6 of 11 October 1999 [latest update: #1559] on 2 December 1999 at 12:09:36 pm'!
Magnitude subclass: #MessageTally
	instanceVariableNames: 'class method tally receivers senders time '
	classVariableNames: 'ObservedProcess Timer '
	poolDictionaries: ''
	category: 'System-Support'!
MessageSet subclass: #TimeProfileBrowser
	instanceVariableNames: 'selectedClass selectedSelector block tally '
	classVariableNames: 'TextMenu '
	poolDictionaries: ''
	category: 'Interface-Browser'!
TimeProfileBrowser class
	instanceVariableNames: ''!

!MessageTally methodsFor: 'initialize-release' stamp: 'stp 05/07/1999 15:31'!
spyEvery: millisecs on: aBlock 
	"Create a spy and spy on the given block at the specified rate."

	| myDelay value startTime time0 |
	(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.
	Timer :=
		[[true] whileTrue: 
			[startTime := Time millisecondClockValue.
			myDelay wait.
			self tally: ObservedProcess suspendedContext
				"tally can be > 1 if ran a long primitive"
				by: (Time millisecondClockValue - startTime) // millisecs].
		nil] newProcess.
	Timer priority: Processor userInterruptPriority.
		"activate the probe and evaluate the block"
	Timer resume.
	value := aBlock value.
		"cancel the probe and return the value"
	Timer terminate.
	time := Time millisecondClockValue - time0.
	^value! !

!MessageTally methodsFor: 'reporting' stamp: 'stp 05/07/1999 14:38'!
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 tallyExact: false orThreshold: threshold]! !

!MessageTally methodsFor: 'reporting' stamp: 'stp 05/08/1999 12:06'!
tally
	"Answer the receiver's number of tally."

	^tally! !

!MessageTally methodsFor: 'reporting' stamp: 'stp 05/08/1999 11:47'!
time
	"Answer the receiver's run time."

	^time! !


!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
block
	"Answer the receiver's 'block'."

	^block! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
block: anObject
	"Set the receiver's instance variable 'block' to be anObject."

	block := anObject! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
selectedClass
	"Answer the receiver's 'selectedClass'."

	^selectedClass! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
selectedClass: anObject
	"Set the receiver's instance variable 'selectedClass' to be anObject."

	selectedClass := anObject! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
selectedSelector
	"Answer the receiver's 'selectedSelector'."

	^selectedSelector! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
selectedSelector: anObject
	"Set the receiver's instance variable 'selectedSelector' to be anObject."

	selectedSelector := anObject! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
tally
	"Answer the receiver's 'tally'."

	^tally! !

!TimeProfileBrowser methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:37'!
tally: anObject
	"Set the receiver's instance variable 'tally' to be anObject."

	tally := anObject! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'stp 05/08/1999 15:36'!
messageListKey: aChar from: view
	"Respond to a Command key. Cmd-D means re-run block."

	aChar == $d ifTrue: [^ Cursor execute showWhile: [self runBlock]].
	^ self arrowKey: aChar from: view! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'stp 05/08/1999 15:27'!
messageListMenu: aMenu shifted: shifted
	"Add a menu to the inherited one."

	| menu |
	menu := super messageListMenu: aMenu shifted: shifted.
"	menu addItem: (0)."
	^menu! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'stp 05/13/1999 07:02'!
runBlock

	| stream list |
	tally := MessageTally new.
	tally spyEvery: 16 on: block.
	stream := ReadWriteStream on: (String new: 2048).
	stream nextPutAll: tally tally printString, ' tallies ', 
				tally time printString, ' msec.'; cr.
	tally fullPrintOn: stream tallyExact: false orThreshold: 2.
	stream reset.
	list := OrderedCollection new.
	[stream atEnd]
		whileFalse:
		[list add: (stream upTo: Character cr). stream next].
	self initializeMessageList: list.
	self changed: #messageList.
	self changed: #messageListIndex.
! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'stp 05/08/1999 15:19'!
selectedMessage
	"Answer the source method for the currently selected message."
	| source |
	self setClassAndSelectorIn: [:class :selector | 
		source _ class sourceMethodAt: selector ifAbsent: [^ 'Missing'].
		Preferences browseWithPrettyPrint ifTrue:
			[source _ class compilerClass new
				format: source in: class notifying: nil].
		^ source asText makeSelectorBoldIn: class].
	^''! !

!TimeProfileBrowser methodsFor: 'private' stamp: 'stp 12/2/1999 12:08'!
setClassAndSelectorIn: csBlock
	"Decode strings of the form    <selectorName> (<className> [class])  "

	| string strm class sel parens |
	messageListIndex < 3 ifTrue: [^contents := nil].		"Ignore first 2 lines"
	string _ self selection asString.
	string isEmpty ifTrue: [^contents := nil].
	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 findLast: [ :ch | ch == $ ]).
			class := strm upTo: $>.
			strm next.
			sel := strm upToEnd].
	class isEmpty ifTrue: [^contents := nil].
	sel isEmpty ifTrue: [^contents := nil].
	^MessageSet parse: (class, ' ', sel) toClassAndSelector: csBlock! !


!TimeProfileBrowser class methodsFor: 'instance creation' stamp: 'stp 05/13/1999 07:11'!
onBlock: block
	"Open a profile browser on the given block, thereby running the block and 
	 collecting the message tally."
	"TimeProfileBrowser onBlock: [20 timesRepeat: 
			[Transcript show: 100 factorial printString]]"

	| inst |
	inst := self new.
	inst block: block.
	inst runBlock.
	self open: inst name: 'Time Profile'! !

(StringHolder new textContents:
	('
	For a demonstration of the TimeProfileBrowser, evaluate the following expression

		"TimeProfileBrowser onBlock: [20 timesRepeat: 
			[Transcript show: 100 factorial printString]]"'))
	openLabel: 'TimeProfileBrowser ReadMe'!!

--------------F166D6E78CAE4087C40DEB18--