--- a/MessageTracer.st Fri Jan 29 16:38:31 1999 +0100
+++ b/MessageTracer.st Thu Feb 25 16:23:41 1999 +0100
@@ -20,6 +20,13 @@
category:'System-Debugging-Support'
!
+MessageTracer subclass:#PrintingMessageTracer
+ instanceVariableNames:'tracedBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:MessageTracer
+!
+
!MessageTracer class methodsFor:'documentation'!
copyright
@@ -492,7 +499,7 @@
"evaluate aBlock sending trace information to stdout.
Return the value of the block."
- ^ self new trace:aBlock detail:false.
+ ^ PrintingMessageTracer new trace:aBlock detail:false.
"
MessageTracer trace:[#(6 5 4 3 2 1) sort]
@@ -504,11 +511,34 @@
Return the value of the block.
The trace information is more detailed."
- ^ self new trace:aBlock detail:true.
+ ^ PrintingMessageTracer new trace:aBlock detail:true.
"
MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
"
+!
+
+traceFullIndented:aBlock
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block.
+ The trace information is more detailed."
+
+ ^ PrintingMessageTracer new trace:aBlock detail:#fullIndent.
+
+ "
+ MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
+ "
+!
+
+traceIndented:aBlock
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block."
+
+ ^ PrintingMessageTracer new trace:aBlock detail:#indent.
+
+ "
+ MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ]
+ "
! !
!MessageTracer class methodsFor:'method breakpointing'!
@@ -2547,51 +2577,10 @@
!
printEntryFull:aContext level:lvl on:aStream
- |sender mClass mClassName|
-
- mClass := aContext methodClass.
- mClass isNil ifTrue:[
- mClassName := '???'
- ] ifFalse:[
- mClassName := mClass name
- ].
-
aStream
spaces:lvl;
- nextPutAll:'enter ';
- nextPutAll:mClassName;
- space;
- bold;
- nextPutAll:aContext selector;
- normal;
- nextPutAll:' rec=['.
-
- aContext receiver printOn:aStream.
- aStream nextPutAll:'] '.
- (aContext args) keysAndValuesDo:[:idx :arg |
- |s|
-
- s := arg printString.
- s > 20 ifTrue:[
- s := arg classNameWithArticle
- ].
- aStream nextPutAll:'arg'. idx printOn:aStream. aStream nextPutAll:'=['.
- s printOn:aStream.
- aStream nextPutAll:'] '.
- ].
-
- sender := aContext sender.
- sender notNil ifTrue:[
- (sender selector startsWith:'perform:') ifTrue:[
- sender := sender sender.
- ].
- ].
-
- aStream nextPutAll:'from:'.
- sender printOn:aStream.
- aStream cr; flush.
-
- "Modified: 5.3.1997 / 12:40:55 / cg"
+ nextPutAll:'enter '.
+ self printFull:aContext on:aStream withSender:true.
!
printEntryFull:aContext on:aStream
@@ -2607,6 +2596,7 @@
] ifFalse:[
mClassName := mClass name
].
+
aStream
nextPutAll:mClassName;
space;
@@ -2664,6 +2654,53 @@
self printExit:aContext with:retVal level:0 on:aStream
!
+printFull:aContext on:aStream withSender:withSender
+ |sender mClass mClassName|
+
+ mClass := aContext methodClass.
+ mClass isNil ifTrue:[
+ mClassName := '???'
+ ] ifFalse:[
+ mClassName := mClass name
+ ].
+
+ aStream
+ nextPutAll:mClassName;
+ space;
+ bold;
+ nextPutAll:aContext selector;
+ normal;
+ nextPutAll:' rec=['.
+
+ aContext receiver printOn:aStream.
+ aStream nextPutAll:'] '.
+ (aContext args) keysAndValuesDo:[:idx :arg |
+ |s|
+
+ s := arg printString.
+ s > 20 ifTrue:[
+ s := arg classNameWithArticle
+ ].
+ aStream nextPutAll:'arg'. idx printOn:aStream. aStream nextPutAll:'=['.
+ s printOn:aStream.
+ aStream nextPutAll:'] '.
+ ].
+
+ withSender ifTrue:[
+ sender := aContext sender.
+ sender notNil ifTrue:[
+ (sender selector startsWith:'perform:') ifTrue:[
+ sender := sender sender.
+ ].
+ ].
+ aStream nextPutAll:'from:'.
+ sender printOn:aStream.
+ ].
+ aStream cr; flush.
+
+ "Modified: 5.3.1997 / 12:40:55 / cg"
+!
+
traceEntryFull:aContext on:aStream
aStream nextPutLine:'-----------------------------------------'.
aContext fullPrintAllOn:aStream
@@ -2704,29 +2741,6 @@
!MessageTracer methodsFor:'trace helpers '!
-stepInterrupt
- "called for every send while tracing"
-
- |con|
-
- StepInterruptPending := nil.
- con := thisContext sender.
- con lineNumber == 1 ifTrue:[
- traceDetail == true ifTrue:[
- self class printEntryFull:con on:Stderr.
- ] ifFalse:[
- con printOn:Stderr.
- Stderr cr.
- ]
- ].
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1.
- ^ self
-
- "Modified: 20.5.1996 / 10:28:20 / cg"
-!
-
trace:aBlock detail:fullDetail
"trace execution of aBlock."
@@ -2748,9 +2762,104 @@
"
! !
+!MessageTracer::PrintingMessageTracer methodsFor:'trace helpers '!
+
+stepInterrupt
+ "called for every send while tracing"
+
+ |ignore sel con r|
+
+ StepInterruptPending := nil.
+ con := thisContext sender.
+ ignore := false.
+
+ con receiver == Processor ifTrue:[
+ (sel := con selector) == #threadSwitch: ifTrue:[
+ ignore := true.
+ ].
+ sel == #timerInterrupt ifTrue:[
+ ignore := true.
+ ]
+ ].
+
+ con lineNumber == 1 ifFalse:[
+ ignore := true
+ ].
+
+ ignore ifFalse:[
+ con markForInterruptOnUnwind.
+
+ ((r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]) ifTrue:[
+ traceDetail == #fullIndent ifTrue:[
+ [con notNil
+ and:[(r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]]] whileTrue:[
+ ' ' printOn:Stderr.
+ con := con sender.
+ ].
+ con := thisContext sender.
+ self class printFull:con on:Stderr withSender:false.
+ ] ifFalse:[
+ traceDetail == #indent ifTrue:[
+ [con notNil
+ and:[(r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]]] whileTrue:[
+ ' ' printOn:Stderr.
+ con := con sender.
+ ].
+ con := thisContext sender.
+ con printOn:Stderr.
+ Stderr cr.
+ ] ifFalse:[
+ traceDetail == true ifTrue:[
+ self class printFull:con on:Stderr withSender:true.
+ ] ifFalse:[
+ con printOn:Stderr.
+ Stderr cr.
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := 1.
+ InterruptPending := 1.
+
+ "
+ self new trace:[#(6 5 4 3 2 1) sort] detail:false
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:true
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#indent
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
+ self new trace:[ View new ] detail:#fullIndent
+ "
+!
+
+trace:aBlock detail:fullDetail
+ "trace execution of aBlock."
+
+ tracedBlock := aBlock.
+ ^ super trace:aBlock detail:fullDetail
+
+ "
+ self new trace:[#(6 5 4 3 2 1) sort] detail:false
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:true
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#indent
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
+ "
+
+! !
+
!MessageTracer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.76 1998-11-17 19:18:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.77 1999-02-25 15:23:41 cg Exp $'
! !
MessageTracer initialize!