MessageTracer.st
changeset 4451 8fcca6fa38f7
parent 4403 f3d3c97042ea
child 4452 48908302f213
--- a/MessageTracer.st	Fri Jun 28 09:02:35 2019 +0200
+++ b/MessageTracer.st	Sat Jun 29 09:22:41 2019 +0200
@@ -541,11 +541,13 @@
     "evaluate aBlock sending trace information to stdout.
      Return the value of the block."
 
-     ^ self trace:aBlock on:Processor activeProcess stderr
+     ^ self trace:aBlock on:(Processor activeProcess stderr)
 
     "
      MessageTracer trace:[#(6 5 4 3 2 1) sort]
     "
+
+    "Modified (comment): / 29-06-2019 / 09:05:58 / Claus Gittinger"
 !
 
 trace:aBlock on:aStream
@@ -566,11 +568,13 @@
      Return the value of the block.
      The trace information is more detailed."
 
-     ^ self traceFull:aBlock on:Processor activeProcess stderr
+     ^ self traceFull:aBlock on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
     "
+
+    "Modified (comment): / 29-06-2019 / 09:05:54 / Claus Gittinger"
 !
 
 traceFull:aBlock on:aStream
@@ -592,49 +596,57 @@
      Return the value of the block.
      The trace information is more detailed."
 
-     ^ self traceFullIndented:aBlock on:Processor activeProcess stderr
+     ^ self traceFullIndented:aBlock on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
     "
+
+    "Modified (comment): / 29-06-2019 / 09:05:51 / Claus Gittinger"
 !
 
 traceFullIndented:aBlock on:aStream
-    "evaluate aBlock sending trace information to stdout.
+    "evaluate aBlock sending trace information to aStream.
      Return the value of the block.
      The trace information is more detailed."
 
      ^ PrintingMessageTracer new
-	output:aStream;
-	trace:aBlock detail:#fullIndent.
+        output:aStream;
+        trace:aBlock detail:#fullIndent.
 
     "
      MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
     "
+
+    "Modified (comment): / 29-06-2019 / 09:04:56 / Claus Gittinger"
 !
 
 traceIndented:aBlock
     "evaluate aBlock sending trace information to stdout.
      Return the value of the block."
 
-     ^ self traceIndented:aBlock on:Processor activeProcess stderr
+     ^ self traceIndented:aBlock on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ]
     "
+
+    "Modified (comment): / 29-06-2019 / 09:05:21 / Claus Gittinger"
 !
 
 traceIndented:aBlock on:aStream
-    "evaluate aBlock sending trace information to stdout.
+    "evaluate aBlock sending trace information to aStream.
      Return the value of the block."
 
      ^ PrintingMessageTracer new
-	output:aStream;
-	trace:aBlock detail:#indent.
+        output:aStream;
+        trace:aBlock detail:#indent.
 
     "
      MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ] on:Transcript
     "
+
+    "Modified (comment): / 29-06-2019 / 09:04:47 / Claus Gittinger"
 ! !
 
 !MessageTracer class methodsFor:'method breakpointing'!
@@ -1723,7 +1735,7 @@
     "arrange for a trace message to be output on Stderr, when a message with aSelector is
      sent to instances of aClass (or subclass instances). Use untraceClass to remove this."
 
-    self traceClass:aClass selector:aSelector on:Processor activeProcess stderr
+    self traceClass:aClass selector:aSelector on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceClass:Integer selector:#factorial.
@@ -1741,6 +1753,8 @@
      #(6 1 9 66 2 17) copy sort.
      MessageTracer untraceClass:Array
     "
+
+    "Modified (comment): / 29-06-2019 / 09:06:09 / Claus Gittinger"
 !
 
 traceClass:aClass selector:aSelector on:aStream
@@ -1767,7 +1781,7 @@
      when aMethod is executed. Traces both entry and exit.
      Use unwrapMethod to remove this."
 
-    ^ self traceMethod:aMethod on:Processor activeProcess stderr
+    ^ self traceMethod:aMethod on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
@@ -1794,6 +1808,64 @@
      MessageTracer untraceMethod:(Object compiledMethodAt:#at:).
      MessageTracer untraceMethod:(Object compiledMethodAt:#at:put:).
     "
+
+    "Modified (comment): / 29-06-2019 / 09:06:15 / Claus Gittinger"
+!
+
+traceMethod:aMethod in:aProcess on:aStream
+    "arrange for a trace message to be output on aStream,
+     when aMethod is executed. Traces both entry and exit.
+     Use unwrapMethod to remove this."
+
+    |lvl inside|
+
+    ^ self wrapMethod:aMethod
+         onEntry:[:con |
+                        (Processor activeProcess processGroupId = aProcess id) ifTrue:[
+                            inside isNil ifTrue:[
+                                inside := true.
+                                CallingLevel isNil ifTrue:[
+                                    CallingLevel := 0.
+                                ].
+                                lvl notNil ifTrue:[
+                                    lvl := lvl + 1
+                                ] ifFalse:[
+                                    CallingLevel := lvl := CallingLevel + 1.
+                                ].
+                                MessageTracer printEntryFull:con level:lvl on:aStream.
+                                inside := nil
+                            ]
+                        ]
+                 ]
+         onExit:[:con :retVal |
+                        (Processor activeProcess processGroupId = aProcess id) ifTrue:[
+                            inside isNil ifTrue:[
+                                inside := true.
+                                MessageTracer printExit:con with:retVal level:lvl on:aStream.
+                                CallingLevel := lvl := lvl - 1.
+                                inside := nil
+                            ].
+                        ].
+                        retVal
+                ]
+
+    "
+     MessageTracer traceMethod:(Integer compiledMethodAt:#factorial) on:Transcript.
+     5 factorial.
+     MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+    "
+    "
+     MessageTracer traceMethod:(Integer compiledMethodAt:#factorialR) on:Transcript.
+     5 factorialR.
+     MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+    "
+    "
+     MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:) on:Transcript.
+     #(6 1 9 66 2 17) copy sort.
+     MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+    "
+
+    "Created: / 29-06-2019 / 09:13:48 / Claus Gittinger"
 !
 
 traceMethod:aMethod on:aStream
@@ -1865,7 +1937,7 @@
      when aMethod is executed. Only entry is traced.
      Use unwrapMethod to remove this."
 
-    ^ self traceMethodEntry:aMethod on:Processor activeProcess stderr
+    ^ self traceMethodEntry:aMethod on:(Processor activeProcess stderr)
 
     "
      MessageTracer traceMethodEntry:(Integer compiledMethodAt:#factorial).
@@ -1882,6 +1954,8 @@
      #(6 1 9 66 2 17) copy sort.
      MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
     "
+
+    "Modified (comment): / 29-06-2019 / 09:06:32 / Claus Gittinger"
 !
 
 traceMethodEntry:aMethod on:aStream
@@ -1931,24 +2005,53 @@
      Only the sender is traced on entry.
      Use untraceMethod to remove this trace."
 
-    ^ self traceMethodFull:aMethod on:Processor activeProcess stderr
-
-    "Created: 15.12.1995 / 18:19:31 / cg"
-    "Modified: 22.10.1996 / 17:39:28 / cg"
+    ^ self traceMethodFull:aMethod on:(Processor activeProcess stderr)
+
+    "Created: / 15-12-1995 / 18:19:31 / cg"
+    "Modified: / 22-10-1996 / 17:39:28 / cg"
+    "Modified (format): / 29-06-2019 / 09:06:38 / Claus Gittinger"
+!
+
+traceMethodFull:aMethod in:aProcess on:aStream
+    "arrange for a full trace message to be output on aStream, when aMethod is executed.
+     Only the sender is traced on entry.
+     Use untraceMethod to remove this trace."
+
+    |onEntry onExit|
+
+    onEntry := (self traceFullBlockFor:aStream).
+    onExit := LeaveTraceBlock.
+    
+    ^ self
+        wrapMethod:aMethod
+        onEntry:[:con |
+                        (Processor activeProcess processGroupId = aProcess id) ifTrue:[
+                            onEntry value:con
+                        ]
+                ]        
+        onExit:[:con :retVal |
+                        (Processor activeProcess processGroupId = aProcess id) ifTrue:[
+                            LeaveTraceBlock value:con value:retVal
+                        ].
+                        retVal
+               ].
+
+    "Created: / 29-06-2019 / 09:20:22 / Claus Gittinger"
 !
 
 traceMethodFull:aMethod on:aStream
-    "arrange for a full trace message to be output on Stderr, when aMethod is executed.
+    "arrange for a full trace message to be output on aStream, when aMethod is executed.
      Only the sender is traced on entry.
      Use untraceMethod to remove this trace."
 
     ^ self
-	wrapMethod:aMethod
-	onEntry:(self traceFullBlockFor:aStream)
-	onExit:LeaveTraceBlock.
-
-    "Created: 15.12.1995 / 18:19:31 / cg"
-    "Modified: 22.10.1996 / 17:39:28 / cg"
+        wrapMethod:aMethod
+        onEntry:(self traceFullBlockFor:aStream)
+        onExit:LeaveTraceBlock.
+
+    "Created: / 15-12-1995 / 18:19:31 / cg"
+    "Modified: / 22-10-1996 / 17:39:28 / cg"
+    "Modified (comment): / 29-06-2019 / 09:06:47 / Claus Gittinger"
 !
 
 traceMethodSender:aMethod
@@ -1957,20 +2060,23 @@
      Only the sender is traced on entry.
      Use untraceMethod to remove this trace."
 
-    ^ self traceMethodSender:aMethod on:Processor activeProcess stderr
+    ^ self traceMethodSender:aMethod on:(Processor activeProcess stderr)
+
+    "Modified (format): / 29-06-2019 / 09:06:51 / Claus Gittinger"
 !
 
 traceMethodSender:aMethod on:aStream
-    "arrange for a trace message to be output on Stderr, when amethod is executed.
+    "arrange for a trace message to be output on aStream, when amethod is executed.
      Only the sender is traced on entry.
      Use untraceMethod to remove this trace."
 
     ^ self
-	wrapMethod:aMethod
-	onEntry:(self traceSenderBlockFor:aStream)
-	onExit:LeaveTraceBlock.
-
-    "Modified: 22.10.1996 / 17:39:33 / cg"
+        wrapMethod:aMethod
+        onEntry:(self traceSenderBlockFor:aStream)
+        onExit:LeaveTraceBlock.
+
+    "Modified: / 22-10-1996 / 17:39:33 / cg"
+    "Modified (comment): / 29-06-2019 / 09:06:56 / Claus Gittinger"
 !
 
 traceUpdateMethod:aMethod on:aStream
@@ -2897,7 +3003,7 @@
      Use untrap to remove this trace.
      The current implementation does not allow integers or nil to be traced."
 
-    self trace:anObject selector:aSelector on:Processor activeProcess stderr
+    self trace:anObject selector:aSelector on:(Processor activeProcess stderr)
 
     "
      |p|
@@ -2919,19 +3025,20 @@
      a sort.
     "
 
-    "Modified: / 21.4.1998 / 15:37:05 / cg"
+    "Modified: / 21-04-1998 / 15:37:05 / cg"
+    "Modified (comment): / 29-06-2019 / 09:07:12 / Claus Gittinger"
 !
 
 trace:anObject selector:aSelector on:aStream
-    "arrange for a trace message to be output on Stderr, when a message with
+    "arrange for a trace message to be output on aStream, when a message with
      aSelector is sent to anObject. Both entry and exit are traced.
      Use untrap to remove this trace.
      The current implementation does not allow integers or nil to be traced."
 
     self
-	trace:anObject
-	selectors:(Array with:aSelector)
-	on:aStream
+        trace:anObject
+        selectors:(Array with:aSelector)
+        on:aStream
 
     "
      |p|
@@ -2953,7 +3060,8 @@
      a sort.
     "
 
-    "Modified: / 21.4.1998 / 15:37:05 / cg"
+    "Modified: / 21-04-1998 / 15:37:05 / cg"
+    "Modified (comment): / 29-06-2019 / 09:07:17 / Claus Gittinger"
 !
 
 trace:anObject selectors:aCollectionOfSelectors
@@ -2963,7 +3071,7 @@
      Use untrap:/untrace: to remove this trace.
      The current implementation does not allow integers or nil to be traced."
 
-    self trace:anObject selectors:aCollectionOfSelectors on:Processor activeProcess stderr
+    self trace:anObject selectors:aCollectionOfSelectors on:(Processor activeProcess stderr)
 
     "
      |p|
@@ -2985,39 +3093,40 @@
      a sort.
     "
 
-    "Modified: / 21.4.1998 / 15:41:57 / cg"
+    "Modified: / 21-04-1998 / 15:41:57 / cg"
+    "Modified (comment): / 29-06-2019 / 09:07:24 / Claus Gittinger"
 !
 
 trace:anObject selectors:aCollectionOfSelectors on:aStream
-    "arrange for a trace message to be output on Stderr, when any message
+    "arrange for a trace message to be output on aStream, when any message
      from aCollectionOfSelectors is sent to anObject.
      Both entry and exit are traced.
      Use untrap:/untrace: to remove this trace.
      The current implementation does not allow integers or nil to be traced."
 
     aCollectionOfSelectors do:[:aSelector |
-	|methodName|
-
-	methodName := anObject class name , '>>' , aSelector.
-	self
-	    wrap:anObject
-	    selector:aSelector
-	    onEntry:[:con |
-			aStream nextPutAll:'enter '; nextPutAll:methodName.
-			aStream nextPutAll:' receiver='.
-			con receiver printOn:aStream.
-			aStream nextPutAll:' args='. (con args) printOn:aStream.
-			aStream nextPutAll:' from:'. con sender printOn:aStream.
-			aStream cr; flush
-		    ]
-	    onExit:[:con :retVal |
-			aStream nextPutAll:'leave '; nextPutAll:methodName.
-			aStream nextPutAll:' receiver='. con receiver printOn:aStream.
-			aStream nextPutAll:' returning:'. retVal printOn:aStream.
-			aStream cr; flush
-		   ]
-	    withOriginalClass:true
-	    flushCaches:false
+        |methodName|
+
+        methodName := anObject class name , '>>' , aSelector.
+        self
+            wrap:anObject
+            selector:aSelector
+            onEntry:[:con |
+                        aStream nextPutAll:'enter '; nextPutAll:methodName.
+                        aStream nextPutAll:' receiver='.
+                        con receiver printOn:aStream.
+                        aStream nextPutAll:' args='. (con args) printOn:aStream.
+                        aStream nextPutAll:' from:'. con sender printOn:aStream.
+                        aStream cr; flush
+                    ]
+            onExit:[:con :retVal |
+                        aStream nextPutAll:'leave '; nextPutAll:methodName.
+                        aStream nextPutAll:' receiver='. con receiver printOn:aStream.
+                        aStream nextPutAll:' returning:'. retVal printOn:aStream.
+                        aStream cr; flush
+                   ]
+            withOriginalClass:true
+            flushCaches:false
     ].
     ObjectMemory flushCaches
 
@@ -3040,13 +3149,14 @@
      a sort.
     "
 
-    "Modified: / 21.4.1998 / 15:41:57 / cg"
+    "Modified: / 21-04-1998 / 15:41:57 / cg"
+    "Modified (comment): / 29-06-2019 / 09:07:28 / Claus Gittinger"
 !
 
 traceAll:anObject
     "trace all messages which are understood by anObject"
 
-    self traceAll:anObject on:Processor activeProcess stderr
+    self traceAll:anObject on:(Processor activeProcess stderr)
 
     "
      trace all (implemented) messages sent to Display
@@ -3058,13 +3168,14 @@
      MessageTracer untrace:Display
     "
 
-    "Modified: 5.6.1996 / 13:43:51 / stefan"
+    "Modified: / 05-06-1996 / 13:43:51 / stefan"
+    "Modified (comment): / 29-06-2019 / 09:07:32 / Claus Gittinger"
 !
 
 traceAll:anObject from:aClass
-    "trace all messages defined in aClass sent to anObject"
-
-    self traceAll:anObject from:aClass on:Processor activeProcess stderr
+    "trace all messages, which are defined in aClass, sent to an anObject on stderr"
+
+    self traceAll:anObject from:aClass on:(Processor activeProcess stderr)
 
     "
      trace all methods in Display, which are implemented
@@ -3076,11 +3187,12 @@
      MessageTracer untrace:Display
     "
 
-    "Modified: 5.6.1996 / 13:45:37 / stefan"
+    "Modified: / 05-06-1996 / 13:45:37 / stefan"
+    "Modified (comment): / 29-06-2019 / 09:08:26 / Claus Gittinger"
 !
 
 traceAll:anObject from:aClass on:aStream
-    "trace all messages defined in aClass sent to anObject"
+    "trace all messages, which are defined in aClass, sent to anObject"
 
     self trace:anObject selectors:aClass selectors on:aStream
 
@@ -3094,7 +3206,8 @@
      MessageTracer untrace:Display
     "
 
-    "Modified: 5.6.1996 / 13:45:37 / stefan"
+    "Modified: / 05-06-1996 / 13:45:37 / stefan"
+    "Modified (comment): / 29-06-2019 / 09:08:38 / Claus Gittinger"
 !
 
 traceAll:anObject on:aStream
@@ -3122,7 +3235,7 @@
 !
 
 traceEntry:anObject selectors:aCollectionOfSelectors on:aStream
-    "arrange for a trace message to be output on Stderr, when any message
+    "arrange for a trace message to be output on aStream, when any message
      from aCollectionOfSelectors is sent to anObject.
      Only entry is traced.
      Use untrap:/untrace: to remove this trace.
@@ -3150,7 +3263,8 @@
      a sort.
     "
 
-    "Modified: / 21.4.1998 / 15:41:57 / cg"
+    "Modified: / 21-04-1998 / 15:41:57 / cg"
+    "Modified (comment): / 29-06-2019 / 09:08:46 / Claus Gittinger"
 !
 
 traceSender:anObject selector:aSelector
@@ -3159,7 +3273,7 @@
      Use untrap to remove this trace.
      The current implementation does not allow integers or nil to be traced."
 
-    ^ self traceSender:anObject selector:aSelector on:Processor activeProcess stderr
+    ^ self traceSender:anObject selector:aSelector on:(Processor activeProcess stderr)
 
     "
      |p|
@@ -3181,11 +3295,12 @@
      a sort.
     "
 
-    "Modified: 10.1.1997 / 17:54:53 / cg"
+    "Modified: / 10-01-1997 / 17:54:53 / cg"
+    "Modified (comment): / 29-06-2019 / 09:08:51 / Claus Gittinger"
 !
 
 traceSender:anObject selector:aSelector on:aStream
-    "arrange for a trace message to be output on Stderr, when a message with
+    "arrange for a trace message to be output on aStream, when a message with
      aSelector is sent to anObject. Only the sender is traced on entry.
      Use untrap to remove this trace.
      The current implementation does not allow integers or nil to be traced."
@@ -3194,14 +3309,14 @@
 
     methodName := anObject class name , '>>' , aSelector.
     self wrap:anObject
-	 selector:aSelector
-	 onEntry:[:con |
-		     aStream nextPutAll:methodName.
-		     aStream nextPutAll:' from '.
-		     con sender printOn:aStream.
-		     aStream cr; flush.
-		 ]
-	 onExit:LeaveTraceBlock.
+         selector:aSelector
+         onEntry:[:con |
+                     aStream nextPutAll:methodName.
+                     aStream nextPutAll:' from '.
+                     con sender printOn:aStream.
+                     aStream cr; flush.
+                 ]
+         onExit:LeaveTraceBlock.
 
     "
      |p|
@@ -3223,7 +3338,8 @@
      a sort.
     "
 
-    "Modified: 10.1.1997 / 17:54:53 / cg"
+    "Modified: / 10-01-1997 / 17:54:53 / cg"
+    "Modified (comment): / 29-06-2019 / 09:08:56 / Claus Gittinger"
 !
 
 untrace:anObject