--- a/MessageTracer.st Wed Jun 12 11:54:30 2013 +0100
+++ b/MessageTracer.st Mon Jul 01 22:14:32 2013 +0100
@@ -15,8 +15,9 @@
instanceVariableNames:'traceDetail tracedBlock'
classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
TraceSenderBlock2 LeaveBreakBlock LeaveTraceBlock MethodCounts
- MethodMemoryUsage MethodTiming TraceFullBlock TraceFullBlock2
- ObjectWrittenBreakpointSignal ObjectCopyHolders TimeForWrappers'
+ MethodCountsPerReceiverClass MethodMemoryUsage MethodTiming
+ TraceFullBlock TraceFullBlock2 ObjectWrittenBreakpointSignal
+ ObjectCopyHolders TimeForWrappers'
poolDictionaries:''
category:'System-Debugging-Support'
!
@@ -936,20 +937,77 @@
"Modified: / 27.7.1998 / 10:47:46 / cg"
!
+countMethodByReceiverClass:aMethod
+ "arrange for a aMethod's execution to be counted and maintain
+ a per-receiver class profile.
+ Use unwrapMethod to remove this."
+
+ MethodCountsPerReceiverClass isNil ifTrue:[
+ MethodCountsPerReceiverClass := IdentityDictionary new.
+ ].
+ MethodCountsPerReceiverClass at:aMethod put:(IdentityDictionary new).
+
+ ^ self wrapMethod:aMethod
+ onEntry:[:con |
+ |cls perMethodCounts cnt|
+
+ cls := (con receiver class).
+ perMethodCounts := MethodCountsPerReceiverClass at:aMethod.
+ cnt := perMethodCounts at:cls ifAbsentPut:0.
+ perMethodCounts at:cls put:(cnt + 1).
+ MessageTracer changed:#statistics: with:aMethod.
+ aMethod changed:#statistics
+ ]
+ onExit:[:con :retVal |
+ ]
+
+ "
+ MessageTracer countMethodWithReceiverStatistic:(Collection compiledMethodAt:#detect:).
+ NewSystemBrowser open.
+ MessageTracer executionCountsOf:(Collection compiledMethodAt:#detect:) printNL.
+ MessageTracer stopCountingMethod:(Collection compiledMethodAt:#detect:)
+ "
+!
+
executionCountOfMethod:aMethod
"return the current count"
- |count|
-
- MethodCounts isNil ifTrue:[^ 0].
- aMethod isWrapped ifTrue:[
- count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
- count notNil ifTrue:[^ count].
+ |count counts|
+
+ MethodCounts notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
+ count notNil ifTrue:[^ count].
+ ].
+ ^ MethodCounts at:aMethod ifAbsent:0
+ ].
+ MethodCountsPerReceiverClass notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
+ ].
+ counts isNil ifTrue:[
+ counts := MethodCounts at:aMethod ifAbsent:#().
+ ].
+ ^ (counts collect:[:eachClassCountAssoc | eachClassCountAssoc value]) sum
].
- ^ MethodCounts at:aMethod ifAbsent:0
-
- "Created: 15.12.1995 / 11:01:56 / cg"
- "Modified: 15.12.1995 / 15:45:15 / cg"
+ ^ 0
+!
+
+executionCountsByReceiverClassOfMethod:aMethod
+ "return a collection mapping receiver class to call counts"
+
+ |counts|
+
+ MethodCountsPerReceiverClass notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
+ ].
+ counts isNil ifTrue:[
+ counts := MethodCounts at:aMethod ifAbsent:#().
+ ].
+ ^ counts
+ ].
+ ^ #()
!
resetCountOfMethod:aMethod
@@ -972,6 +1030,11 @@
MethodCounts removeKey:aMethod originalMethod ifAbsent:nil.
].
].
+ MethodCountsPerReceiverClass notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ MethodCountsPerReceiverClass removeKey:aMethod originalMethod ifAbsent:nil.
+ ].
+ ].
^ self unwrapMethod:aMethod
"Modified: 15.12.1995 / 15:43:53 / cg"
@@ -2182,7 +2245,7 @@
definingClass withAllSuperclassesDo:[:aClass |
aClass methodDictionary keys addAllTo:selectors
].
- idx := anObject class instVarOffsetOf:anInstVarOrOffset.
+ idx := anObject class instVarIndexFor:anInstVarOrOffset.
self
trapModificationsIn:anObject selectors:selectors filter:[:old :new | (old instVarAt:idx) ~~ (new instVarAt:idx)]
]
@@ -2845,10 +2908,17 @@
isCounting:aMethod
"return true if aMethod is counted"
- MethodCounts isNil ifTrue:[^ false].
- (MethodCounts includesKey:aMethod) ifTrue:[^ true].
- aMethod isWrapped ifTrue:[
- ^ MethodCounts includesKey:aMethod originalMethod
+ MethodCounts notNil ifTrue:[
+ (MethodCounts includesKey:aMethod) ifTrue:[^ true].
+ aMethod isWrapped ifTrue:[
+ (MethodCounts includesKey:aMethod originalMethod)ifTrue:[^ true].
+ ].
+ ].
+ MethodCountsPerReceiverClass notNil ifTrue:[
+ (MethodCountsPerReceiverClass includesKey:aMethod) ifTrue:[^ true].
+ aMethod isWrapped ifTrue:[
+ (MethodCountsPerReceiverClass includesKey:aMethod originalMethod)ifTrue:[^ true].
+ ].
].
^ false
@@ -2856,6 +2926,17 @@
"Modified: 15.12.1995 / 15:42:10 / cg"
!
+isCountingByReceiverClass:aMethod
+ "return true if aMethod is counted with per receiver class statistics"
+
+ MethodCountsPerReceiverClass isNil ifTrue:[^ false].
+ (MethodCountsPerReceiverClass includesKey:aMethod) ifTrue:[^ true].
+ aMethod isWrapped ifTrue:[
+ ^ MethodCountsPerReceiverClass includesKey:aMethod originalMethod
+ ].
+ ^ false
+!
+
isTiming:aMethod
"return true if aMethod is timed"
@@ -3367,7 +3448,7 @@
!MessageTracer class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.123 2013-06-04 13:23:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.125 2013-06-30 08:11:02 cg Exp $'
!
version_HG