help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] PATCH2/2: post processing and reporting


From: Derek Zhou
Subject: [Help-smalltalk] PATCH2/2: post processing and reporting
Date: Sun, 8 Feb 2009 12:12:52 -0800
User-agent: KMail/1.9.9

This is a couple smalltalk classes to post process the profile and print a 
report. It is old syntax smalltalk though.

Object subclass: #MethodProfile
    instanceVariableNames: 'selfCost totalCost callTimes callees table'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Profiling'!

MethodProfile comment:
    'I store some statistic info about a method, including cast and 
call graph'!

!MethodProfile class methodsFor: 'instance creation'!

newFrom: p in: t
    ^self new initWith: p in: t!
!

!MethodProfile methodsFor: 'basic'!

initWith: p in: t
    "initial self from raw profile p, which is a MethodDictionary"
    selfCost := p at: true.
    table := t.
    "to be figured out later"
    callTimes := 0.
    callees := IdentityDictionary new.
    p keysAndValuesDo: [ :k :v |
        "ignore blocks for now"
        (k ~~ true) & 
            (CallGraph seperateBlocks or: [ k isKindOf: CompiledMethod ]) 
            ifTrue: [ callees at: k put: v ]]!

mergeWith: p
    "merge with raw profile p, which is a MethodDictionary"
    selfCost := selfCost + (p at: true).
    p keysAndValuesDo: [ :k :v |
        "ignore blocks for now"
        (k ~~ true) &
            (CallGraph seperateBlocks or: [ k isKindOf: CompiledMethod ]) 
            ifTrue: [ 
                (callees includesKey: k)
                    ifTrue: [ callees at: k put: v + (callees at: k) ] 
                    ifFalse: [ callees at: k put: v ]]]!
!

!MethodProfile methodsFor: 'printing'!

printCallGraphOn: aStream
    aStream nextPutAll: '0 %1' % {selfCost}; nl.
    callees keysAndValuesDo: [ :callee :n |
        aStream 
            nextPutAll: 'cfl=%1' % {callee methodClass}; nl;
            nextPutAll: 'cfn=%1' % {callee}; nl;
            nextPutAll: 'calls=%1' % {n}; nl;
            nextPutAll: '* %1' % {self costOf: callee}; nl ]!
!

!MethodProfile methodsFor: 'accessing'!

selfCost
    ^selfCost!

totalCost
    totalCost notNil ifTrue: [ ^totalCost ].
    "TODO: better handle loops"
    totalCost := selfCost.
    callees keysAndValuesDo: [ :callee :n |
        totalCost := (self costOf: callee) + totalCost ].
    ^totalCost!

costOf: callee
    |calleeProfile|
    calleeProfile := table at: callee ifAbsent: [nil].
    calleeProfile isNil 
        ifTrue: [ 
            Transcript show: '%1 has no profile' % {callee}; nl.
            ^0 ]
        ifFalse: [ 
            ^(calleeProfile totalCost * (callees at: callee) / 
                  calleeProfile callTimes) ceiling ]!

callTimes
    ^callTimes!

callTimes: n
    callTimes := n!

callees
    ^callees!
!

Object subclass: #CallGraph
    instanceVariableNames: 'methodProfiles'
    classVariableNames: 'seperateBlocks'
    poolDictionaries: ''
    category: ''!

CallGraph comment:
    'I store a call tree and associated profiling info'!

!CallGraph class methodsFor: 'instance creation'!

seperateBlocks
    "return whether to seperate blocks in the report"
    ^seperateBlocks!

seperateBlocks: bool
    "set whether to seperate blocks in the report, default is false"
    seperateBlocks := bool!

new
    "capture the current raw profile. Infers Smalltalk profilerOff"
    Smalltalk profilerOff.
    ^super new 
        initFrom: (Smalltalk rawProfile);
        computeCallTimes;
        computeCost;
        yourself!
!

CallGraph seperateBlocks: false!

!CallGraph methodsFor: 'basic'!

initFrom: p
    methodProfiles := IdentityDictionary new: 256.
    p keysAndValuesDo: [ :k :v |
        |method|
        "merge the costs of block to the mother method. If we treat block calls
         as full blown method calls then a method like 
         SequenceableCollection>>do:, with do nothing but invoking blocks, 
         will see highly varied execution paths and may cause many false
         recursions, both of which will produce highly skewed cost 
         allocation."
        method := (seperateBlocks or: [ k isKindOf: CompiledMethod ]) 
            ifTrue: [ k ]
            ifFalse: [ k method ].
        (methodProfiles includesKey: method)
            ifTrue: [ (methodProfiles at: method) mergeWith: v ]
            ifFalse: [ methodProfiles at: method put: 
                           (MethodProfile newFrom: v in: methodProfiles)]]!

computeCallTimes
    methodProfiles do: [ :profile |
        profile callees keysAndValuesDo: [ :callee :n |
            |calleeProfile|
            calleeProfile := methodProfiles at: callee ifAbsent: [nil].
            calleeProfile isNil 
                ifTrue: [ 
                    Transcript show: '%1 has no profile' % {callee}; nl ]
                ifFalse: [
                    calleeProfile callTimes: 
                              (calleeProfile callTimes + n) ]]]!

computeCost
    methodProfiles do: [ :profile | 
        profile totalCost ]!

totalCost
    ^methodProfiles inject: 0 into: [ :sum :profile |
        sum + profile selfCost ]!

methodCount
    ^methodProfiles size!
!

!CallGraph methodsFor: 'printing'!

printCallGraphOn: aStream
"print a callgrind compatible profile report on aStream"
    self printHeaderOn: aStream.
    methodProfiles keysAndValuesDo: [ :method :profile |
    aStream
        nextPutAll: 'fl=%1' % {method methodClass}; nl;
        nextPutAll: 'fn=%1' % {method}; nl.
        profile printCallGraphOn: aStream.
        aStream nl ]!

printCallGraphToFile: fn
"print a callgrind compatible profile report to a file named fn"
    |fs|
    fs := (File name: fn) writeStream.
    [ self printCallGraphOn: fs ] ensure: [ fs close ]!

printHeaderOn: aStream
    aStream 
        nextPutAll: 'version: 1'; nl;
        nextPutAll: 'creator: gst profile'; nl;
        nextPutAll: 'positions: instr'; nl;
        nextPutAll: 'events: Ir'; nl;
        nextPutAll: 'summary: %1' % {self totalCost}; nl; nl!
!





reply via email to

[Prev in Thread] Current Thread [Next in Thread]