--- a/MessageTracer.st Mon Nov 05 18:18:38 2012 +0100
+++ b/MessageTracer.st Tue Nov 06 00:09:21 2012 +0100
@@ -36,7 +36,7 @@
!
MessageTracer subclass:#PrintingMessageTracer
- instanceVariableNames:''
+ instanceVariableNames:'output'
classVariableNames:''
poolDictionaries:''
privateIn:MessageTracer
@@ -62,7 +62,7 @@
"
This class provides a common home for the tracing
facilities (originally, they where in Object, but have been moved to
- allow easier separation of development vs. runtime configurations.
+ allow easier separation of development vs. runtime configurations).
tracing execution of a block:
@@ -213,7 +213,7 @@
[exEnd]
trapping modifications to an objects instVars:
- [exBegin]
+ [exBegin]
|o|
o := Point new.
@@ -223,7 +223,7 @@
o x:1.
o y:2.
MessageTracer untrap:o
- [exEnd]
+ [exEnd]
trapping modifications of a particular instVar:
[exBegin]
@@ -237,6 +237,11 @@
o y:2.
MessageTracer untrap:o
[exEnd]
+ tracing during block execution:
+ [exBegin]
+ MessageTracer trace:[ 10 factorialR ]
+ [exEnd]
+
"
! !
@@ -518,19 +523,46 @@
"evaluate aBlock sending trace information to stdout.
Return the value of the block."
- ^ PrintingMessageTracer new trace:aBlock detail:false.
+ ^ self trace:aBlock on:Stderr
"
MessageTracer trace:[#(6 5 4 3 2 1) sort]
"
!
+trace:aBlock on:aStream
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block."
+
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:false.
+
+ "
+ MessageTracer trace:[#(6 5 4 3 2 1) sort] on:Transcript
+ "
+!
+
traceFull: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:true.
+ ^ self traceFull:aBlock on:Stderr
+
+ "
+ MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
+ "
+!
+
+traceFull:aBlock on:aStream
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block.
+ The trace information is more detailed."
+
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:true.
"
MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
@@ -542,7 +574,21 @@
Return the value of the block.
The trace information is more detailed."
- ^ PrintingMessageTracer new trace:aBlock detail:#fullIndent.
+ ^ self traceFullIndented:aBlock on:Stderr
+
+ "
+ MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
+ "
+!
+
+traceFullIndented:aBlock on:aStream
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block.
+ The trace information is more detailed."
+
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:#fullIndent.
"
MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
@@ -553,11 +599,24 @@
"evaluate aBlock sending trace information to stdout.
Return the value of the block."
- ^ PrintingMessageTracer new trace:aBlock detail:#indent.
+ ^ self traceIndented:aBlock on:Stderr
"
MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ]
"
+!
+
+traceIndented:aBlock on:aStream
+ "evaluate aBlock sending trace information to stdout.
+ Return the value of the block."
+
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:#indent.
+
+ "
+ MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ] on:Transcript
+ "
! !
!MessageTracer class methodsFor:'method breakpointing'!
@@ -798,7 +857,7 @@
!MessageTracer class methodsFor:'method counting'!
countMethod:aMethod
- "arrange for a aMethods execution to be counted.
+ "arrange for a aMethod's execution to be counted.
Use unwrapMethod to remove this."
MethodCounts isNil ifTrue:[
@@ -812,6 +871,7 @@
cnt := MethodCounts at:aMethod ifAbsent:0.
MethodCounts at:aMethod put:(cnt + 1).
+ MessageTracer changed:#statistics: with:aMethod.
aMethod changed:#statistics
]
onExit:[:con :retVal |
@@ -872,7 +932,7 @@
!MessageTracer class methodsFor:'method memory usage'!
countMemoryUsageOfMethod:aMethod
- "arrange for aMethods memory usage to be counted.
+ "arrange for aMethod's memory usage to be counted.
Use unwrapMethod to remove this."
|oldPriority oldScavengeCount oldNewUsed|
@@ -911,6 +971,7 @@
MethodMemoryUsage at:aMethod put:(cnt + memUse).
].
Processor activeProcess priority:oldPriority.
+ MessageTracer changed:#statistics: with:aMethod.
aMethod changed:#statistics
]
onUnwind:[
@@ -1047,7 +1108,7 @@
!
timeMethod:aMethod
- "arrange for a aMethods execution time to be measured.
+ "arrange for a aMethod's execution time to be measured.
Use unwrapMethod: or stopTimingMethod: to remove this."
|t0|
@@ -1082,6 +1143,7 @@
] ifFalse:[
info rememberExecutionTime:t.
].
+ MessageTracer changed:#statistics: with:aMethod.
aMethod changed:#statistics
]
@@ -3120,16 +3182,23 @@
"Created: / 05-03-2007 / 15:32:43 / cg"
! !
+!MessageTracer::PrintingMessageTracer methodsFor:'accessing'!
+
+output:something
+ output := something.
+! !
+
!MessageTracer::PrintingMessageTracer methodsFor:'trace helpers'!
stepInterrupt
"called for every send while tracing"
- |ignore sel con r|
+ |ignore sel con r outStream|
StepInterruptPending := nil.
con := thisContext sender.
ignore := false.
+ outStream := output ? Stderr.
con receiver == Processor ifTrue:[
(sel := con selector) == #threadSwitch: ifTrue:[
@@ -3153,28 +3222,28 @@
[con notNil
and:[(r := con receiver) ~~ self
and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:Stderr.
+ ' ' printOn:outStream.
con := con sender.
].
con := thisContext sender.
- self class printFull:con on:Stderr withSender:false.
+ self class printFull:con on:outStream withSender:false.
] ifFalse:[
traceDetail == #indent ifTrue:[
[con notNil
and:[(r := con receiver) ~~ self
and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:Stderr.
+ ' ' printOn:outStream.
con := con sender.
].
con := thisContext sender.
- con printOn:Stderr.
- Stderr cr.
+ con printOn:outStream.
+ outStream cr.
] ifFalse:[
traceDetail == true ifTrue:[
- self class printFull:con on:Stderr withSender:true.
+ self class printFull:con on:outStream withSender:true.
] ifFalse:[
- con printOn:Stderr.
- Stderr cr.
+ con printOn:outStream.
+ outStream cr.
]
]
].
@@ -3200,7 +3269,7 @@
!MessageTracer class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.116 2012-05-21 08:16:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.117 2012-11-05 23:09:21 cg Exp $'
! !
MessageTracer initialize!