"{ 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:[

            ].

        ]

    ].

    "Created: / 23-06-2006 / 13:31:16 / 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 firstEntry|

    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.

        ].

        firstEntry := false.

        infoPerReceiver := infoPerReceiverClass 

                            at:receiversClass