hg/stx-libcomp: comparison InstrumentingCompiler.st

equal deleted inserted replaced

-:0ac586956983
+:e48d46439c08
 	poolDictionaries:''
 	privateIn:InstrumentingCompiler::MethodInvocationInfo
 !
 Object subclass:#MethodInvocationInfoPerSendingMethod
-	instanceVariableNames:'countPerSendersClass'
+	instanceVariableNames:'countPerSendersClass invokedViaPerform'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass
 !
 ^ 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].
 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.
 !InstrumentingCompiler::MethodInvocationInfo::MethodInvocationInfoPerReceiverClass methodsFor:'instrumentation calls'!
 entry:aContext
 "invoked by instrumented compiled code, upon method entry"
-|sender sendingMethod infoPerMethod|
+|sender sendingMethod infoPerMethod viaPerform|
 sender := aContext sender methodHome.
 sendingMethod := sender method.
+viaPerform := false.
 (sendingMethod mclass == Object
 and:[ sendingMethod selector startsWith:'perform:'] ) ifTrue:[
-Transcript showCR:('%1 [info]: skipping #perform' bindWith:self class nameWithoutPrefix).
+"/ 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
+infoPerMethod entry:aContext viaPerform:viaPerform
-"Modified: / 27-04-2010 / 12:13:08 / cg"
+"Modified: / 27-04-2010 / 18:19: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
+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)
+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.2 2010-04-27 12:54:19 cg Exp $'
+^ '$Header: /cvs/stx/stx/libcomp/InstrumentingCompiler.st,v 1.3 2010-04-27 17:04:32 cg Exp $'
 ! !

changeset 2368	e48d46439c08
parent 2359	b70f2c9dddcf
child 2370	a801cc4df234