"{ Package: 'stx:libcomp' }"

ByteCodeCompiler subclass:#InstrumentingCompiler

	instanceVariableNames:'method methodEntryInfo blockInvocationInfo'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Compiler-Instrumentation'

!

InstrumentationInfo subclass:#StatementExecutionInfo

	instanceVariableNames:'startPosition count'

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentationInfo subclass:#MethodInvocationInfo

	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::MethodInvocationInfo subclass:#MethodInvocationInfoForCoverageInAlreadyEnteredState

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentingCompiler::MethodInvocationInfo subclass:#MethodInvocationInfoInAlreadyEnteredState

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentingCompiler::StatementExecutionInfo subclass:#VariableAccessExecutionInfo

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentingCompiler::StatementExecutionInfo subclass:#BlockExecutionInfo

	instanceVariableNames:'endPosition'

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentingCompiler::VariableAccessExecutionInfo subclass:#ReadAccessExecutionInfo

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:InstrumentingCompiler

!

InstrumentingCompiler::VariableAccessExecutionInfo subclass:#WriteAccessExecutionInfo

	instanceVariableNames:''

	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 from where (methodInvocationInfo) what the receiver's types are

    (inherited classes) and how often basic blocks (blockExecutionInfo) and statements 

    (statementExecutionInfo) are invoked .

    The who-calls and receiver type info may produce some overhead, which can be avoided by 

    using the somewhat more naive InstrumentingForSimpleCoverageCompiler (that is what people are

    used to from the C/Java world, anyway).

    From the first bulk, we can compute the inheritanceCoverage info (which methods have been called for which

    subclass) in addition to the known line and block coverages.

"

! !

!InstrumentingCompiler class methodsFor:'compilation-public'!

compileClass:aClass

    "compile all methods of aClass with instrumentation"

    aClass instAndClassMethodsDo:[:eachMethod |

        self compileMethod:eachMethod

    ].

!

compileMethod:aMethod

    "compile a single method with instrumentation"

    self 

        compile:(aMethod source)

        forClass:(aMethod mclass) 

        inCategory:(aMethod category)

!

compilePackage:aPackageID

    "compile all classes of a package instrumentation"

    Smalltalk allClassesInPackage:aPackageID do:[:eachClass |

        self compileClass:eachClass

    ].

    "

     InstrumentingCompiler compilePackage:'exept:workflow'.

     InstrumentingCompiler compilePackage:'exept:expecco'.

    "

! !

!InstrumentingCompiler class methodsFor:'special'!

allInstrumentedMethods

    ^ InstrumentedMethod allInstances 

    "

     self allInstrumentedMethods

    "

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

!

callersOf:aMethod do:aBlock

    "enumerate all callers of aMethod into a block"

    |info|

    info := aMethod methodInvocationInfo.

    info notNil ifTrue:[

        info callingMethodsDo:[:callingMethod |

            aBlock value:callingMethod

        ]

    ]

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

    "Modified (comment): / 07-08-2011 / 15:08:33 / 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

    "called by the compiler to instrument a block node"

    |countCode blockEntryInfo|

    blockInvocationInfo isNil ifTrue:[

        blockInvocationInfo := OrderedCollection new.

    ].

    blockEntryInfo := self blockExecutionInfoInstance.

    blockEntryInfo startPosition:aBlockNode startPosition endPosition:aBlockNode endPosition.

"/    Transcript show:aBlockNode startPosition;

"/     show:' -> ';

"/     showCR: 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 ?

        countCode nextStatement:(StatementNode expression:(ConstantNode value:nil)).

        aBlockNode statements:countCode.

    ] ifFalse:[

        countCode nextStatement:aBlockNode statements.

        aBlockNode statements:countCode.

    ].

    "Modified: / 21-08-2011 / 16:02:52 / cg"

!

addBlockCountersToEachBlockIn:aCollection

    "called by the compiler to instrument a collection of block nodes"

    aCollection do:[:eachNode |

        eachNode isBlockNode ifTrue:[

            self addBlockCounterTo:eachNode

        ]

    ].

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

!

createMethod

    "called by the compiler to instatiate a new method instance"

    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

    "called by the compiler to ask for the method instance's class"

    ^ InstrumentedMethod

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

!

statementCounterBefore:aStatementNode

    "called by the compiler to instrument a statement node (head of a basic block)"

    |countCode statementEntryInfo|

    blockInvocationInfo isNil ifTrue:[

        blockInvocationInfo := OrderedCollection new.

    ].

    statementEntryInfo := self statementExecutionInfoInstance.

    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

    "Modified: / 07-08-2011 / 15:32:45 / cg"

! !

!InstrumentingCompiler methodsFor:'code generation hooks'!

assignmentRewriteHookFor:anAssignmentNode

    "invoked whenever an assignment node has been generated"

    ^ anAssignmentNode

    "Created: / 30-09-2011 / 12:28:09 / cg"

!

blockNodeRewriteHookFor:aBlockNode

    "invoked whenever a block node has been generated"

    "/ add a counter for the block

    self addBlockCounterTo:aBlockNode.

    ^ aBlockNode

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

!

messageNodeRewriteHookFor:aMessageNode

    "invoked whenever a message send node has been generated"

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

    "Modified (comment): / 30-09-2011 / 12:16:56 / cg"

!

startCodeGenerationHookOn:codeStream

    "invoked before code is generated"

    methodEntryInfo := self methodInvocationInfoInstance.

    (StatementNode 

        expression:(MessageNode 

                        receiver:(ConstantNode value:methodEntryInfo)

                        selector:#entry:

                        arg:(VariableNode type:#ThisContext context:contextToEvaluateIn)))

            codeForSideEffectOn:codeStream inBlock:nil for:self.

    "Modified: / 07-08-2011 / 15:34:09 / cg"

    "Modified (comment): / 30-09-2011 / 12:16:05 / cg"

!

statementListRewriteHookFor:firstStatement

    "invoked whenever a statement list node has been generated"

    "/ 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.

    ].

    "Modified (comment): / 30-09-2011 / 12:15:52 / cg"

!

variableReadRewriteHookFor:aVariableNode

    "invoked whenever a variable access node has been generated"

    ^ aVariableNode

    "Created: / 30-09-2011 / 12:27:47 / cg"

! !

!InstrumentingCompiler methodsFor:'redefinable'!

blockExecutionInfoInstance

    "one instance is generated for every block,

     and called at execution time with entry:"

    ^ BlockExecutionInfo new cleanInfoWithChange:false.

    "Created: / 07-08-2011 / 15:13:42 / cg"

!

methodInvocationInfoInstance

    "one instance is generated for every method,

     and called at execution time with entry:"

    ^ MethodInvocationInfo new.

    "Created: / 07-08-2011 / 15:33:57 / cg"

!

statementExecutionInfoInstance

    "one instance is generated for every statement,

     and called at execution time with entry:"

    ^ StatementExecutionInfo new cleanInfoWithChange:false.

    "Created: / 07-08-2011 / 15:32:36 / cg"

! !

!InstrumentingCompiler::StatementExecutionInfo class methodsFor:'documentation'!

documentation

"

    (sub)instances of me are updated by instrumented code when statements are executed.

"

! !

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

cleanInfoWithChange:withChange

    count := 0.

    withChange ifTrue:[

        Smalltalk changed:#methodCoverageInfo with:owningMethod.

    ].

    "Modified: / 20-07-2011 / 17:55:49 / cg"

    "Created: / 20-07-2011 / 18:59:01 / cg"

! !

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

entry:callingContext

    "invoked by instrumented code;

     called whenever the block/statment is entered"

    |context|

    context := InstrumentationContext current.

    context isNil ifTrue:[^ self].

    context coverageOnly ifTrue:[

        self hasBeenExecuted ifTrue:[^ self].

    ].