--- a/MessageTracer.st	Sat Jun 15 03:25:19 2013 +0000
+++ b/MessageTracer.st	Thu Jun 20 13:18:06 2013 +0200
@@ -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'
 !
@@ -890,20 +891,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
@@ -926,6 +984,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"
@@ -2744,10 +2807,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
 
@@ -2755,6 +2825,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"
 
@@ -3268,7 +3349,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.124 2013-06-20 11:18:06 cg Exp $'
 ! !