"{ 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:#StatementExecutionInfo
	instanceVariableNames:'startPosition 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::StatementExecutionInfo subclass:#BlockExecutionInfo
	instanceVariableNames:'endPosition'
	classVariableNames:''
	poolDictionaries:''
	privateIn:InstrumentingCompiler
!

!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"
!

statementCounterBefore:aStatementNode
    |countCode statementEntryInfo|

    blockInvocationInfo isNil ifTrue:[
        blockInvocationInfo := OrderedCollection new.
    ].
    statementEntryInfo := StatementExecutionInfo new cleanInfo.
    statementEntryInfo startPosition:aStatementNode startPosition.
    blockInvocationInfo add:statementEntryInfo.

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

    countCode nextStatement:aStatementNode.
    ^ countCode
! !

!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"
!

statementListRewriteHookFor:firstStatement
    "/ care for blocks which return...
    |thisStatement prevStatement countStatement mustInsertExecutionInfo|

    mustInsertExecutionInfo := false.
    prevStatement := nil.

    thisStatement := firstStatement.
    thisStatement isNil ifTrue:[^ firstStatement].

    [true] whileTrue:[
        mustInsertExecutionInfo ifTrue:[
            "/ prev-stat had a return in it (a block with a return);
            "/ insert a statement-entry here.
            thisStatement notNil ifTrue:[
                countStatement := self statementCounterBefore:thisStatement.
                prevStatement nextStatement:countStatement.
                mustInsertExecutionInfo := false.
                prevStatement := countStatement.
            ]
        ].
        thisStatement isNil ifTrue:[^ firstStatement].

        thisStatement isReturnNode ifFalse:[
            thisStatement containsReturn ifTrue:[
                mustInsertExecutionInfo := true    
            ]
        ].
        prevStatement := thisStatement.
        thisStatement := thisStatement nextStatement.
    ].
! !

!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::StatementExecutionInfo 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"
!

startPosition
    ^ startPosition

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

startPosition:something
    startPosition := something.
! !

!InstrumentingCompiler::StatementExecutionInfo methodsFor:'cleanup'!

cleanInfo
    count := 0
! !

!InstrumentingCompiler::StatementExecutionInfo methodsFor:'instrumentation calls'!

entry:callingContext
    "invoked by instrumented code;
     called whenever the block is entered"

    |p|

    count := count + 1.
    count == 1 ifTrue:[
        "/ the very first time, send a change notification
        p := Processor activeProcess.
        (p environmentAt:#inInstrument ifAbsent:false) ifFalse:[
            p withThreadVariable:#inInstrument boundTo:true do:[
                owningMethod changed:#methodInfo
            ].
        ]
    ].

    "Created: / 23-06-2006 / 13:31:16 / cg"
    "Modified: / 05-07-2011 / 13:35:25 / cg"
! !

!InstrumentingCompiler::StatementExecutionInfo 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"

    |p receiversClass infoPerReceiver|

    p := Processor activeProcess.
    (p environmentAt:#inInstrument ifAbsent:false) ifTrue:[^ self].
    p withThreadVariable:#inInstrument boundTo:true do:[
        receiversClass := aContext receiver class.
        infoPerReceiverClass isNil ifTrue:[
            infoPerReceiverClass := IdentityDictionary new.
        ].
        infoPerReceiver := infoPerReceiverClass 
                            at:receiversClass 
                            ifAbsentPut:[ MethodInvocationInfoPerReceiverClass new ].
        infoPerReceiver entry:aContext
    ]

    "Modified: / 05-07-2011 / 13:35:42 / cg"
! !

!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|

    aContext selector == #doesNotUnderstand: ifTrue:[
        sender := aContext sender sender methodHome.
    ] ifFalse:[
        sender := aContext sender methodHome.
    ].
    sender isNil ifTrue:[
        ^ self.
    ] ifFalse:[
        sendingMethod := sender method.
        sendingMethod isNil ifTrue:[^ self].

        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::BlockExecutionInfo methodsFor:'accessing'!

endPosition
    ^ endPosition

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

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

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

!InstrumentingCompiler class methodsFor:'documentation'!

version_CVS
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentingCompiler.st,v 1.7 2011-07-05 11:36:04 cg Exp $'
! !