[commit: ghc] master: Add an RTS eventlog tracing class for user messages (aaaaf67)

[Duncan Coutts]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/aaaaf67b2fca9bd9b0027c983bfc9f9255b2bce5

>---------------------------------------------------------------

commit aaaaf67b2fca9bd9b0027c983bfc9f9255b2bce5
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Thu Oct 27 12:44:05 2011 +0100

    Add an RTS eventlog tracing class for user messages
    
    Enables people to turn them on/off. Defaults to on.

>---------------------------------------------------------------

 includes/rts/Flags.h |    1 +
 rts/RtsFlags.c       |   12 ++++++++++--
 rts/Trace.c          |   14 +++++++++++---
 rts/Trace.h          |    1 +
 4 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index 46f1eb8..2d1516f 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -131,6 +131,7 @@ struct TRACE_FLAGS {
     rtsBool gc;             /* trace GC events */
     rtsBool sparks_sampled; /* trace spark events by a sampled method */
     rtsBool sparks_full;    /* trace spark events 100% accurately */
+    rtsBool user;           /* trace user events (emitted from Haskell code) */
 };
 
 struct CONCURRENT_FLAGS {
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index eda327d..ff14df7 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -166,6 +166,7 @@ void initRtsFlagsDefaults(void)
     RtsFlags.TraceFlags.gc            = rtsFalse;
     RtsFlags.TraceFlags.sparks_sampled= rtsFalse;
     RtsFlags.TraceFlags.sparks_full   = rtsFalse;
+    RtsFlags.TraceFlags.user          = rtsFalse;
 #endif
 
     RtsFlags.MiscFlags.tickInterval	= 20;  /* In milliseconds */
@@ -295,12 +296,13 @@ usage_text[] = {
 "                g    GC events",
 "                p    par spark events (sampled)",
 "                f    par spark events (full detail)",
+"                u    user events (emitted from Haskell code)",
+"                a    all event classes above",
 #  ifdef DEBUG
 "                t    add time stamps (only useful with -v)",
 #  endif
-"                a    all event classes above",
 "               -x    disable an event class, for any flag above",
-"             the initial enabled event classes are 'sgp'",
+"             the initial enabled event classes are 'sgpu'",
 #endif
 
 #if !defined(PROFILING)
@@ -1466,6 +1468,7 @@ static void read_trace_flags(char *arg)
     RtsFlags.TraceFlags.scheduler      = rtsTrue;
     RtsFlags.TraceFlags.gc             = rtsTrue;
     RtsFlags.TraceFlags.sparks_sampled = rtsTrue;
+    RtsFlags.TraceFlags.user           = rtsTrue;
 
     for (c  = arg; *c != '\0'; c++) {
         switch(*c) {
@@ -1479,6 +1482,7 @@ static void read_trace_flags(char *arg)
             RtsFlags.TraceFlags.gc             = enabled;
             RtsFlags.TraceFlags.sparks_sampled = enabled;
             RtsFlags.TraceFlags.sparks_full    = enabled;
+            RtsFlags.TraceFlags.user           = enabled;
             enabled = rtsTrue;
             break;
 
@@ -1502,6 +1506,10 @@ static void read_trace_flags(char *arg)
             RtsFlags.TraceFlags.gc        = enabled;
             enabled = rtsTrue;
             break;
+        case 'u':
+            RtsFlags.TraceFlags.user      = enabled;
+            enabled = rtsTrue;
+            break;
         default:
             errorBelch("unknown trace option: %c",*c);
             break;
diff --git a/rts/Trace.c b/rts/Trace.c
index 9d29f2a..a3aa266 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -50,6 +50,7 @@ int TRACE_sched;
 int TRACE_gc;
 int TRACE_spark_sampled;
 int TRACE_spark_full;
+int TRACE_user;
 
 #ifdef THREADED_RTS
 static Mutex trace_utx;
@@ -106,9 +107,12 @@ void initTracing (void)
         RtsFlags.TraceFlags.sparks_full ||
         RtsFlags.DebugFlags.sparks;
 
+    TRACE_user =
+        RtsFlags.TraceFlags.user;
+
     eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG;
 
-    /* Note: we can have TRACE_sched or TRACE_spark turned on even when
+    /* Note: we can have any of the TRACE_* flags turned on even when
        eventlog_enabled is off. In the DEBUG way we may be tracing to stderr.
      */
 
@@ -521,13 +525,17 @@ static void traceFormatUserMsg(Capability *cap, char *msg, ...)
     va_list ap;
     va_start(ap,msg);
 
+    /* Note: normally we don't check the TRACE_* flags here as they're checked
+       by the wrappers in Trace.h. But traceUserMsg is special since it has no
+       wrapper (it's called from cmm code), so we check TRACE_user here
+     */
 #ifdef DEBUG
-    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR && TRACE_user) {
         traceCap_stderr(cap, msg, ap);
     } else
 #endif
     {
-        if (eventlog_enabled) {
+        if (eventlog_enabled && TRACE_user) {
             postUserMsg(cap, msg, ap);
         }
     }
diff --git a/rts/Trace.h b/rts/Trace.h
index f7894ca..a0c5e26 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -66,6 +66,7 @@ extern int TRACE_sched;
 extern int TRACE_gc;
 extern int TRACE_spark_sampled;
 extern int TRACE_spark_full;
+/* extern int TRACE_user; */  // only used in Trace.c
 
 // -----------------------------------------------------------------------------
 // Posting events