"{ Package: 'stx:libcomp' }"

ByteCodeCompiler subclass:#InstrumentingCompiler
	instanceVariableNames:'method methodEntryInfo blockInvocationInfo'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler-Instrumentation'
!

Object subclass:#InstrumentationInfo
	instanceVariableNames:'owningMethod'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler
!

InstrumentingCompiler::InstrumentationInfo subclass:#BlockExecutionInfo
	instanceVariableNames:'startPosition endPosition count'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler
!

InstrumentingCompiler::InstrumentationInfo subclass:#MethodInvocationInfo
	instanceVariableNames:'infoPerReceiverClass'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler
!

Object subclass:#MethodInvocationInfoPerReceiverClass
	instanceVariableNames:'infoPerSendingMethod'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler::MethodInvocationInfo
!

Object subclass:#MethodInvocationInfoPerSendingMethod
	instanceVariableNames:'countPerSendersClass invokedViaPerform'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass
!

!InstrumentingCompiler class methodsFor:'documentation'!

documentation
"
    an experiment - recompile classes using this compiler adds instrumentation
    code. This remembers who calls a method (methodInvocationInfo) and how often
    basic blocks are invoked (blockExecutionInfo).
"
! !

!InstrumentingCompiler class methodsFor:'compilation-public'!

compileClass:aClass
    "compile all methods of aClass with instrumentation"

    aClass methodsDo:[:eachMethod |
        self compileMethod:eachMethod
    ].
!

compileMethod:aMethod
    "compile a single method with instrumentation"

    self 
        compile:(aMethod source)
        forClass:(aMethod mclass) 
        inCategory:(aMethod category)
! !

!InstrumentingCompiler class methodsFor:'special'!

allInstrumentedMethods
    ^ InstrumentedMethod allInstances 

    "
     self allInstrumentedMethods
    "

    "Modified: / 27-04-2010 / 13:37:51 / cg"
!

callersOf:aMethod do:aBlock
    |info|

    info := aMethod methodInvocationInfo.
    info notNil ifTrue:[
        info callingMethodsDo:[:callingMethod |
            aBlock value:callingMethod
        ]
    ]

    "Modified: / 27-04-2010 / 13:35:00 / cg"
!

isInstrumented:aMethod
    ^ aMethod isInstrumented

    "
     self methodInfoOf:aMethod
    "

    "Modified: / 27-04-2010 / 13:35:21 / cg"
!

methodInfoOf:aMethod
    <resource: #obsolete>

    self obsoleteMethodWarning:'please use Method >> methodInvocationInfo'.
    ^ aMethod methodInvocationInfo

    "
     self methodInfoOf:aMethod
    "

    "Modified: / 27-04-2010 / 13:37:31 / cg"
!

methodInvocationInfoOf:aMethod
    self obsoleteMethodWarning:'please use method>>methodInvocationInfo'.
    ^ aMethod methodInvocationInfo

    "
     self methodInfoOf:aMethod
    "

    "Created: / 27-04-2010 / 12:28:56 / cg"
    "Modified: / 27-04-2010 / 13:34:36 / cg"
! !

!InstrumentingCompiler methodsFor:'code generation helpers'!

addBlockCounterTo:aBlockNode
    |countCode blockEntryInfo|

    blockInvocationInfo isNil ifTrue:[
        blockInvocationInfo := OrderedCollection new.
    ].
    blockEntryInfo := BlockExecutionInfo new cleanInfo.
    blockEntryInfo startPosition:aBlockNode startPosition endPosition:aBlockNode endPosition.
    blockInvocationInfo add:blockEntryInfo.

    countCode := 
        StatementNode 
            expression:(MessageNode 
                            receiver:(ConstantNode value:blockEntryInfo)
                            selector:#entry:
                            arg:(VariableNode type:#ThisContext context:contextToEvaluateIn)).

    aBlockNode isEmptyBlock ifTrue:[
        "/ q: are we interested in empty blocks ?
        aBlockNode statements:countCode.
    ] ifFalse:[
        countCode nextStatement:aBlockNode statements.
        aBlockNode statements:countCode.
    ].

    "Modified: / 28-04-2010 / 15:55:30 / cg"
!

addBlockCountersToEachBlockIn:aCollection
    aCollection do:[:eachNode |
        eachNode isBlockNode ifTrue:[
            self addBlockCounterTo:eachNode
        ]
    ].

    "Created: / 27-04-2010 / 11:47:56 / cg"
!

createMethod
    method := super createMethod.

    methodEntryInfo notNil ifTrue:[
        methodEntryInfo owningMethod:method    
    ].
    blockInvocationInfo notNil ifTrue:[
        blockInvocationInfo do:[:eachInfo | eachInfo owningMethod:method]
    ].

    ^ method

    "Modified: / 27-04-2010 / 14:04:50 / cg"
!

methodClass
    ^ InstrumentedMethod

    "Created: / 27-04-2010 / 12:17:22 / cg"
! !

!InstrumentingCompiler methodsFor:'code generation-hooks'!

blockNodeRewriteHookFor:aBlockNode
    "/ add a counter for the block
    self addBlockCounterTo:aBlockNode.
    ^ aBlockNode

    "Created: / 28-04-2010 / 14:21:27 / cg"
!

messageNodeRewriteHookFor:aMessageNode
"/ see blockNodeRewriter...

"/    "/ argument could be a constantNode (due to contant-folding optimization)
"/    aMessageNode isConstant ifTrue:[^ aMessageNode].
"/    (
"/        #( 
"/            ifTrue: 
"/            ifFalse:
"/            ifTrue:ifFalse: 
"/            ifFalse:ifTrue: 
"/        )
"/        includes:aMessageNode selector
"/    ) ifTrue:[
"/        "/ add a counter for the block
"/        self addBlockCountersToEachBlockIn:(aMessageNode arguments)
"/    ].
    ^ aMessageNode

    "Created: / 27-04-2010 / 11:43:22 / cg"
    "Modified: / 28-04-2010 / 14:22:05 / cg"
!

startCodeGenerationHookOn:codeStream
    methodEntryInfo := MethodInvocationInfo new.

    (StatementNode 
        expression:(MessageNode 
                        receiver:(ConstantNode value:methodEntryInfo)
                        selector:#entry:
                        arg:(VariableNode type:#ThisContext context:contextToEvaluateIn)))
            codeForSideEffectOn:codeStream inBlock:nil for:self.

    "Modified: / 27-04-2010 / 11:50:48 / cg"
! !

!InstrumentingCompiler::InstrumentationInfo class methodsFor:'cleanup'!

allInfosDo:aBlock
    InstrumentedMethod allInstancesDo:[:m |
        m literalsDo:[:l |
            (l isKindOf:self) ifTrue:[
                aBlock value:l.
            ].
        ]
    ].

    "Created: / 27-04-2010 / 12:09:03 / cg"
!

cleanAllInfo
    self allInfosDo:[:l |
        l cleanInfo.
    ].

    "
     InstrumentingCompiler::InstrumentationInfo cleanAllInfo
     InstrumentingCompiler::MethodInvocationInfo cleanAllInfo
    "

    "Modified: / 27-04-2010 / 12:10:07 / cg"
! !

!InstrumentingCompiler::InstrumentationInfo methodsFor:'accessing'!

owningMethod:something
    owningMethod := something.
! !

!InstrumentingCompiler::InstrumentationInfo methodsFor:'instrumentation probe calls'!

entry:callingContext
    "probe entry from instrumented code"

    "Created: / 27-04-2010 / 12:06:48 / cg"
! !

!InstrumentingCompiler::BlockExecutionInfo methodsFor:'accessing'!

callCount
    ^ count

    "Created: / 27-04-2010 / 13:45:15 / cg"
!

characterPosition
    ^ startPosition

    "Created: / 23-06-2006 / 13:31:19 / cg"
    "Modified: / 28-04-2010 / 15:54:24 / cg"
!

characterPosition:something
    startPosition := something.

    "Created: / 23-06-2006 / 13:31:19 / cg"
    "Modified: / 28-04-2010 / 15:54:30 / cg"
!

count
    ^ count

    "Created: / 23-06-2006 / 13:31:28 / cg"
!

endPosition
    ^ endPosition

    "Created: / 28-04-2010 / 15:57:14 / cg"
!

startPosition
    ^ startPosition

    "Created: / 28-04-2010 / 15:54:26 / cg"
!

startPosition:startArg endPosition:endArg
    startPosition := startArg.
    endPosition := endArg.

    "Created: / 28-04-2010 / 15:54:47 / cg"
! !

!InstrumentingCompiler::BlockExecutionInfo methodsFor:'cleanup'!

cleanInfo
    count := 0
! !

!InstrumentingCompiler::BlockExecutionInfo methodsFor:'instrumentation calls'!

entry:callingContext
    "probe entry from instrumented code;
     called whenever the block is entered"

"/ self halt.
    count := count + 1.
    count == 1 ifTrue:[
        owningMethod changed:#methodInfo
    ].

    "Created: / 23-06-2006 / 13:31:16 / cg"
    "Modified: / 27-04-2010 / 14:03:29 / cg"
! !

!InstrumentingCompiler::BlockExecutionInfo methodsFor:'queries'!

hasBeenExecuted
    ^ count > 0

    "Created: / 28-04-2010 / 14:39:46 / cg"
! !

!InstrumentingCompiler::MethodInvocationInfo methodsFor:'accessing'!

callingMethodsDo:aBlock
    infoPerReceiverClass notNil ifTrue:[
        infoPerReceiverClass do:[:each |
            each callingMethodsDo:aBlock
        ]
    ]
!

hasBeenCalled
    ^ infoPerReceiverClass notEmptyOrNil

    "Created: / 27-04-2010 / 13:43:15 / cg"
!

invokedViaPerform
    ^ infoPerReceiverClass contains:[:someInfo | someInfo invokedViaPerform].

    "Created: / 27-04-2010 / 18:21:56 / cg"
!

invokingMethods
    |setOfMethods|

    setOfMethods := IdentitySet new.
    self invokingMethodsDo:[:m | setOfMethods add:m].
    ^ setOfMethods.
!

invokingMethodsDo:aBlock
    infoPerReceiverClass isNil ifTrue:[ ^ self].
    ^ infoPerReceiverClass do:[:eachInfo | eachInfo invokingMethodsDo:aBlock].
!

numberOfInvocations
    infoPerReceiverClass isNil ifTrue:[ ^ 0].
    ^ infoPerReceiverClass inject:0 into:[:sumSoFar :info | sumSoFar + info numberOfInvocations] 
!

numberOfInvocationsFromExternalOf:aClass
    |sum|

    infoPerReceiverClass isNil ifTrue:[ ^ 0].

    sum := 0.
    infoPerReceiverClass keysAndValuesDo:[:recClass :info |
        sum := sum + (info numberOfInvocationsFromExternalOf:aClass)
    ]. 
    ^ sum
!

numberOfInvocationsFromInternalOf:aClass
    |sum|

    infoPerReceiverClass isNil ifTrue:[ ^ 0].

    sum := 0.
    infoPerReceiverClass keysAndValuesDo:[:recClass :info |
        sum := sum + (info numberOfInvocationsFromInternalOf:aClass)
    ]. 
    ^ sum
! !

!InstrumentingCompiler::MethodInvocationInfo methodsFor:'cleanup'!

cleanInfo
    infoPerReceiverClass := nil.
! !

!InstrumentingCompiler::MethodInvocationInfo methodsFor:'instrumentation probe calls'!

entry:aContext
    "invoked by instrumented compiled code, upon method entry"

    |receiversClass infoPerReceiver|

    receiversClass := aContext receiver class.
    infoPerReceiverClass isNil ifTrue:[
        infoPerReceiverClass := IdentityDictionary new.
    ].
    infoPerReceiver := infoPerReceiverClass 
                        at:receiversClass 
                        ifAbsentPut:[ MethodInvocationInfoPerReceiverClass new ].
    infoPerReceiver entry:aContext
! !

!InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass methodsFor:'accessing'!

callingMethodsDo:aBlock
    infoPerSendingMethod keysAndValuesDo:[:m :eachInfo |
        aBlock value:m
    ]
!

invokedViaPerform
    ^ infoPerSendingMethod contains:[:someInfo | someInfo invokedViaPerform].

    "Created: / 27-04-2010 / 18:21:36 / cg"
!

invokingMethodsDo:aBlock
    infoPerSendingMethod isNil ifTrue:[ ^ self].
    ^ infoPerSendingMethod keysDo:aBlock.
!

numberOfInvocations
    infoPerSendingMethod isNil ifTrue:[ ^ 0].
    ^ infoPerSendingMethod inject:0 into:[:sumSoFar :info | sumSoFar + info numberOfInvocations] 
!

numberOfInvocationsFromExternalOf:aClass
    |sum|

    infoPerSendingMethod isNil ifTrue:[ ^ 0].

    sum := 0.
    infoPerSendingMethod keysAndValuesDo:[:sendingMethod :info |
        |sendingMethodsClass|

        sendingMethodsClass := sendingMethod mclass.
        sendingMethodsClass notNil ifTrue:[
            ((sendingMethodsClass isSubclassOf:aClass) 
            or:[(aClass isSubclassOf:sendingMethodsClass )]) ifFalse:[
                sum := sum + (info numberOfInvocations)
            ]
        ]
    ]. 
    ^ sum
!

numberOfInvocationsFromInternalOf:aClass
    |sum|

    infoPerSendingMethod isNil ifTrue:[ ^ 0].

    sum := 0.
    infoPerSendingMethod keysAndValuesDo:[:sendingMethod :info |
        |sendingMethodsClass|

        sendingMethodsClass := sendingMethod mclass.
        sendingMethodsClass notNil ifTrue:[
            ((sendingMethodsClass isSubclassOf:aClass) 
            or:[(aClass isSubclassOf:sendingMethodsClass)]) ifTrue:[
                sum := sum + (info numberOfInvocations)
            ]
        ]
    ]. 
    ^ sum
! !

!InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass methodsFor:'instrumentation calls'!

entry:aContext
    "invoked by instrumented compiled code, upon method entry"

    |sender sendingMethod infoPerMethod viaPerform|

    sender := aContext sender methodHome.
    sender isNil ifTrue:[
        ^ self.
    ] ifFalse:[
        sendingMethod := sender method.
        viaPerform := false.

        (sendingMethod mclass == Object 
        and:[ sendingMethod selector startsWith:'perform:'] ) ifTrue:[
            "/ Transcript showCR:('%1 [info]: skipping #perform' bindWith:self class nameWithoutPrefix).
            sender := sender sender methodHome.
            sendingMethod := sender method.
            viaPerform := true.
        ].
    ].

    infoPerSendingMethod isNil ifTrue:[
        infoPerSendingMethod := IdentityDictionary new.
    ].
    infoPerMethod := infoPerSendingMethod 
                        at:sendingMethod 
                        ifAbsentPut:[ MethodInvocationInfoPerSendingMethod new ].

    infoPerMethod entry:aContext viaPerform:viaPerform

    "Modified: / 28-04-2010 / 16:09:04 / cg"
! !

!InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass::MethodInvocationInfoPerSendingMethod methodsFor:'accessing'!

invokedViaPerform
    ^ invokedViaPerform ? false

    "Created: / 27-04-2010 / 18:20:05 / cg"
!

numberOfInvocations
    countPerSendersClass isNil ifTrue:[ ^ 0].
    ^ countPerSendersClass inject:0 into:[:sumSoFar :count | sumSoFar + count] 
! !

!InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass::MethodInvocationInfoPerSendingMethod methodsFor:'instrumentation calls'!

entry:aContext viaPerform:viaPerformBoolean
    "invoked by instrumented compiled code, upon method entry"

    |sendersClass count|

    sendersClass := aContext sender receiver class.

    countPerSendersClass isNil ifTrue:[
        countPerSendersClass := IdentityDictionary new.
    ].
    count := countPerSendersClass at:sendersClass ifAbsentPut:0.
    countPerSendersClass at:sendersClass put:(count + 1).
    viaPerformBoolean ifTrue:[ invokedViaPerform := true ].

    "Created: / 27-04-2010 / 18:17:27 / cg"
! !

!InstrumentingCompiler class methodsFor:'documentation'!

version_CVS
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentingCompiler.st,v 1.4 2010-04-30 09:59:44 cg Exp $'
! !