MessageTracer.st
changeset 17 86bd3a9f6ef0
parent 16 fcbfbba03d49
child 18 3212d3164f28
--- a/MessageTracer.st	Mon Feb 06 00:38:51 1995 +0100
+++ b/MessageTracer.st	Wed Feb 08 04:16:43 1995 +0100
@@ -11,7 +11,7 @@
 "
 
 Object subclass:#MessageTracer
-       instanceVariableNames:'traceHow'
+       instanceVariableNames:'traceDetail'
        classVariableNames:'BreakpointSignal CallingLevel'
        poolDictionaries:''
        category:'System-Support'
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1994 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.7 1995-02-05 23:38:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.8 1995-02-08 03:16:42 claus Exp $
 '!
 
 !MessageTracer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.7 1995-02-05 23:38:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.8 1995-02-08 03:16:42 claus Exp $
 "
 !
 
@@ -177,9 +177,11 @@
 
 trace:aBlock
     "evaluate aBlock sending trace information to stdout.
-     Return the value of the block."
+     Return the value of the block. 
+     Warning, due to the implementation, only one process can be traced at a time. 
+     (since there is currently no per-process stepInterruptHandler)"
 
-    ^ self new trace:aBlock.
+    ^ self new trace:aBlock detail:false.
 
     "
      MessageTracer trace:[#(6 5 4 3 2 1) sort]
@@ -189,9 +191,11 @@
 traceFull:aBlock
     "evaluate aBlock sending trace information to stdout.
      Return the value of the block.
-     The trace information is more detailed."
+     The trace information is more detailed.
+     Warning, due to the implementation, only one process can be traced at a time. 
+     (since there is currently no per-process stepInterruptHandler)"
 
-     ^ self new traceFull:aBlock.
+     ^ self new trace:aBlock detail:true.
 
     "
      MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
@@ -213,36 +217,26 @@
 
 !MessageTracer methodsFor:'trace helpers '!
 
-trace:aBlock
-    "trace execution of aBlock"
+trace:aBlock detail:fullDetail
+    "trace execution of aBlock.
+     Warning, due to the implementation, only one process can be traced at a time. 
+     (since there is currently no per-process stepInterruptHandler)"
 
+    traceDetail := fullDetail.
     ObjectMemory stepInterruptHandler:self.
-    StepInterruptPending := true.
-    InterruptPending := true.
-    ^ aBlock valueNowOrOnUnwindDo:[
+    ^ [
+        ObjectMemory flushInlineCaches.
+        StepInterruptPending := 1.
+        InterruptPending := 1.
+	aBlock value
+    ] valueNowOrOnUnwindDo:[
 	StepInterruptPending := nil.
 	ObjectMemory stepInterruptHandler:nil.
     ]
 
     "
-     MessageTracer trace:[#(6 5 4 3 2 1) sort]
-    "
-!
-
-traceFull:aBlock
-    "trace execution of aBlock"
-
-    traceHow := #detail.
-    ObjectMemory stepInterruptHandler:self.
-    StepInterruptPending := true.
-    InterruptPending := true.
-    ^ aBlock valueNowOrOnUnwindDo:[
-	StepInterruptPending := nil.
-	ObjectMemory stepInterruptHandler:nil.
-    ]
-
-    "
-     MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
+     MessageTracer trace:[#(6 5 4 3 2 1) sort] detail:false
+     MessageTracer trace:[#(6 5 4 3 2 1) sort] detail:true 
     "
 !
 
@@ -250,14 +244,16 @@
     "called for every send while tracing"
 
     StepInterruptPending := nil.
-    traceHow == #detail ifTrue:[
-	self class printEntryFull:thisContext sender.
-"/        thisContext sender printNL.
-    ] ifFalse:[    
-	thisContext sender printNL.
+    thisContext sender lineNumber == 1 ifTrue:[
+        traceDetail == true ifTrue:[
+	    self class printEntryFull:thisContext sender.
+        ] ifFalse:[    
+	    thisContext sender printNL.
+	]
     ].
-    StepInterruptPending := true.
-    InterruptPending := true.
+    ObjectMemory flushInlineCaches.
+    StepInterruptPending := 1.
+    InterruptPending := 1.
     ^ self
 ! !