diff -r 7fefd3a142a4 -r 114b461b280d MessageTracer.st --- 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!