The Trunk: System-ar.242.mcz
Locked
 
|
Andreas Raab uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ar.242.mcz ==================== Summary ==================== Name: System-ar.242 Author: ar Time: 3 February 2010, 9:34:48.402 pm UUID: f0907bbe-46a2-a840-bcd8-afb5a10f16b0 Ancestors: System-dtl.241 Merge latest MessageTally changes from Cuis. =============== Diff against System-dtl.241 =============== Item was added: + ----- Method: MessageTally>>leavesPrintExactOn: (in category 'printing') ----- + 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 ]! 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 startTime time0 endTime observedProcess sem | - | myDelay time0 endTime sem observedProcess | (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: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime | [ startTime := Time millisecondClockValue. myDelay wait. + self + tally: Processor preemptedProcess suspendedContext + in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) - self tally: Processor preemptedProcess suspendedContext - in: (ShowProcesses ifTrue: [ - 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! Item was changed: ----- Method: MessageTally>>tally:by: (in category 'tallying') ----- tally: context by: count "Explicitly tally the specified context and its stack." | sender | "Add to this node if appropriate" context method == method ifTrue: [^self bumpBy: count]. "No sender? Add new branch to the tree." + (sender := context home sender)ifNil: [ - (sender := context home sender)ifNil: [ ^ (self bumpBy: count) tallyPath: context by: count]. "Find the node for the sending context (or add it if necessary)" ^ (self tally: sender by: count) tallyPath: context by: count! Item was changed: ----- Method: MessageTally class>>tallySendsTo:inBlock:showTree: (in category 'spying') ----- tallySendsTo: receiver inBlock: aBlock showTree: treeOption + " + MessageTally tallySends: [3.14159 printString] + " - "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" - tallies := MessageTally new class: aBlock receiver class - method: aBlock method. 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 ]. + tallies close ])) - ifTrue: [tallies fullPrintOn: s tallyExact: true orThreshold: 0] - ifFalse: [tallies leavesPrintOn: s tallyExact: true orThreshold: 0]. - tallies close])) openLabel: 'Spy Results'! Item was added: + ----- Method: MessageTally>>rootPrintOn:total:totalTime:threshold: (in category 'printing') ----- + 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]]. + ]! Item was added: + ----- Method: MessageTally class>>spyOn:toFileNamed:reportOtherProcesses: (in category 'spying') ----- + 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! 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 startTime time0 observedProcess | + (aBlock isMemberOf: BlockClosure) - | 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: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime observedProcess | [true] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. observedProcess := Processor preemptedProcess. + self + tally: observedProcess suspendedContext + in: observedProcess - self tally: observedProcess suspendedContext - in: (ShowProcesses ifTrue: [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" SmalltalkImage current 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]! Item was changed: ----- Method: MessageTally>>leavesInto:fromSender: (in category 'collecting leaves') ----- leavesInto: leafDict fromSender: senderTally + | rcvrs | + rcvrs := self sonsOver: 0. - rcvrs _ self sonsOver: 0. rcvrs size = 0 + ifTrue: [ self into: leafDict fromSender: senderTally ] - ifTrue: [self into: leafDict fromSender: senderTally] ifFalse: [ + (reportOtherProcesses not and: [ rcvrs anyOne process isNil ]) ifTrue: [ + ^self]. - "Do not show 'other processes' " - "Please keep consistency with #rootPrintOn:total:totalTime:tallyExact:orThreshold: - on showing them or not!!" - rcvrs anyOne process ifNil: [^self]. + rcvrs do: [ :node | - rcvrs do: - [:node | node isPrimitives + ifTrue: [ node leavesInto: leafDict fromSender: senderTally ] + ifFalse: [ node leavesInto: leafDict fromSender: self ]]]! - ifTrue: [node leavesInto: leafDict fromSender: senderTally] - ifFalse: [node leavesInto: leafDict fromSender: self]]]! Item was changed: ----- Method: MessageTally>>printSenderCountsOn: (in category 'printing') ----- printSenderCountsOn: aStream + | mergedSenders mergedNode | - | mergedSenders | mergedSenders := IdentityDictionary new. senders do: + [:node | - [:node | | mergedNode | mergedNode := mergedSenders at: node method ifAbsent: [nil]. mergedNode == nil ifTrue: [mergedSenders at: node method put: node] ifFalse: [mergedNode bump: node tally]]. mergedSenders asSortedCollection do: [:node | 10 to: node tally printString size by: -1 do: [:i | aStream space]. node printOn: aStream total: tally totalTime: nil tallyExact: true]! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- + spyEvery: millisecs on: aBlock - 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: BlockClosure) - | 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. - observedProcess _ Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. gcStats := SmalltalkImage current getVMParameters. + Timer ifNotNil: [ Timer terminate ]. + Timer := [ - Timer := [ | startTime | [true] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. + self + tally: Processor preemptedProcess suspendedContext + in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) - self tally: Processor preemptedProcess suspendedContext - in: (ShowProcesses ifTrue: [ - 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" SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcStats at: idx put: (gcVal - (gcStats at: idx))]. "cancel the probe and return the value" + Timer terminate. + Timer := nil. - Timer ifNotNil: [ Timer terminate ]. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>treePrintOn:tabs:thisTab:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold + | sons sonTab | - | sons | tabs do: [:tab | aStream nextPutAll: tab]. tabs size > 0 ifTrue: [self printOn: aStream total: total totalTime: totalTime tallyExact: isExact]. sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold]. sons isEmpty ifFalse: [tabs addLast: myTab. sons := sons asSortedCollection. (1 to: sons size) do: + [:i | - [:i | | sonTab | sonTab := i < sons size ifTrue: [' |'] ifFalse: [' ']. (sons at: i) treePrintOn: aStream tabs: (tabs size < self maxTabs ifTrue: [tabs] ifFalse: [(tabs select: [:x | x = '[']) copyWith: '[']) thisTab: sonTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold]. tabs removeLast]! Item was changed: ----- Method: MessageTally class>>spyOnProcess:forMilliseconds: (in category 'spying') ----- 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. - p1 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. - p2 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. (Delay forMilliseconds: 100) wait. MessageTally spyOnProcess: p1 forMilliseconds: 1000 " + ^self spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: ShowProcesses + ! - | node | - node := self new. - node - spyEvery: self defaultPollPeriod - onProcess: aProcess - forMilliseconds: msecDuration. - (StringHolder new - contents: (String - streamContents: [:s | node report: s; - close])) - openLabel: 'Spy Results'! Item was changed: ----- Method: MessageTally class>>spyAllOn: (in category 'spying') ----- 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. result := node spyAllEvery: self defaultPollPeriod on: aBlock. + self showReport: node. - (StringHolder new contents: (String streamContents: [:s | node report: s; close])) - openLabel: 'Spy Results'. ^ result! Item was changed: Magnitude subclass: #MessageTally + instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs reportOtherProcesses' - instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' classVariableNames: 'DefaultPollPeriod ShowProcesses Timer' poolDictionaries: '' category: 'System-Tools'! + !MessageTally commentStamp: 'StephaneDucasse 9/27/2009 10:42' prior: 0! - !MessageTally commentStamp: 'nk 3/8/2004 12:43' 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. - NOTE: a higher-level user interface (combining the MessageTally result tree with a method browser) is available from TimeProfileBrowser. + 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 - * 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. * 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. - * 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. - * 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] + + + 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]] + + + + ! - 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.! Item was changed: ----- Method: MessageTally>>tally:in:by: (in category 'tallying') ----- tally: context in: aProcess by: count "Explicitly tally the specified context and its stack." | sender | "Add to this node if appropriate" context method == method ifTrue: [^self bumpBy: count]. "No sender? Add new branch to the tree." + (sender := context home sender) ifNil: [ - (sender := context home sender) ifNil: [ ^ (self bumpBy: count) tallyPath: context in: aProcess by: count]. "Find the node for the sending context (or add it if necessary)" ^ (self tally: sender in: aProcess by: count) tallyPath: context in: aProcess by: count! Item was added: + ----- Method: MessageTally>>reportOtherProcesses (in category 'accessing') ----- + reportOtherProcesses + "If true, reports all processes in the system" + ^reportOtherProcesses! Item was changed: ----- Method: MessageTally>>into:fromSender: (in category 'collecting leaves') ----- into: leafDict fromSender: senderTally | leafNode | + leafNode := leafDict at: method - leafNode _ leafDict at: method ifAbsent: [leafDict at: method put: ((MessageTally new class: class method: method) + process: process; + reportOtherProcesses: reportOtherProcesses)]. - process: process)]. leafNode bump: tally fromSender: senderTally! Item was changed: ----- Method: MessageTally>>tallyPath:in:by: (in category 'tallying') ----- 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! Item was changed: + ----- Method: MessageTally>>initialize (in category 'initialization') ----- - ----- Method: MessageTally>>initialize (in category 'initialize-release') ----- initialize + "Initialize the receiver" + super initialize. maxClassNameSize := self class defaultMaxClassNameSize. maxClassPlusSelectorSize := self class defaultMaxClassPlusSelectorSize. + maxTabs := self class defaultMaxTabs. + reportOtherProcesses := false. + ! - maxTabs := self class defaultMaxTabs.! Item was changed: ----- Method: MessageTally>>copyWithTally: (in category 'private') ----- copyWithTally: hitCount + ^ (MessageTally new class: class method: method) + reportOtherProcesses: reportOtherProcesses; - ^ (MessageTally new class: class method: method) process: process; bump: hitCount! Item was added: + ----- Method: MessageTally>>fullPrintOn:threshold: (in category 'printing') ----- + 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! Item was added: + ----- Method: MessageTally>>fullPrintExactOn: (in category 'printing') ----- + 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! Item was added: + ----- Method: MessageTally class>>spyOnProcess:forMilliseconds:toFileNamed:reportOtherProcesses: (in category 'spying') ----- + 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! Item was changed: ----- Method: MessageTally class>>tallySends: (in category 'spying') ----- + tallySends: aBlock + " + MessageTally tallySends: [3.14159 printString] + " + - tallySends: aBlock "MessageTally tallySends: [3.14159 printString]" ^ self tallySendsTo: nil inBlock: aBlock showTree: true! Item was changed: ----- Method: MessageTally>>report:cutoff: (in category 'reporting') ----- 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]. - self fullPrintOn: strm tallyExact: false orThreshold: threshold]. time isZero ifFalse: [self reportGCStatsOn: strm].! Item was added: + ----- Method: MessageTally class>>showReport: (in category 'spying') ----- + showReport: node + "Open a string holder with the reports from the given node" + (StringHolder new contents: + (String streamContents: [:s | node report: s; close])) + openLabel: 'Spy Results'! Item was added: + ----- Method: MessageTally>>reportOtherProcesses: (in category 'accessing') ----- + reportOtherProcesses: aBoolean + "If true, reports all processes in the system" + reportOtherProcesses := aBoolean! Item was added: + ----- Method: MessageTally class>>spyOnProcess:forMilliseconds:reportOtherProcesses: (in category 'spying') ----- + 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.! Item was added: + ----- Method: MessageTally class>>spyOn:reportOtherProcesses: (in category 'spying') ----- + 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! Item was changed: ----- Method: MessageTally>>sonsOver: (in category 'comparing') ----- sonsOver: threshold | hereTally last sons | (receivers == nil or: [receivers size = 0]) ifTrue: [^#()]. + hereTally := tally. + sons := receivers select: "subtract subNode tallies for primitive hits here" - hereTally _ tally. - sons _ receivers select: "subtract subNode tallies for primitive hits here" [:son | + hereTally := hereTally - son tally. - hereTally _ hereTally - son tally. son tally > threshold]. hereTally > threshold + ifTrue: [ + last := MessageTally new class: class method: method. - ifTrue: - [last _ MessageTally new class: class method: method. last process: process. + last reportOtherProcesses: reportOtherProcesses. ^sons copyWith: (last primitives: hereTally)]. ^sons! Item was changed: ----- Method: MessageTally class>>spyOn: (in category 'spying') ----- 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: ShowProcesses! - | node result | - node _ self new. - result _ node spyEvery: self defaultPollPeriod on: aBlock. - (StringHolder new contents: (String streamContents: [:s | node report: s; close])) - openLabel: 'Spy Results'. - ^ result! Item was changed: ----- Method: MessageTally>>close (in category 'initialize-release') ----- close + Timer ifNotNil: [ Timer terminate ]. - (Timer isMemberOf: Process) ifTrue: [Timer terminate]. Timer := nil. class := method := tally := receivers := nil! Item was changed: ----- Method: MessageTally>>tallyPath:by: (in category 'tallying') ----- tallyPath: context by: count | aMethod path | + aMethod := context method. - 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! Item was added: + ----- Method: MessageTally>>leavesPrintOn:threshold: (in category 'printing') ----- + 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 ]! Item was removed: - ----- Method: MessageTally>>fullPrintOn:tallyExact:orThreshold: (in category 'printing') ----- - fullPrintOn: aStream tallyExact: isExact orThreshold: perCent - | threshold | - isExact ifFalse: [threshold _ (perCent asFloat / 100 * tally) rounded]. - aStream nextPutAll: '**Tree**'; cr. - self rootPrintOn: aStream - total: tally - totalTime: time - tallyExact: isExact - orThreshold: threshold. - aStream nextPut: Character newPage; cr. - aStream nextPutAll: '**Leaves**'; cr. - self leavesPrintOn: aStream - tallyExact: isExact - orThreshold: threshold! Item was removed: - ----- Method: MessageTally>>rootPrintOn:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- - rootPrintOn: aStream total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold - | groups sons | - ShowProcesses ifFalse:[ - ^self treePrintOn: aStream - tabs: OrderedCollection new - thisTab: '' - total: total - totalTime: totalTime - tallyExact: isExact - orThreshold: threshold. - ]. - sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold]. - groups := sons groupBy:[:aTally| aTally process] having:[:g| true]. - groups do:[:g| | p | - sons := g asSortedCollection. - p := g anyOne process. - "Do not show 'other processes' " - "Please keep consistency with #leavesInto:fromSender: - on showing them or not!!" - p ifNotNil: [ - 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: isExact - orThreshold: threshold]]. - ].! Item was removed: - ----- Method: MessageTally>>leavesPrintOn:tallyExact:orThreshold: (in category 'printing') ----- - leavesPrintOn: aStream tallyExact: isExact orThreshold: threshold - | dict | - dict := IdentityDictionary new: 100. - self leavesInto: dict fromSender: nil. - isExact ifTrue: - [dict asSortedCollection - do: [:node | - node printOn: aStream total: tally totalTime: nil tallyExact: isExact. - node printSenderCountsOn: aStream]] - ifFalse: - [(dict asOrderedCollection - select: [:node | node tally > threshold]) - asSortedCollection - do: [:node | - node printOn: aStream total: tally totalTime: time tallyExact: isExact]]! |
Re: The Trunk: System-ar.242.mcz
|
|
Andreas,
one rationale for ... do: [| blockScope | ... blockScope := ...] ... over | methodScope | ... do: [... methodScope := ...]
is that if ever one adds parallel do to the language the former continues to work whereas the latter breaks. Personally I find declaring things at method scope that are truly block scope bad style and not forward looking. Yes, the auto declare facility is poor in this regard but it's fixable.
2¢ On Wed, Feb 3, 2010 at 9:35 PM, <[hidden email]> wrote: Andreas Raab uploaded a new version of System to project The Trunk: |
Re: The Trunk: System-ar.242.mcz
|
|
Eliot Miranda wrote:
> Andreas, > > one rationale for > ... > do: [| blockScope | ... blockScope := ...] > ... > over > | methodScope | > ... > do: [... methodScope := ...] > is that if ever one adds parallel do to the language the former > continues to work whereas the latter breaks. Personally I find > declaring things at method scope that are truly block scope bad style > and not forward looking. Yes, the auto declare facility is poor in this > regard but it's fixable. The change wasn't intentional, I was merging a whole bunch of stuff from Juan and wasn't going to rewrite every method manually to push the temps into the proper place. You'll have to accept that when you merge external code you get some of that style along with your own. Not much to do unless you fix the tools to do The Right Thing by default. Cheers, - Andreas |
Re: The Trunk: System-ar.242.mcz
|
|
On Wed, Feb 3, 2010 at 9:51 PM, Andreas Raab <[hidden email]> wrote:
Ah! Hush my mouth!!
|
Re: The Trunk: System-ar.242.mcz
|
|
Eliot Miranda wrote:
> > > On Wed, Feb 3, 2010 at 9:51 PM, Andreas Raab <[hidden email] > <mailto:[hidden email]>> wrote: > > Eliot Miranda wrote: > > Andreas, > > one rationale for ... > do: [| blockScope | ... blockScope := ...] > ... > over > | methodScope | > ... > do: [... methodScope := ...] > is that if ever one adds parallel do to the language the > former continues to work whereas the latter breaks. > Personally I find declaring things at method scope that are > truly block scope bad style and not forward looking. Yes, the > auto declare facility is poor in this regard but it's fixable. > > > The change wasn't intentional, I was merging a whole bunch of > stuff from Juan and wasn't going to rewrite every method manually > to push the temps into the proper place. You'll have to accept > that when you merge external code you get some of that style along > with your own. Not much to do unless you fix the tools to do The > Right Thing by default. > > > Ah! Hush my mouth!! > > > > Cheers, > - Andreas > BTW, I've been playing a bit with Eliot's measurements. The attach includes the result. It is done for Cuis, a bit of simple tweaking will be needed for Squeak. Eliot, I think I found 2 bugs in your measurement code. One is in looking for copied values in the second scan. It should be done before the #interpretNextInstructionFor: call. This affects the count of clean closures. The other bug is that the second scan scans just for one closure. For methods with more than one closure (non-nested), we need to keep scanning, and the results are now not about closures, but about methods. Please look at my code to see how I did it. #eliotsClosureMeasurements is equivalent to yours, with a few comments on the bugs. #eliotsClosureMeasurements2 is my refactored and fixed version. There are several utility methods too, like #browseMethodsWithClosuresThatWriteOuterTemps . With all this, Cuis 2.0 has 698 methods with closures that write to outer temps, including those in MessageTally. I'll review them all manually soon. Cheers, Juan Vuletich 'From Cuis 2.0 of 4 January 2010 [latest update: #393] on 5 February 2010 at 11:19:46 am'! !classDefinition: #PlayingWithClosures category: #'Playing with Closures'! Object subclass: #PlayingWithClosures instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Playing with Closures'! !PlayingWithClosures commentStamp: 'jmv 12/28/2009 10:25' prior: 0! Just some scripts for learning about Closures! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:22'! exp01Argument ^ [ :a | a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:11'! exp01LocalTemp ^ [ | a | a := 1. a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:13'! exp01RemoteTemp | a | a := 1. ^ [ a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 10:59'! exp01RemoteTempAssignedTwice | a | a := 1. ^ [ a := 2. a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 10:49'! exp01RemoteTempCanBeMovedInside | a | ^ [ a := 1. a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 10:49'! exp01RemoteTempCantBeMovedInside | a | a := 1. ^ [ a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:14'! exp01RemoteTempOptimized | a | a := 1. ^1>0 ifTrue: [ a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:13'! exp01RemoteTempOptimizedWithAssignment | a | ^1>0 ifTrue: [ a := 1. a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 12/28/2009 11:29'! exp01RemoteTempWithAssignment | a | ^ [ a := 1. a+1 ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 09:59'! exp01SelfSend ^ [ self printString, 'p' ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 09:59'! exp01SuperSend ^ [ super exp01SuperSend, 'p' ]! ! !PlayingWithClosures class methodsFor: 'experiments' stamp: 'jmv 2/5/2010 10:46'! exp01UpArrowReturn ^ [ ^self ]! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:43'! browseMethodsWithClosuresThatAccessOuterTemps " Smalltalk browseMethodsWithClosuresThatAccessOuterTemps " self browseMessageList: (self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | anyClosureHasCopied ]. ]) name: 'Closures that read or write to outer temps'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:43'! browseMethodsWithClosuresThatOnlyReadOuterTemps " Smalltalk browseMethodsWithClosuresThatOnlyReadOuterTemps " self browseMessageList: (self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopiedValues :anyClosureDoesUAR :anyClosureUsesSelf | anyClosureHasCopiedValues & hasIndirectTemps not]. ]) name: 'Closures that read but not write to outer temps'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:43'! browseMethodsWithClosuresThatWriteOuterTemps " Smalltalk browseMethodsWithClosuresThatWriteOuterTemps " self browseMessageList: (self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | hasIndirectTemps ]. ]) name: ' Closures that write to outer temps'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 11:04'! browseMethodsWithClosuresThatWriteOuterTempsButCleanOtherwise " Smalltalk browseMethodsWithClosuresThatWriteOuterTempsButCleanOtherwise " self browseMessageList: (self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | hasIndirectTemps and: [ anyClosureDoesUAR not and: [ anyClosureUsesSelf not ] ] ]. ]) name: ' Closures that write to outer temps, but clean otherwise'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:30'! browseMethodsWithMoreThanOneClosure " Smalltalk browseMethodsWithMoreThanOneClosure " self browseMessageList: (self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | closuresCount > 1 ]. ]) name: 'Methods with more than one Closure'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:31'! browseMethodsWithOnlyCleanClosures " Smalltalk browseMethodsWithOnlyCleanClosures " self browseMessageList: ( self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | closuresCount > 0 and: [ (anyClosureHasCopied or: [ anyClosureDoesUAR or: [ anyClosureUsesSelf ]]) not ]. ] ]) name: 'Methods with only Clean Closures'! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 11:19'! eliotsClosureMeasurements " Smalltalk eliotsClosureMeasurements From http://www.mirandabanda.org/cogblog/2008/11/14/mechanised-modifications-and-miscellaneous-measurements/ by Eliot Miranda " | numMethods numMethodsWithClosure numMethodsWithIndirectTemps numClosures numClosuresWithCopiedValues numCopiedValuesForClosure numRemoteTemps numScopesWithRemoteTemps upArrowReturnsInClosure closureUsesSelfs upArrowReturnAndUsesSelfs numClean | numMethods := numMethodsWithClosure := numMethodsWithIndirectTemps := numClosures := numClosuresWithCopiedValues := numCopiedValuesForClosure := numRemoteTemps := numScopesWithRemoteTemps := upArrowReturnsInClosure := closureUsesSelfs := upArrowReturnAndUsesSelfs := numClean := 0. self allSelect: [:m| | s hasClosure hasIndirectTemps blkPc blkSz doesUAR usesSelf hasCopied sel| sel _ false. hasClosure := hasIndirectTemps := false. s := InstructionStream on: m. s scanFor: [:b| b = 143 "closure creation" ifTrue: [hasClosure := true. numClosures := numClosures + 1. s followingByte >= 16 ifTrue: [numClosuresWithCopiedValues := numClosuresWithCopiedValues + 1. numCopiedValuesForClosure := numCopiedValuesForClosure + (s followingByte >> 4)]]. (b = 138 "indirect temp vector creation" and: [s followingByte <= 127]) ifTrue: [hasIndirectTemps := true. numScopesWithRemoteTemps := numScopesWithRemoteTemps + 1. numRemoteTemps := numRemoteTemps + s followingByte]. false]. numMethods := numMethods + 1. hasClosure ifTrue: [numMethodsWithClosure := numMethodsWithClosure + 1. s pc: m initialPC; scanFor: [:b| b = 143]. "jmv-This looks like the correct place to do this" hasCopied := s followingByte >= 16. blkSz := s interpretNextInstructionFor: BlockStartLocator new. blkPc := s pc. doesUAR := usesSelf := false. "jmv-Doing this here looks like a bug. See the other comment" hasCopied := s followingByte >= 16. "jmv-Another bug. This only considers the first closure (and any nested closure in it), but not later ones" s scanFor: [:b| s pc >= (blkPc + blkSz) ifTrue: [true] ifFalse: [doesUAR := doesUAR or: [s willReturn and: [s willBlockReturn not]]. usesSelf := usesSelf or: [b = 112 "pushSelf" or: [b < 16 "pushInstVar" or: [(b = 128 and: [s followingByte <= 63]) "pushInstVar" or: [(b between: 96 and: 96 + 7) "storePopInstVar" or: [(b = 130 and: [s followingByte <= 63]) "storePopInstVar" or: [(b = 129 and: [s followingByte <= 63]) "storeInstVar" or: [b = 132 and: [s followingByte = 160]]]]]]]]. false]]. doesUAR ifTrue: [upArrowReturnsInClosure := upArrowReturnsInClosure + 1]. usesSelf ifTrue: [closureUsesSelfs := closureUsesSelfs + 1]. (doesUAR and: [usesSelf]) ifTrue: [upArrowReturnAndUsesSelfs := upArrowReturnAndUsesSelfs + 1]. (doesUAR or: [usesSelf or: [hasCopied]]) ifFalse: [numClean := numClean + 1]]. hasIndirectTemps ifTrue: [numMethodsWithIndirectTemps := numMethodsWithIndirectTemps + 1]. sel]. ^ { {'Methods'. numMethods}. {'MethodsWithClosure'. numMethodsWithClosure}. {'MethodsWithIndirectTemps'. numMethodsWithIndirectTemps}. {'Closures'. numClosures}. {'CopiedValuesForClosures'. numCopiedValuesForClosure}. {'ClosuresWithCopiedValues'. numClosuresWithCopiedValues}. {'RemoteTemps'. numRemoteTemps}. {'ScopesWithRemoteTemps'. numScopesWithRemoteTemps}. {'MethodsWithUpArrowReturnsInClosures'. upArrowReturnsInClosure}. {'MethodsWithReferencesToSelfInClosures'. closureUsesSelfs}. {'Both'. upArrowReturnAndUsesSelfs}. {'MethodsWithOnlyCleanClosures'. numClean} }! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:44'! eliotsClosureMeasurements2 " Smalltalk eliotsClosureMeasurements2 " | numMethods numMethodsWithClosure numMethodsWithIndirectTemps anyClosureDoesUARCount anyClosureUsesSelfCount bothCount onlyCleanBlocksCount anyClosureHasCopiedCount | numMethods := numMethodsWithClosure := numMethodsWithIndirectTemps := anyClosureDoesUARCount := anyClosureUsesSelfCount := bothCount := onlyCleanBlocksCount := 0. anyClosureHasCopiedCount _ 0. self allSelect: [ :m | self eliotsClosureMeasurementsOn: m over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | numMethods := numMethods + 1. closuresCount > 0 ifTrue: [ numMethodsWithClosure := numMethodsWithClosure + 1 ]. hasIndirectTemps ifTrue: [ numMethodsWithIndirectTemps := numMethodsWithIndirectTemps + 1]. anyClosureDoesUAR ifTrue: [ anyClosureDoesUARCount := anyClosureDoesUARCount + 1]. anyClosureUsesSelf ifTrue: [ anyClosureUsesSelfCount := anyClosureUsesSelfCount + 1]. (anyClosureDoesUAR and: [anyClosureUsesSelf]) ifTrue: [ bothCount := bothCount + 1]. closuresCount > 0 ifTrue: [ (anyClosureDoesUAR or: [anyClosureUsesSelf or: [anyClosureHasCopied]]) ifFalse: [ onlyCleanBlocksCount := onlyCleanBlocksCount + 1]]. anyClosureHasCopied ifTrue: [ anyClosureHasCopiedCount _ anyClosureHasCopiedCount + 1 ]. false. ] ]. ^{ {'Methods'. numMethods}. {'MethodsWithClosure'. numMethodsWithClosure}. {'WithClosuresAccessingOuterTemps'. anyClosureHasCopiedCount}. {'WithClosuresWritingOuterTemps'. numMethodsWithIndirectTemps}. {'WithUpArrowReturnsInClosures'. anyClosureDoesUARCount}. {'WithReferencesToSelfInClosures'. anyClosureUsesSelfCount}. {'BothAbove'. bothCount}. {'WithOnlyCleanClosures'. onlyCleanBlocksCount}. }! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 11:00'! eliotsClosureMeasurements2On: aMethod " A Couple of Clean Closures Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01Argument Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01LocalTemp Closures reading and writing to outer temps Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTemp Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempWithAssignment Closure doing an up-arrow return Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01UpArrowReturn Closures sending messages to self & super Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01SelfSend Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01SuperSend A couple of non-closures, i.e. blocks that are optimized by the compiler and a closure is never created Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempOptimized Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempOptimizedWithAssignment A remote temp whose declaration can not be moved inside the block Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempCantBeMovedInside Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempAssignedTwice A remote temp whose declaration can be moved inside the block Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01RemoteTempCanBeMovedInside A not-so remote temp. The declaration was moved inside the block, making it a clean block Smalltalk eliotsClosureMeasurements2On: PlayingWithClosures class >> #exp01LocalTemp " | numMethods numMethodsWithClosure numMethodsWithIndirectTemps anyClosureDoesUARCount anyClosureUsesSelfCount bothCount onlyCleanBlocksCount anyClosureHasCopiedCount | numMethods := numMethodsWithClosure := numMethodsWithIndirectTemps := anyClosureDoesUARCount := anyClosureUsesSelfCount := bothCount := onlyCleanBlocksCount := 0. anyClosureHasCopiedCount _ 0. self eliotsClosureMeasurementsOn: aMethod over: [ :closuresCount :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | numMethods := numMethods + 1. closuresCount > 0 ifTrue: [ numMethodsWithClosure := numMethodsWithClosure + 1 ]. hasIndirectTemps ifTrue: [ numMethodsWithIndirectTemps := numMethodsWithIndirectTemps + 1]. anyClosureDoesUAR ifTrue: [ anyClosureDoesUARCount := anyClosureDoesUARCount + 1]. anyClosureUsesSelf ifTrue: [ anyClosureUsesSelfCount := anyClosureUsesSelfCount + 1]. (anyClosureDoesUAR and: [anyClosureUsesSelf]) ifTrue: [ bothCount := bothCount + 1]. closuresCount > 0 ifTrue: [ (anyClosureDoesUAR or: [anyClosureUsesSelf or: [anyClosureHasCopied]]) ifFalse: [ onlyCleanBlocksCount := onlyCleanBlocksCount + 1]]. anyClosureHasCopied ifTrue: [ anyClosureHasCopiedCount _ anyClosureHasCopiedCount + 1 ]. false. ]. ^{ {'Methods'. numMethods}. {'MethodsWithClosure'. numMethodsWithClosure}. {'WithClosuresAccessingOuterTemps'. anyClosureHasCopiedCount}. {'WithClosuresWritingOuterTemps'. numMethodsWithIndirectTemps}. {'WithUpArrowReturnsInClosures'. anyClosureDoesUARCount}. {'WithReferencesToSelfInClosures'. anyClosureUsesSelfCount}. {'BothAbove'. bothCount}. {'WithOnlyCleanClosures'. onlyCleanBlocksCount}. }! ! !SystemDictionary methodsFor: 'Closure measurements' stamp: 'jmv 2/5/2010 10:29'! eliotsClosureMeasurementsOn: m over: aFiveArgBlock " See senders. Or try something like: Smalltalk eliotsClosureMeasurementsOn: FileList >> #defaultContents over: [ :closuresCount :hasCopiedValuesForClosure :hasIndirectTemps :anyClosureHasCopied :anyClosureDoesUAR :anyClosureUsesSelf | (Array with: closuresCount with: hasCopiedValuesForClosure with: hasIndirectTemps with: anyClosureHasCopied with: anyClosureDoesUAR with: anyClosureUsesSelf)] From http://www.mirandabanda.org/cogblog/2008/11/14/mechanised-modifications-and-miscellaneous-measurements/ by Eliot Miranda " | s nextScanStart thisClosureHasCopied closuresCount hasIndirectTemps blkPc blkSz anyClosureHasCopied anyClosureDoesUAR anyClosureUsesSelf analyzedClosures | closuresCount := 0. hasIndirectTemps := false. anyClosureHasCopied := anyClosureDoesUAR := anyClosureUsesSelf := false. s := InstructionStream on: m. s scanFor: [ :b | b = 16r8F "16r8F = 143 closure creation" ifTrue: [ closuresCount := closuresCount + 1]. (b = 16r8A "16r8A = 138indirect temp vector creation" and: [ s followingByte <= 127]) ifTrue: [ hasIndirectTemps := true]. false]. nextScanStart := m initialPC. analyzedClosures := 0. [ analyzedClosures < closuresCount ] whileTrue: [ s pc: nextScanStart; scanFor: [ :b | b = 16r8F ]. "16r8F = 143 Search for first closure" analyzedClosures := analyzedClosures + 1. thisClosureHasCopied := s followingByte >= 16r10. anyClosureHasCopied := anyClosureHasCopied | thisClosureHasCopied. blkSz := s interpretNextInstructionFor: BlockStartLocator new. "Findout size of first closure" blkPc := s pc. s scanFor: [ :b | s pc >= (blkPc + blkSz) ifTrue: [ nextScanStart := s pc. true] ifFalse: [ b = 16r8F ifTrue: [ thisClosureHasCopied := s followingByte >= 16r10. anyClosureHasCopied := anyClosureHasCopied | thisClosureHasCopied. analyzedClosures := analyzedClosures + 1 ]. anyClosureDoesUAR := anyClosureDoesUAR or: [s willReturn and: [s willBlockReturn not]]. anyClosureUsesSelf := anyClosureUsesSelf or: [b = 16r70 "pushSelf" or: [b < 16r10 "pushInstVar" or: [(b = 16r80 and: [s followingByte <= 16r3F]) "pushInstVar" or: [(b between: 16r60 and: 16r60 + 7) "storePopInstVar" or: [(b = 16r82 and: [s followingByte <= 63]) "storePopInstVar" or: [(b = 16r81 and: [s followingByte <= 63]) "storeInstVar" or: [b = 16r84 and: [s followingByte = 160]]]]]]]]. false]]]. ^aFiveArgBlock valueWithArguments: (Array with: closuresCount with: hasIndirectTemps with: anyClosureHasCopied with: anyClosureDoesUAR with: anyClosureUsesSelf)! ! !SystemDictionary reorganize! ('accessing' organization) ('class names' classNamed: classNames flushClassNameCache forgetClass:logged: hasClassNamed: removeClassNamed: renameAndUpdateReferences:as: renameClass:as: renameClassNamed:as:) ('dictionary access' associationAtOrAbove:ifAbsent: associationOrUndeclaredAt: at:put: atOrAbove:ifAbsent: atOrBelow:ifAbsent: environmentForCategory: includesKeyOrAbove: kernelCategories scopeFor:from:envtAndPathIfFound:) ('housekeeping' browseObsoleteMethodReferences browseUndeclaredReferences cleanOutUndeclared compressSources condenseChanges condenseSources forgetDoIts macroBenchmark1 macroBenchmark3 makeInternalRelease obsoleteBehaviors obsoleteClasses obsoleteMethodReferences reclaimDependents recompileAllFrom: removeAllLineFeeds removeEmptyMessageCategories removeTextCode testDecompiler testFormatter testFormatter2 verifyChanges) ('image, changes name' changeImageNameTo: changesName fullNameForChangesNamed: fullNameForImageNamed: imageName imageName: imagePath sourcesName vmPath) ('memory space' bytesLeft bytesLeft: bytesLeftString createStackOverflow garbageCollect garbageCollectMost installLowSpaceWatcher lowSpaceThreshold lowSpaceWatcher lowSpaceWatcherProcess okayToProceedEvenIfSpaceIsLow primBytesLeft primLowSpaceSemaphore: primSignalAtBytesLeft: primitiveGarbageCollect signalLowSpace useUpMemory useUpMemoryWithArrays useUpMemoryWithContexts useUpMemoryWithTinyObjects) ('code authors' agreedContributors allContributors contributionsOf: missingAuthorsWithMethods newContributors okContributors returnedSignatories) ('miscellaneous' exitToDebugger extraVMMemory extraVMMemory: getSystemAttribute: getVMParameters handleUserInterrupt hasMorphic listBuiltinModule: listBuiltinModules listLoadedModule: listLoadedModules logError:inContext:to: osVersion platformName platformSubtype setMacFileInfoOn: unloadModule: verifyMorphicAvailability vmParameterAt: vmParameterAt:put: vmVersion) ('objects from disk' objectForDataStream: storeDataOn:) ('printing' printElementsOn:) ('profiling' clearProfile dumpProfile profile: startProfiling stopProfiling) ('retrieving' allBehaviorsDo: allCallsOn: allCallsOn:and: allClasses allClassesDo: allClassesImplementing: allGlobalRefs allGlobalRefsWithout: allImplementedMessages allImplementedMessagesWithout: allImplementorsOf: allImplementorsOf:localTo: allMethodsInCategory: allMethodsWithSourceString:matchCase: allMethodsWithString: allObjectsDo: allObjectsSelect: allPrimitiveMessages allPrimitiveMethodsInCategories: allSelect: allSelectNoDoits: allSentMessages allSentMessagesWithout: allUnSentMessages allUnSentMessagesIn: allUnSentMessagesWithout: allUnimplementedCalls allUnusedClassesWithout: isThereAnImplementorOf: numberOfImplementorsOf: pointersTo: pointersTo:except: pointersToItem:of: poolUsers selectorsWithAnyImplementorsIn: unimplemented) ('shrinking' abandonSources abandonTempNames computeImageSegmentation discardNetworking discardOddsAndEnds fileOutAndRemove: fileOutAndRemove:retainingRoots: fileOutAndRemove:withOtherClasses:andOtherMessages: lastRemoval presumedSentMessages removeAllUnSentMessages removeSelector: removedUnusedClassesAndMethods reportClassAndMethodRemovalsFor: unusedClasses unusedClassesAndMethodsWithout: writeImageSegmentsFrom:withKernel:) ('snapshot and quit' add:toList:after: addToShutDownList: addToShutDownList:after: addToStartUpList: addToStartUpList:after: lastQuitLogPosition processShutDownList: processStartUpList: quitPrimitive readDocumentFile removeFromShutDownList: removeFromStartUpList: saveAs saveAsEmbeddedImage saveAsNewVersion saveChangesInFileNamed: saveImageInFileNamed: saveImageSegments saveSession send:toClassesNamedIn:with: setGCParameters setPlatformPreferences shutDown snapshot:andQuit: snapshotEmbeddedPrimitive snapshotPrimitive unbindExternalPrimitives) ('sources, change log' aboutThisSystem assureStartupStampLogged closeSourceFiles currentChangeSetString datedVersion endianness event: externalizeSources forceChangesToDisk internalizeChangeLog internalizeSources isBigEndian isLittleEndian lastUpdateString logChange: logChange:preamble: openSourceFiles recover: systemInformationString timeStamp: version writeRecentCharacters:toFileNamed: writeRecentToFile) ('special objects' clearExternalObjects compactClassesArray externalObjects hasSpecialSelector:ifTrueSetByte: recreateSpecialObjectsArray registerExternalObject: specialNargsAt: specialObjectsArray specialSelectorAt: specialSelectorSize specialSelectors unregisterExternalObject:) ('copying' veryDeepCopyWith:) ('deprecated' removeClassFromSystem:logged: swapBytesIn:from:to:) ('toDeprecate' getFileNameFromUser snapshot:andQuit:embedded:) ('ui' confirmRemovalOf:on: inspectGlobals) ('browsing' browseAllAccessesTo:from: browseAllCallsOn: browseAllCallsOn:and: browseAllCallsOn:localTo: browseAllCallsOnClass: browseAllImplementorsOf: browseAllImplementorsOf:localTo: browseAllImplementorsOfList: browseAllImplementorsOfList:title: browseAllMethodsInCategory: browseAllObjectReferencesTo:except:ifNone: browseAllSelect: browseAllSelect:name:autoSelect: browseAllStoresInto:from: browseAllUnSentMessages browseAllUnimplementedCalls browseClassCommentsWithString: browseClassesWithNamesContaining:caseSensitive: browseInstVarDefs: browseInstVarRefs: browseMessageList:name: browseMessageList:name:autoSelect: browseMethodsWhoseNamesContain: browseMethodsWithSourceString: browseMethodsWithString: browseMethodsWithString:matchCase: browseObsoleteReferences showMenuOf:withFirstItem:ifChosenDo: showMenuOf:withFirstItem:ifChosenDo:withCaption:) ('private' allSymbolsIn:do:) ('Compiler swapping' actualCompiledMethodWithNodeClass actualCompilerClass actualDecompilerClass actualEncoderClass actualMessageNodeClass actualParserClass actualScannerClass) ('Closure measurements' browseMethodsWithClosuresThatAccessOuterTemps browseMethodsWithClosuresThatOnlyReadOuterTemps browseMethodsWithClosuresThatWriteOuterTemps browseMethodsWithClosuresThatWriteOuterTempsButCleanOtherwise browseMethodsWithMoreThanOneClosure browseMethodsWithOnlyCleanClosures eliotsClosureMeasurements eliotsClosureMeasurements2 eliotsClosureMeasurements2On: eliotsClosureMeasurementsOn:over:) ! |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |