'From Squeak3.11alpha of 13 February 2010 [latest update: #9483] on 9 March 2010 at 11:11:23 am'! !MessageTally methodsFor: 'initialize-release' stamp: 'ul 2/22/2010 16:46'! close self deprecated: 'Use MessageTally >> #terminateTimerProcess'. Timer ifNotNil: [ Timer terminate ]. Timer := nil. class := method := tally := receivers := nil! ! !MessageTally methodsFor: 'initialize-release' stamp: 'ul 2/22/2010 16:43'! spyAllEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy all the system processes" | 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 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]. 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" Timer ifNotNil: [ Timer terminate. Timer := nil ]. "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - (gcStats at: idx))]. time := Time millisecondClockValue - time0]! ! !MessageTally methodsFor: 'initialize-release' stamp: 'ul 2/22/2010 16:44'! 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 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' ]. 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]. 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" Timer ifNotNil: [ Timer terminate. Timer := nil ]. "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - (gcStats at: idx))]. time := Time millisecondClockValue - time0]! ! !MessageTally methodsFor: 'initialize-release' stamp: 'ul 2/22/2010 16:46'! spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration "Create a spy and spy on the given process at the specified rate." | 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. "Collect gc statistics" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - gcStats at: idx)]. time := Time millisecondClockValue - time0! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:47'! showReport: node "Open a string holder with the reports from the given node" (StringHolder new contents: (String streamContents: [:s | node report: s ])) openLabel: 'Spy Results'! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:47'! 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. self showReport: node. ^ result! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:48'! 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. self showReport: node. ^ result! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:48'! spyOn: aBlock toFileNamed: fileName "Spy on the evaluation of aBlock. Write the data collected on a file named fileName." | value node | node := self new. value := node spyEvery: self defaultPollPeriod on: aBlock. FileStream newFileNamed: fileName do: [ :file | node report: file ]. ^value! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:50'! 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: ShowProcesses ! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:50'! 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. self showReport: node.! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/22/2010 16:50'! spyOnProcess: aProcess forMilliseconds: msecDuration toFileNamed: fileName "Spy on the evaluation of aProcess. Write the data collected on a file named fileName. Will overwrite fileName" | node | node := self new. node spyEvery: self defaultPollPeriod onProcess: aProcess forMilliseconds: msecDuration. FileStream fileNamed: fileName do: [ :file | node report: file ]! ! !MessageTally class methodsFor: 'spying' stamp: 'ul 2/24/2010 00:06'! 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. (StringHolder new contents: (String streamContents: [:s | s nextPutAll: 'This simulation took ' , totalTime printString , ' seconds.'; cr. treeOption ifTrue: [ tallies fullPrintExactOn: s ] ifFalse: [ tallies leavesPrintExactOn: s ] ])) openLabel: 'Spy Results'! ! !MessageTally class methodsFor: 'as yet unclassified' stamp: 'ul 2/22/2010 16:47'! terminateTimerProcess Timer ifNotNil: [ Timer terminate. Timer := nil ]. ! ! !Preferences class methodsFor: 'fonts' stamp: 'dtl 2/12/2010 22:21'! setListFontTo: aFont "Set the list font as indicated" Parameters at: #standardListFont put: aFont. Smalltalk at: #ListParagraph ifPresent: [:lp | lp initialize]. Smalltalk at: #Flaps ifPresent: [:flaps | flaps replaceToolsFlap]! ! !Project methodsFor: 'utilities' stamp: 'dtl 2/14/2010 20:44'! textWindows "Answer a dictionary of all system windows for text display keyed by window title. Generate new window titles as required to ensure unique keys in the dictionary." self subclassResponsibility! ! !SmalltalkImage methodsFor: 'os' stamp: 'nice 3/7/2010 01:20'! windowSystemName "Return the name of the window system currently being used for display." "Smalltalk os windowSystemName" ^self getSystemAttribute: 1005! ! !Utilities class methodsFor: 'miscellaneous' stamp: 'dtl 2/14/2010 20:59'! storeTextWindowContentsToFileNamed: aName "Utilities storeTextWindowContentsToFileNamed: 'TextWindows'" | aDict aRefStream | aDict := Project current textWindows.. aDict size = 0 ifTrue: [^ self inform: 'no windows found to export.']. aRefStream := ReferenceStream fileNamed: aName. aRefStream nextPut: aDict. aRefStream close. self inform: 'Done!! ', aDict size printString, ' window(s) exported.'! !