Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a5192d48e61a8ece69cddc43cc12625fcdcc56ec >--------------------------------------------------------------- commit a5192d48e61a8ece69cddc43cc12625fcdcc56ec Author: Duncan Coutts <[email protected]> Date: Fri Jul 8 17:36:16 2011 +0200 add a new trace class for spark events >--------------------------------------------------------------- includes/rts/Flags.h | 2 +- rts/RtsFlags.c | 44 ++++++++++++++++++++++++++++++++++++++++++-- rts/Trace.c | 10 ++++++++++ rts/Trace.h | 13 ++++++++++--- 4 files changed, 63 insertions(+), 6 deletions(-) diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h index 42ca671..63dc72e 100644 --- a/includes/rts/Flags.h +++ b/includes/rts/Flags.h @@ -127,8 +127,8 @@ struct PROFILING_FLAGS { struct TRACE_FLAGS { int tracing; rtsBool timestamp; /* show timestamp in stderr output */ - rtsBool scheduler; /* trace scheduler events */ + rtsBool sparks; /* trace spark events */ }; struct CONCURRENT_FLAGS { diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 24181d3..abeffc7 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -163,6 +163,7 @@ void initRtsFlagsDefaults(void) RtsFlags.TraceFlags.tracing = TRACE_NONE; RtsFlags.TraceFlags.timestamp = rtsFalse; RtsFlags.TraceFlags.scheduler = rtsFalse; + RtsFlags.TraceFlags.sparks = rtsFalse; #endif RtsFlags.MiscFlags.tickInterval = 20; /* In milliseconds */ @@ -288,6 +289,7 @@ usage_text[] = { # endif " where [flags] can contain:", " s scheduler events", +" p par spark events", # ifdef DEBUG " t add time stamps (only useful with -v)", # endif @@ -1429,19 +1431,57 @@ decodeSize(const char *flag, nat offset, StgWord64 min, StgWord64 max) static void read_trace_flags(char *arg) { char *c; + rtsBool enabled = rtsTrue; + /* Syntax for tracing flags currently looks like: + * + * -l To turn on eventlog tracing with default trace classes + * -lx Turn on class 'x' (for some class listed below) + * -l-x Turn off class 'x' + * -la Turn on all classes + * -l-a Turn off all classes + * + * This lets users say things like: + * -la-p "all but sparks" + * -l-ap "only sparks" + */ + + /* Start by turning on the default tracing flags. + * + * Currently this is all the trace classes, but might not be in + * future, for example we might default to slightly less verbose + * scheduler or GC tracing. + */ + RtsFlags.TraceFlags.scheduler = rtsTrue; + RtsFlags.TraceFlags.sparks = rtsTrue; for (c = arg; *c != '\0'; c++) { switch(*c) { case '\0': break; + case '-': + enabled = rtsFalse; + break; + case 'a': + RtsFlags.TraceFlags.scheduler = enabled; + RtsFlags.TraceFlags.sparks = enabled; + enabled = rtsTrue; + break; + case 's': - RtsFlags.TraceFlags.scheduler = rtsTrue; + RtsFlags.TraceFlags.scheduler = enabled; + enabled = rtsTrue; + break; + case 'p': + RtsFlags.TraceFlags.sparks = enabled; + enabled = rtsTrue; break; case 't': - RtsFlags.TraceFlags.timestamp = rtsTrue; + RtsFlags.TraceFlags.timestamp = enabled; + enabled = rtsTrue; break; case 'g': // ignored for backwards-compat + enabled = rtsTrue; break; default: errorBelch("unknown trace option: %c",*c); diff --git a/rts/Trace.c b/rts/Trace.c index 0c32737..7d856d6 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -47,6 +47,7 @@ int DEBUG_sparks; // events int TRACE_sched; +int TRACE_spark; #ifdef THREADED_RTS static Mutex trace_utx; @@ -90,8 +91,17 @@ void initTracing (void) RtsFlags.TraceFlags.scheduler || RtsFlags.DebugFlags.scheduler; + // -Dr turns on spark tracing + TRACE_spark = + RtsFlags.TraceFlags.sparks || + RtsFlags.DebugFlags.sparks; + eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG; + /* Note: we can have TRACE_sched or TRACE_spark turned on even when + eventlog_enabled is off. In the DEBUG way we may be tracing to stderr. + */ + if (eventlog_enabled) { initEventLogging(); } diff --git a/rts/Trace.h b/rts/Trace.h index 910afbd..b29df52 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -62,6 +62,7 @@ extern int DEBUG_sparks; // events extern int TRACE_sched; +extern int TRACE_spark; // ----------------------------------------------------------------------------- // Posting events @@ -93,6 +94,11 @@ void traceEnd (void); traceSchedEvent_(cap, tag, tso, info1, info2); \ } +#define traceSparkEvent(cap, tag, tso, other) \ + if (RTS_UNLIKELY(TRACE_spark)) { \ + traceSchedEvent_(cap, tag, tso, other, 0); \ + } + void traceSchedEvent_ (Capability *cap, EventTypeNum tag, StgTSO *tso, StgWord info1, StgWord info2); @@ -192,6 +198,7 @@ void traceSparkCounters_ (Capability *cap, #define traceSchedEvent(cap, tag, tso, other) /* nothing */ #define traceSchedEvent2(cap, tag, tso, other, info) /* nothing */ +#define traceSparkEvent(cap, tag, tso, other) /* nothing */ #define traceEvent(cap, tag) /* nothing */ #define traceCap(class, cap, msg, ...) /* nothing */ #define trace(class, msg, ...) /* nothing */ @@ -402,7 +409,7 @@ INLINE_HEADER void traceEventRequestParGc(Capability *cap STG_UNUSED) INLINE_HEADER void traceEventRunSpark(Capability *cap STG_UNUSED, StgTSO *tso STG_UNUSED) { - traceSchedEvent(cap, EVENT_RUN_SPARK, tso, 0); + traceSparkEvent(cap, EVENT_RUN_SPARK, tso, 0); dtraceRunSpark((EventCapNo)cap->no, (EventThreadID)tso->id); } @@ -410,7 +417,7 @@ INLINE_HEADER void traceEventStealSpark(Capability *cap STG_UNUSED, StgTSO *tso STG_UNUSED, nat victim_cap STG_UNUSED) { - traceSchedEvent(cap, EVENT_STEAL_SPARK, tso, victim_cap); + traceSparkEvent(cap, EVENT_STEAL_SPARK, tso, victim_cap); dtraceStealSpark((EventCapNo)cap->no, (EventThreadID)tso->id, (EventCapNo)victim_cap); } @@ -418,7 +425,7 @@ INLINE_HEADER void traceEventStealSpark(Capability *cap STG_UNUSED, INLINE_HEADER void traceEventCreateSparkThread(Capability *cap STG_UNUSED, StgThreadID spark_tid STG_UNUSED) { - traceSchedEvent(cap, EVENT_CREATE_SPARK_THREAD, 0, spark_tid); + traceSparkEvent(cap, EVENT_CREATE_SPARK_THREAD, 0, spark_tid); dtraceCreateSparkThread((EventCapNo)cap->no, (EventThreadID)spark_tid); } _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
