Add fast event logging

Generate binary log files from the RTS containing a log of runtime
events with timestamps.  The log file can be visualised in various
ways, for investigating runtime behaviour and debugging performance
problems.  See for example the forthcoming ThreadScope viewer.

New GHC option:

  -eventlog   (link-time option) Enables event logging.

  +RTS -l     (runtime option) Generates <prog>.eventlog with
              the binary event information.

This replaces some of the tracing machinery we already had in the RTS:
e.g. +RTS -vg  for GC tracing (we should do this using the new event
logging instead).

Event logging has almost no runtime cost when it isn't enabled, though
in the future we might add more fine-grained events and this might
change; hence having a link-time option and compiling a separate
version of the RTS for event logging.  There's a small runtime cost
for enabling event-logging, for most programs it shouldn't make much
difference.

(Todo: docs)

15 files changed, 638 insertions, 110 deletions

diff --git a/rts/Capability.c b/rts/Capability.c
index bd6d56ff00..05e9126420 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -320,10 +320,9 @@ giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task)
 {
     ASSERT_LOCK_HELD(&cap->lock);
     ASSERT(task->cap == cap);
-    trace(TRACE_sched | DEBUG_sched,
-	  "passing capability %d to %s %p",
-	  cap->no, task->tso ? "bound task" : "worker",
-	  (void *)task->id);
+    debugTrace(DEBUG_sched, "passing capability %d to %s %p",
+               cap->no, task->tso ? "bound task" : "worker",
+               (void *)task->id);
     ACQUIRE_LOCK(&task->lock);
     task->wakeup = rtsTrue;
     // the wakeup flag is needed because signalCondition() doesn't
@@ -365,8 +364,7 @@ releaseCapability_ (Capability* cap,
 
     if (waiting_for_gc == PENDING_GC_SEQ) {
       last_free_capability = cap; // needed?
-      trace(TRACE_sched | DEBUG_sched, 
-	    "GC pending, set capability %d free", cap->no);
+      debugTrace(DEBUG_sched, "GC pending, set capability %d free", cap->no);
       return;
     } 
 
@@ -407,7 +405,7 @@ releaseCapability_ (Capability* cap,
     }
 
     last_free_capability = cap;
-    trace(TRACE_sched | DEBUG_sched, "freeing capability %d", cap->no);
+    debugTrace(DEBUG_sched, "freeing capability %d", cap->no);
 }
 
 void
@@ -542,7 +540,7 @@ waitForReturnCapability (Capability **pCap, Task *task)
 
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
-    trace(TRACE_sched | DEBUG_sched, "resuming capability %d", cap->no);
+    debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
 
     *pCap = cap;
 #endif
@@ -560,7 +558,9 @@ yieldCapability (Capability** pCap, Task *task)
 
     if (waiting_for_gc == PENDING_GC_PAR) {
 	debugTrace(DEBUG_sched, "capability %d: becoming a GC thread", cap->no);
+        postEvent(cap, EVENT_GC_START, 0, 0);
         gcWorkerThread(cap);
+        postEvent(cap, EVENT_GC_END, 0, 0);
         return;
     }
 
@@ -606,7 +606,7 @@ yieldCapability (Capability** pCap, Task *task)
 	    break;
 	}
 
-	trace(TRACE_sched | DEBUG_sched, "resuming capability %d", cap->no);
+	debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
 	ASSERT(cap->running_task == task);
 
     *pCap = cap;
@@ -648,7 +648,6 @@ wakeupThreadOnCapability (Capability *my_cap,
 
 	appendToRunQueue(other_cap,tso);
 
-	trace(TRACE_sched, "resuming capability %d", other_cap->no);
 	releaseCapability_(other_cap,rtsFalse);
     } else {
 	appendToWakeupQueue(my_cap,other_cap,tso);
@@ -768,6 +767,7 @@ shutdownCapability (Capability *cap, Task *task, rtsBool safe)
             continue;
         }
             
+        postEvent(cap, EVENT_SHUTDOWN, 0, 0);
 	debugTrace(DEBUG_sched, "capability %d is stopped.", cap->no);
 	RELEASE_LOCK(&cap->lock);
 	break;
diff --git a/rts/Makefile b/rts/Makefile
index 216d7def88..585958fca3 100644
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -57,7 +57,7 @@ override HADDOCK_DOCS = NO
 NON_HS_PACKAGE = YES
 
 # grab sources from these subdirectories
-ALL_DIRS = hooks parallel sm
+ALL_DIRS = hooks parallel sm eventlog
 
 ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
 ALL_DIRS += win32
@@ -137,7 +137,8 @@ WARNING_OPTS += -Waggregate-return
 #WARNING_OPTS += -Wredundant-decls 
 #WARNING_OPTS += -Wconversion
 
-STANDARD_OPTS += -I../includes -I. -Iparallel -Ism
+STANDARD_OPTS += -I../includes -I. -Iparallel -Ism -Ieventlog
+
 # COMPILING_RTS is only used when building Win32 DLL support.
 STANDARD_OPTS += -DCOMPILING_RTS
 
@@ -322,7 +323,7 @@ SRC_MKDEPENDC_OPTS += -I. -I../includes
 # a superset of the dependencies.  To do this properly, we should generate
 # a different set of dependencies for each way.  Further hack: PROFILING and
 # TICKY_TICKY can't be used together, so we omit TICKY_TICKY for now.
-SRC_MKDEPENDC_OPTS += -DPROFILING -DTHREADED_RTS -DDEBUG
+SRC_MKDEPENDC_OPTS += -DPROFILING -DTHREADED_RTS -DDEBUG -DEVENTLOG
 
 # -----------------------------------------------------------------------------
 # The auto-generated apply code
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index a31562224d..2ff916a70a 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -18,6 +18,7 @@
 #include "STM.h"
 #include "Sanity.h"
 #include "Profiling.h"
+#include "EventLog.h"
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index b3b95b32d9..3fac86bf4e 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -184,12 +184,14 @@ void initRtsFlagsDefaults(void)
     RtsFlags.DebugFlags.stable		= rtsFalse;
     RtsFlags.DebugFlags.stm             = rtsFalse;
     RtsFlags.DebugFlags.prof		= rtsFalse;
+    RtsFlags.DebugFlags.eventlog        = rtsFalse;
     RtsFlags.DebugFlags.gran		= rtsFalse;
     RtsFlags.DebugFlags.par		= rtsFalse;
     RtsFlags.DebugFlags.apply		= rtsFalse;
     RtsFlags.DebugFlags.linker		= rtsFalse;
     RtsFlags.DebugFlags.squeeze		= rtsFalse;
     RtsFlags.DebugFlags.hpc		= rtsFalse;
+    RtsFlags.DebugFlags.timestamp	= rtsFalse;
 #endif
 
 #if defined(PROFILING) || defined(PAR)
@@ -213,6 +215,10 @@ void initRtsFlagsDefaults(void)
     RtsFlags.ProfFlags.bioSelector        = NULL;
 #endif
 
+#ifdef EVENTLOG
+    RtsFlags.EventLogFlags.doEventLogging = rtsFalse;
+#endif
+
     RtsFlags.MiscFlags.tickInterval	= 20;  /* In milliseconds */
     RtsFlags.ConcFlags.ctxtSwitchTime	= 20;  /* In milliseconds */
 
@@ -329,10 +335,6 @@ void initRtsFlagsDefaults(void)
     RtsFlags.TickyFlags.tickyFile	 = NULL;
 #endif
 
-    RtsFlags.TraceFlags.timestamp	= rtsFalse;
-    RtsFlags.TraceFlags.sched 		= rtsFalse;
-    RtsFlags.TraceFlags.gc 		= rtsFalse;
-
 #ifdef USE_PAPI
     /* By default no special measurements taken */
     RtsFlags.PapiFlags.eventType        = 0;
@@ -419,6 +421,13 @@ usage_text[] = {
 "",
 # endif
 #endif /* PROFILING or PAR */
+
+#ifdef EVENTLOG
+"",
+"  -l       Log runtime events (generates binary trace file <program>.eventlog)",
+"",
+#endif
+
 #if !defined(PROFILING)
 "",
 "  -hT      Heap residency profile (output file <program>.hp)",
@@ -440,8 +449,7 @@ usage_text[] = {
 "            This sets the resolution for -C and the profile timer -i.",
 "            Default: 0.02 sec.",
 "",
-"  -vs       Trace scheduler events (see also -Ds with -debug)",
-"  -vt       Time-stamp trace messages",
+"  -vt       Time-stamp debug messages",
 "",
 #if defined(DEBUG)
 "  -Ds  DEBUG: scheduler",
@@ -453,6 +461,7 @@ usage_text[] = {
 "  -DS  DEBUG: sanity",
 "  -Dt  DEBUG: stable",
 "  -Dp  DEBUG: prof",
+"  -De  DEBUG: event logging",
 "  -Dr  DEBUG: gran",
 "  -DP  DEBUG: par",
 "  -Da  DEBUG: apply",
@@ -660,6 +669,14 @@ errorBelch("not built for: -prof"); \
 error = rtsTrue;
 #endif
 
+#ifdef EVENTLOG
+# define EVENTLOG_BUILD_ONLY(x)   x
+#else
+# define EVENTLOG_BUILD_ONLY(x) \
+errorBelch("not built for: -par-prof"); \
+error = rtsTrue;
+#endif
+
 #ifdef PAR
 # define PAR_BUILD_ONLY(x)      x
 #else
@@ -821,6 +838,9 @@ error = rtsTrue;
 		      case 'p':
 			  RtsFlags.DebugFlags.prof = rtsTrue;
 			  break;
+		      case 'e':
+			  RtsFlags.DebugFlags.eventlog = rtsTrue;
+                          break;
 		      case 'r':
 			  RtsFlags.DebugFlags.gran = rtsTrue;
 			  break;
@@ -955,6 +975,14 @@ error = rtsTrue;
 
 	      /* =========== PROFILING ========================== */
 
+              case 'l':
+#ifdef EVENTLOG
+                  RtsFlags.EventLogFlags.doEventLogging = rtsTrue;
+#else
+                  errorBelch("not built for: -eventlog");
+#endif
+                  break;
+
 	      case 'P': /* detailed cost centre profiling (time/alloc) */
 	      case 'p': /* cost centre profiling (time/alloc) */
 		COST_CENTRE_USING_BUILD_ONLY(
@@ -1270,13 +1298,11 @@ error = rtsTrue;
 		    error = rtsTrue;
 		    break;
 		case 't':
-		    RtsFlags.TraceFlags.timestamp = rtsTrue;
+		    RtsFlags.DebugFlags.timestamp = rtsTrue;
 		    break;
 		case 's':
-		    RtsFlags.TraceFlags.sched = rtsTrue;
-		    break;
 		case 'g':
-		    RtsFlags.TraceFlags.gc = rtsTrue;
+                    // ignored for backwards-compat
 		    break;
 		default:
 		    errorBelch("unknown RTS option: %s",rts_argv[arg]);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index b9442d2bd5..f10de578c7 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -34,6 +34,7 @@
 #include "Stable.h"
 #include "Hpc.h"
 #include "FileLock.h"
+#include "EventLog.h"
 
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
@@ -195,7 +196,9 @@ hs_init(int *argc, char **argv[])
 #endif
 
     /* initTracing must be after setupRtsFlags() */
+#ifdef DEBUG
     initTracing();
+#endif
 
 #if defined(PAR)
     /* NB: this really must be done after processing the RTS flags */
@@ -254,6 +257,12 @@ hs_init(int *argc, char **argv[])
 
     initProfiling1();
 
+#ifdef EVENTLOG
+    if (RtsFlags.EventLogFlags.doEventLogging) {
+        initEventLogging();
+    }
+#endif
+
     /* start the virtual timer 'subsystem'. */
     initTimer();
     startTimer();
@@ -514,6 +523,13 @@ hs_exit_(rtsBool wait_foreign)
     if (prof_file != NULL) fclose(prof_file);
 #endif
 
+#ifdef EVENTLOG
+    if (RtsFlags.EventLogFlags.doEventLogging) {
+        endEventLogging();
+        freeEventLogging();
+    }
+#endif
+
 #if defined(TICKY_TICKY)
     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 040d16f25a..666b59e3e3 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -33,6 +33,7 @@
 #include "ProfHeap.h"
 #include "GC.h"
 #include "Weak.h"
+#include "EventLog.h"
 
 /* PARALLEL_HASKELL includes go here */
 
@@ -539,6 +540,8 @@ run_thread:
     }
 #endif
 
+    postEvent(cap, EVENT_RUN_THREAD, t->id, 0);
+
     switch (prev_what_next) {
 	
     case ThreadKilled:
@@ -587,6 +590,8 @@ run_thread:
     t->saved_winerror = GetLastError();
 #endif
 
+    postEvent (cap, EVENT_STOP_THREAD, t->id, ret);
+
 #if defined(THREADED_RTS)
     // If ret is ThreadBlocked, and this Task is bound to the TSO that
     // blocked, we are in limbo - the TSO is now owned by whatever it
@@ -852,6 +857,9 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
 		} else {
 		    debugTrace(DEBUG_sched, "pushing thread %lu to capability %d", (unsigned long)t->id, free_caps[i]->no);
 		    appendToRunQueue(free_caps[i],t);
+
+                    postEvent (cap, EVENT_MIGRATE_THREAD, t->id, free_caps[i]->no);
+
 		    if (t->bound) { t->bound->cap = free_caps[i]; }
 		    t->cap = free_caps[i];
 		    i++;
@@ -1560,6 +1568,7 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     
     if (gc_type == PENDING_GC_SEQ)
     {
+        postEvent(cap, EVENT_REQUEST_SEQ_GC, 0, 0);
         // single-threaded GC: grab all the capabilities
         for (i=0; i < n_capabilities; i++) {
             debugTrace(DEBUG_sched, "ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities);
@@ -1582,6 +1591,7 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     {
         // multi-threaded GC: make sure all the Capabilities donate one
         // GC thread each.
+        postEvent(cap, EVENT_REQUEST_PAR_GC, 0, 0);
         debugTrace(DEBUG_sched, "ready_to_gc, grabbing GC threads");
 
         waitForGcThreads(cap);
@@ -1607,6 +1617,7 @@ delete_threads_and_gc:
     heap_census = scheduleNeedHeapProfile(rtsTrue);
 
 #if defined(THREADED_RTS)
+    postEvent(cap, EVENT_GC_START, 0, 0);
     debugTrace(DEBUG_sched, "doing GC");
     // reset waiting_for_gc *before* GC, so that when the GC threads
     // emerge they don't immediately re-enter the GC.
@@ -1615,6 +1626,7 @@ delete_threads_and_gc:
 #else
     GarbageCollect(force_major || heap_census, 0, cap);
 #endif
+    postEvent(cap, EVENT_GC_END, 0, 0);
 
     if (recent_activity == ACTIVITY_INACTIVE && force_major)
     {
@@ -1930,6 +1942,7 @@ suspendThread (StgRegTable *reg)
   task = cap->running_task;
   tso = cap->r.rCurrentTSO;
 
+  postEvent(cap, EVENT_STOP_THREAD, tso->id, THREAD_SUSPENDED_FOREIGN_CALL);
   debugTrace(DEBUG_sched, 
 	     "thread %lu did a safe foreign call", 
 	     (unsigned long)cap->r.rCurrentTSO->id);
@@ -2001,6 +2014,8 @@ resumeThread (void *task_)
     tso = task->suspended_tso;
     task->suspended_tso = NULL;
     tso->_link = END_TSO_QUEUE; // no write barrier reqd
+
+    postEvent(cap, EVENT_RUN_THREAD, tso->id, 0);
     debugTrace(DEBUG_sched, "thread %lu: re-entering RTS", (unsigned long)tso->id);
     
     if (tso->why_blocked == BlockedOnCCall) {
@@ -2057,6 +2072,7 @@ scheduleThreadOn(Capability *cap, StgWord cpu USED_IF_THREADS, StgTSO *tso)
     if (cpu == cap->no) {
 	appendToRunQueue(cap,tso);
     } else {
+        postEvent (cap, EVENT_MIGRATE_THREAD, tso->id, capabilities[cpu].no);
 	wakeupThreadOnCapability(cap, &capabilities[cpu], tso);
     }
 #else
@@ -2196,8 +2212,6 @@ initScheduler(void)
   }
 #endif
 
-  trace(TRACE_sched, "start: %d capabilities", n_capabilities);
-
   RELEASE_LOCK(&sched_mutex);
 }
 
diff --git a/rts/Schedule.h b/rts/Schedule.h
index d311801405..97ee78e66c 100644
--- a/rts/Schedule.h
+++ b/rts/Schedule.h
@@ -12,6 +12,7 @@
 
 #include "OSThreads.h"
 #include "Capability.h"
+#include "EventLog.h"
 
 /* initScheduler(), exitScheduler()
  * Called from STG :  no
@@ -188,10 +189,10 @@ appendToRunQueue (Capability *cap, StgTSO *tso)
 	setTSOLink(cap, cap->run_queue_tl, tso);
     }
     cap->run_queue_tl = tso;
+    postEvent (cap, EVENT_THREAD_RUNNABLE, tso->id, 0);
 }
 
-/* Push a thread on the beginning of the run queue.  Used for
- * newly awakened threads, so they get run as soon as possible.
+/* Push a thread on the beginning of the run queue.
  * ASSUMES: cap->running_task is the current task.
  */
 INLINE_HEADER void
diff --git a/rts/Threads.c b/rts/Threads.c
index 936b90e884..501c7514c7 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -210,6 +210,8 @@ createThread(Capability *cap, nat size)
     }
 #endif 
     
+    postEvent (cap, EVENT_CREATE_THREAD, tso->id, 0);
+
 #if defined(GRAN)
     debugTrace(GRAN_DEBUG_pri,
 	       "==__ schedule: Created TSO %d (%p);",
@@ -503,6 +505,7 @@ unblockOne_ (Capability *cap, StgTSO *tso,
 	  ASSERT(tso->bound->cap == tso->cap);
 	  tso->bound->cap = cap;
       }
+
       tso->cap = cap;
       appendToRunQueue(cap,tso);
 
@@ -523,8 +526,9 @@ unblockOne_ (Capability *cap, StgTSO *tso,
   cap->context_switch = 1;
 #endif
 
-  debugTrace(DEBUG_sched,
-	     "waking up thread %ld on cap %d",
+  postEvent (cap, EVENT_THREAD_WAKEUP, tso->id, tso->cap->no);
+
+  debugTrace(DEBUG_sched, "waking up thread %ld on cap %d",
 	     (long)tso->id, tso->cap->no);
 
   return next;
diff --git a/rts/Trace.c b/rts/Trace.c
index 06de1c49de..bd32091a12 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -1,11 +1,13 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 2006
+ * (c) The GHC Team 2006-2009
  *
  * Debug and performance tracing
  *
  * ---------------------------------------------------------------------------*/
 
+#ifdef DEBUG
+
 #include "Rts.h"
 #include "OSThreads.h"
 #include "Trace.h"
@@ -28,33 +30,8 @@ StgWord32 classes_enabled; // not static due to inline funcs
 static Mutex trace_utx;
 #endif
 
-#ifdef DEBUG
 #define DEBUG_FLAG(name, class) \
     if (RtsFlags.DebugFlags.name) classes_enabled |= class;
-#else
-#define DEBUG_FLAG(name, class) \
-    /* nothing */
-#endif
-
-#ifdef PAR
-#define PAR_FLAG(name, class) \
-    if (RtsFlags.ParFlags.Debug.name) classes_enabled |= class;
-#else
-#define PAR_FLAG(name, class) \
-    /* nothing */
-#endif
-
-#ifdef GRAN
-#define GRAN_FLAG(name, class) \
-    if (RtsFlags.GranFlags.Debug.name) classes_enabled |= class;
-#else
-#define GRAN_FLAG(name, class) \
-    /* nothing */
-#endif
-
-#define TRACE_FLAG(name, class) \
-    if (RtsFlags.TraceFlags.name) classes_enabled |= class;
-
 
 void initTracing (void)
 {
@@ -72,43 +49,12 @@ void initTracing (void)
     DEBUG_FLAG(stable,       DEBUG_stable);
     DEBUG_FLAG(stm,          DEBUG_stm);
     DEBUG_FLAG(prof,         DEBUG_prof);
+    DEBUG_FLAG(eventlog,     DEBUG_eventlog);
     DEBUG_FLAG(gran,         DEBUG_gran);
     DEBUG_FLAG(par,          DEBUG_par);
     DEBUG_FLAG(linker,       DEBUG_linker);
     DEBUG_FLAG(squeeze,      DEBUG_squeeze);
     DEBUG_FLAG(hpc,          DEBUG_hpc);
-
-    PAR_FLAG(verbose,        PAR_DEBUG_verbose);
-    PAR_FLAG(bq,             PAR_DEBUG_bq);
-    PAR_FLAG(schedule,       PAR_DEBUG_schedule);
-    PAR_FLAG(free,           PAR_DEBUG_free);
-    PAR_FLAG(resume,         PAR_DEBUG_resume);
-    PAR_FLAG(weight,         PAR_DEBUG_weight);
-    PAR_FLAG(fetch,          PAR_DEBUG_fetch);
-    PAR_FLAG(fish,           PAR_DEBUG_fish);
-    PAR_FLAG(tables,         PAR_DEBUG_tables);
-    PAR_FLAG(packet,         PAR_DEBUG_packet);
-    PAR_FLAG(pack,           PAR_DEBUG_pack);
-    PAR_FLAG(paranoia,       PAR_DEBUG_paranoia);
-
-    GRAN_FLAG(event_trace,   GRAN_DEBUG_event_trace);
-    GRAN_FLAG(event_stats,   GRAN_DEBUG_event_stats);
-    GRAN_FLAG(bq,            GRAN_DEBUG_bq);
-    GRAN_FLAG(pack,          GRAN_DEBUG_pack);
-    GRAN_FLAG(checkSparkQ,   GRAN_DEBUG_checkSparkQ);
-    GRAN_FLAG(thunkStealing, GRAN_DEBUG_thunkStealing);
-    GRAN_FLAG(randomSteal,   GRAN_DEBUG_randomSteal);
-    GRAN_FLAG(findWork,      GRAN_DEBUG_findWork);
-    GRAN_FLAG(unused,        GRAN_DEBUG_unused);
-    GRAN_FLAG(pri,           GRAN_DEBUG_pri);
-    GRAN_FLAG(checkLight,    GRAN_DEBUG_checkLight);
-    GRAN_FLAG(sortedQ,       GRAN_DEBUG_sortedQ);
-    GRAN_FLAG(blockOnFetch,  GRAN_DEBUG_blockOnFetch);
-    GRAN_FLAG(packBuffer,    GRAN_DEBUG_packBuffer);
-    GRAN_FLAG(blockedOnFetch_sanity, GRAN_DEBUG_BOF_sanity);
-
-    TRACE_FLAG(sched, TRACE_sched);
-    TRACE_FLAG(gc, TRACE_gc);
 }
 
 static void tracePreface (void)
@@ -116,7 +62,7 @@ static void tracePreface (void)
 #ifdef THREADED_RTS
     debugBelch("%12lx: ", (unsigned long)osThreadId());
 #endif
-    if (RtsFlags.TraceFlags.timestamp) {
+    if (RtsFlags.DebugFlags.timestamp) {
 	debugBelch("%9" FMT_Word64 ": ", stat_getElapsedTime());
     }
 }
@@ -155,3 +101,5 @@ void traceEnd (void)
     debugBelch("\n");
     RELEASE_LOCK(&trace_utx);
 }
+
+#endif
diff --git a/rts/Trace.h b/rts/Trace.h
index 0e142f5238..fc19e8957a 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -2,16 +2,14 @@
  *
  * (c) The GHC Team 2006
  *
- * Debug and performance tracing.  
+ * Debug tracing.  
  *
  * This is a layer over RtsMessages, which provides for generating
- * trace messages with timestamps and thread Ids attached
+ * trace messages with timestamps and task IDs attached
  * automatically.  Also, multiple classes of messages are supported,
  * which can be enabled separately via RTS flags.
  *
- * All debug trace messages go through here.  Additionally, we
- * generate timestamped trace messages for consumption by profiling
- * tools using this API.
+ * All debug trace messages go through here.
  *
  * ---------------------------------------------------------------------------*/
 
@@ -22,6 +20,8 @@
 // Tracing functions
 // -----------------------------------------------------------------------------
 
+#ifdef DEBUG
+
 void initTracing (void);
 
 // The simple way:
@@ -42,17 +42,18 @@ void traceBegin (const char *str, ...)
 
 void traceEnd (void);
 
-#ifdef DEBUG
 #define debugTrace(class, str, ...) trace(class,str, ## __VA_ARGS__)
 // variable arg macros are C99, and supported by gcc.
 #define debugTraceBegin(str, ...) traceBegin(str, ## __VA_ARGS__)
 #define debugTraceEnd() traceEnd()
-#else
+
+#else /* !DEBUG */
+
 #define debugTrace(class, str, ...) /* nothing */
 #define debugTraceBegin(str, ...) /* nothing */
 #define debugTraceEnd() /* nothing */
-#endif
 
+#endif
 
 // -----------------------------------------------------------------------------
 // Message classes, these may be OR-ed together
@@ -74,10 +75,7 @@ void traceEnd (void);
 #define DEBUG_linker		   (1<<12)
 #define DEBUG_squeeze              (1<<13)
 #define DEBUG_hpc                  (1<<14)
-
-// Tracing flags
-#define TRACE_sched                (1<<20)
-#define TRACE_gc                   (1<<21)
+#define DEBUG_eventlog		   (1<<15)
 
 // -----------------------------------------------------------------------------
 // PRIVATE below here
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
new file mode 100644
index 0000000000..8e74215dbb
--- /dev/null
+++ b/rts/eventlog/EventLog.c
@@ -0,0 +1,467 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2008-2009
+ *
+ * Support for fast binary event logging.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifdef EVENTLOG
+
+#include "Rts.h"
+#include "EventLog.h"
+#include "Capability.h"
+#include "Trace.h"
+#include "RtsUtils.h"
+#include "Stats.h"
+#include <string.h> 
+#include <stdio.h>
+
+static char *event_log_filename = NULL;
+
+// File for logging events
+FILE *event_log_file = NULL;
+
+#define EVENT_LOG_SIZE 2 * (1024 * 1024) // 2MB
+
+static int flushCount;
+
+// Struct for record keeping of buffer to store event types and events.
+typedef struct _EventsBuf {
+  StgInt8 *begin;
+  StgInt8 *pos;
+  StgWord64 size;
+} EventsBuf;
+
+EventsBuf *eventsBuf;
+
+char *EventDesc[] = {
+  "Create thread",
+  "Run thread",
+  "Stop thread",
+  "Thread runnable",
+  "Migrate thread",
+  "Run spark",
+  "Steal spark",
+  "Shutdown",
+  "Wakeup thread",
+  "Request sequential GC",
+  "Request parallel GC",
+  "Starting GC",
+  "Finished GC"
+};
+
+// Event type. 
+
+typedef struct _EventType {
+  EventTypeNum etNum;  // Event Type number.
+  nat   size;     // size of the payload in bytes
+  char *desc;     // Description
+} EventType;
+
+EventType eventTypes[NUM_EVENT_TAGS];
+
+static void printAndClearEventBuf (EventsBuf *eventsBuf);
+static void initEventsBuf(EventsBuf* eb, StgWord64 size);
+static void resetEventsBuf(EventsBuf* eb);
+
+static void beginHeader(EventsBuf *eb);
+static void endHeader(EventsBuf *eb);
+
+static void beginData(EventsBuf *eb);
+static void endData(EventsBuf *eb);
+
+static void beginEventTypes(EventsBuf *eb);
+static void endEventTypes(EventsBuf *eb);
+
+static void postEventType(EventsBuf *eb, EventType *et);
+
+static StgBool hasRoomForEvent(EventsBuf *eb, EventTypeNum eNum);
+
+static inline void postInt8(EventsBuf *eb, StgInt8 i);
+static inline void postInt16(EventsBuf *eb, StgInt16 i);
+static inline void postInt32(EventsBuf *eb, StgInt32 i);
+static inline void postInt64(EventsBuf *eb, StgInt64 i);
+static inline void postWord8(EventsBuf *eb, StgWord8 i);
+static inline void postWord16(EventsBuf *eb, StgWord16 i);
+static inline void postWord32(EventsBuf *eb, StgWord32 i);
+static inline void postWord64(EventsBuf *eb, StgWord64 i);
+
+static inline void postEventTypeNum(EventsBuf *eb, EventTypeNum etNum);
+static inline void postTimestamp(EventsBuf *eb, Timestamp t);
+
+void
+initEventLogging(void)
+{
+    StgWord8 t, c;
+
+    debugTrace(DEBUG_eventlog, "intiEventLog: start");
+
+    event_log_filename = stgMallocBytes(strlen(prog_name) + 9, 
+                                        "initEventLogging");
+
+    if (sizeof(EventDesc) / sizeof(char*) != NUM_EVENT_TAGS) {
+        barf("EventDesc array has the wrong number of elements");
+    }
+  
+    sprintf(event_log_filename, "%s.eventlog", prog_name);
+    
+    /* Open event log file for writing. */
+    if ((event_log_file = fopen(event_log_filename, "wb")) == NULL) {
+        sysErrorBelch("initEventLoggin: can't open %s", event_log_filename);
+        stg_exit(EXIT_FAILURE);    
+    }
+
+    /* 
+     * Allocate buffer(s) to store events.
+     * Create buffer large enough for the header begin marker, all event
+     * types, and header end marker to prevent checking if buffer has room
+     * for each of these steps, and remove the need to flush the buffer to
+     * disk during initialization.
+     *
+     * Use a single buffer to store the header with event types, then flush 
+     * the buffer so all buffers are empty for writing events.
+     */
+    eventsBuf = stgMallocBytes(n_capabilities * sizeof(EventsBuf),"initEventLogging");
+
+    for (c = 0; c < n_capabilities; ++c) {
+        // Init buffer for events.
+        initEventsBuf(&eventsBuf[c], EVENT_LOG_SIZE);
+    }
+
+    // Write in buffer: the header begin marker.
+    beginHeader(&eventsBuf[0]);
+
+    // Mark beginning of event types in the header.
+    beginEventTypes(&eventsBuf[0]);
+    for (t = 0; t < NUM_EVENT_TAGS; ++t) {
+
+        eventTypes[t].etNum = t;
+        eventTypes[t].desc = EventDesc[t];
+
+        switch (t) {
+        case EVENT_CREATE_THREAD:   // (cap, thread)
+        case EVENT_RUN_THREAD:      // (cap, thread)
+        case EVENT_THREAD_RUNNABLE: // (cap, thread)
+        case EVENT_RUN_SPARK:       // (cap, thread)
+            eventTypes[t].size = sizeof(CapabilityNum) + sizeof(ThreadID);
+            break;
+
+        case EVENT_MIGRATE_THREAD:  // (cap, thread, new_cap)
+        case EVENT_STEAL_SPARK:     // (cap, thread, victim_cap)
+        case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
+            eventTypes[t].size =
+                sizeof(CapabilityNum) + sizeof(ThreadID) +
+                sizeof(CapabilityNum);
+            break;
+
+        case EVENT_STOP_THREAD:     // (cap, thread, status)
+            eventTypes[t].size =
+                sizeof(CapabilityNum) + sizeof(ThreadID) + sizeof(StgWord16);
+            break;
+
+        case EVENT_SHUTDOWN:        // (cap)
+        case EVENT_REQUEST_SEQ_GC:  // (cap)
+        case EVENT_REQUEST_PAR_GC:  // (cap)
+        case EVENT_GC_START:        // (cap)
+        case EVENT_GC_END:          // (cap)
+            eventTypes[t].size = sizeof(CapabilityNum);
+            break;
+        }
+
+        // Write in buffer: the start event type.
+        postEventType(&eventsBuf[0], &eventTypes[t]);
+    }
+
+    // Mark end of event types in the header.
+    endEventTypes(&eventsBuf[0]);
+    
+    // Write in buffer: the header end marker.
+    endHeader(&eventsBuf[0]);
+    
+    // Prepare event buffer for events (data).
+    beginData(&eventsBuf[0]);
+    
+    // Flush eventsBuf with header.
+    /*
+     * Flush header and data begin marker to the file, thus preparing the
+     * file to have events written to it.
+     */
+    printAndClearEventBuf(&eventsBuf[0]);
+
+    debugTrace(DEBUG_eventlog, "initEventLog: finish"); 
+}
+
+void
+endEventLogging(void)
+{
+    nat c;
+
+    debugTrace(DEBUG_eventlog,"endEventLog: start");
+    
+    // Flush all events remaining in the buffers.
+    for (c = 0; c < n_capabilities; ++c) {
+        printAndClearEventBuf(&eventsBuf[c]);
+    }
+
+    // Mark end of events (data).
+    endData(&eventsBuf[0]);
+
+    // Flush the end of data marker.
+    printAndClearEventBuf(&eventsBuf[0]);
+
+    if (event_log_file != NULL) {
+        fclose(event_log_file);
+    }
+    
+    debugTrace(DEBUG_eventlog,"endEventLog: finish");
+}
+
+void 
+freeEventLogging(void)
+{
+    StgWord8 c;
+
+    debugTrace(DEBUG_eventlog,"freeEventLog: start"); 
+    
+    // Free events buffer.
+    for (c = 0; c < n_capabilities; ++c) {
+        if (eventsBuf[c].begin != NULL) 
+            stgFree(eventsBuf[c].begin);
+    }
+    if (eventsBuf != NULL)  {
+        stgFree(eventsBuf);
+    }
+    if (event_log_filename != NULL) {
+        stgFree(event_log_filename);
+    }
+    
+    debugTrace(DEBUG_eventlog,"freeEventLog: finish"); 
+}
+
+/*
+ * Post an event message to the capability's eventlog buffer.
+ * If the buffer is full, prints out the buffer and clears it.
+ */
+void
+postEvent_(Capability *cap, EventTypeNum tag, StgThreadID thread, nat other_cap)
+{
+    EventsBuf *eb;
+
+    debugTrace(DEBUG_eventlog,"postEvent: start");
+    
+    eb = &eventsBuf[cap->no];
+
+    if (!hasRoomForEvent(eb, tag)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(eb);
+    }
+    
+    postEventTypeNum(eb, tag);
+    postTimestamp(eb, stat_getElapsedTime() * (1000000000LL/TICKS_PER_SECOND));
+    postWord16(eb, cap->no);
+
+    switch (tag) {
+    case EVENT_CREATE_THREAD:   // (cap, thread)
+    case EVENT_RUN_THREAD:      // (cap, thread)
+    case EVENT_THREAD_RUNNABLE: // (cap, thread)
+    case EVENT_RUN_SPARK:       // (cap, thread)
+    {
+        postWord64(eb,thread);
+        break;
+    }
+
+    case EVENT_MIGRATE_THREAD:  // (cap, thread, new_cap)
+    case EVENT_STEAL_SPARK:     // (cap, thread, victim_cap)
+    case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
+    {
+        postWord64(eb,thread);
+        postWord16(eb,other_cap);
+        break;
+    }
+
+    case EVENT_STOP_THREAD:     // (cap, thread, status)
+    {
+        postWord64(eb,thread);
+        postWord16(eb,other_cap);
+        break;
+    }
+
+    case EVENT_SHUTDOWN:        // (cap)
+    case EVENT_REQUEST_SEQ_GC:  // (cap)
+    case EVENT_REQUEST_PAR_GC:  // (cap)
+    case EVENT_GC_START:        // (cap)
+    case EVENT_GC_END:          // (cap)
+    {
+        break;
+    }
+
+    default:
+        barf("postEvent: unknown event tag %d", tag);
+    }
+
+    debugTrace(DEBUG_eventlog,"postEvent: finish");
+}
+
+static void printAndClearEventBuf (EventsBuf *eventsBuf)
+{
+    StgWord64 numBytes = 0, written = 0;
+
+    if (eventsBuf->begin != NULL && eventsBuf->pos != eventsBuf->begin)
+    {
+        numBytes = eventsBuf->pos - eventsBuf->begin;
+        
+        debugTrace(DEBUG_eventlog, 
+                   "printAndEventLog: numbytes %" FMT_Word64
+                   " bytes to fwrite()",
+                   numBytes);
+        
+        written = fwrite(eventsBuf->begin, 1, numBytes, event_log_file);
+        if (written != numBytes) {
+            debugBelch(
+                "printAndClearEventLog: fwrite() failed, written=%" FMT_Word64
+                " doesn't match numBytes=%" FMT_Word64, written, numBytes);
+            return;
+        }
+        
+        debugTrace(DEBUG_eventlog,
+                   "printAndClearEventLog: fwrite(): %" FMT_Word64 
+                   " bytes written", written);
+        
+        resetEventsBuf(eventsBuf);
+        flushCount++;
+    }
+}
+
+void
+printAndClearEventLog(Capability *cap)
+{
+    debugTrace(DEBUG_eventlog,"printAndClearEventLog: start");
+    
+    printAndClearEventBuf(&eventsBuf[cap->no]);
+    
+    debugTrace(DEBUG_eventlog,"printAndClearEventLog: finish");
+}
+
+/* -----------------------------------------------------------------------------
+   Actual event generation below here
+   -------------------------------------------------------------------------- */
+
+void initEventsBuf(EventsBuf* eb, StgWord64 size)
+{
+    eb->begin = eb->pos = malloc(size);
+    eb->size = size;
+}
+
+void resetEventsBuf(EventsBuf* eb)
+{
+    eb->pos = eb->begin;
+}
+
+// N.B.: Assuming buffer contains enough space for the header begin marker.
+void beginHeader(EventsBuf *eb)
+{
+    postInt32(eb, EVENT_HEADER_BEGIN);
+}
+
+// N.B.: Assuming buffer contains enough space for the header end marker.
+void endHeader(EventsBuf *eb)
+{
+    postInt32(eb, EVENT_HEADER_END);
+}
+
+void beginData(EventsBuf *eb)
+{
+    postInt32(eb, EVENT_DATA_BEGIN);
+}
+
+void endData(EventsBuf *eb)
+{
+    postEventTypeNum(eb, EVENT_DATA_END);
+}
+
+void beginEventTypes(EventsBuf *eb)
+{
+    postInt32(eb, EVENT_HET_BEGIN);
+}
+
+void endEventTypes(EventsBuf *eb)
+{
+    postInt32(eb, EVENT_HET_END);
+}
+
+StgBool hasRoomForEvent(EventsBuf *eb, EventTypeNum eNum)
+{
+  nat size = 0;
+
+  size += sizeof(EventTypeNum) + sizeof(Timestamp) + eventTypes[eNum].size;
+
+  if (eb->pos + size > eb->begin + eb->size) {
+      return 0; // Not enough space.
+  } else  {
+      return 1; // Buf has enough space for the event.
+  }
+}
+
+static void postEventType(EventsBuf *eb, EventType *et)
+{
+    StgWord8 d;
+    nat desclen;
+
+    postInt32(eb, EVENT_ET_BEGIN);
+    postEventTypeNum(eb, et->etNum);
+    postWord16(eb, (StgWord16)et->size);
+    desclen = strlen(et->desc);
+    postWord32(eb, desclen);
+    for (d = 0; d < desclen; ++d) {
+        postInt8(eb, (StgInt8)et->desc[d]);
+    }
+    postWord32(eb, 0); // no extensions yet
+    postInt32(eb, EVENT_ET_END);
+}
+
+static inline void postEventTypeNum(EventsBuf *eb, EventTypeNum etNum)
+{ postWord16(eb, etNum); }
+
+static inline void postEventTypeID(EventsBuf *eb, StgWord16 etID)
+{ postWord16(eb, etID); }
+
+static inline void postTimestamp(EventsBuf *eb, Timestamp t)
+{ postWord64(eb,t); }
+
+static inline void postInt8(EventsBuf *eb, StgInt8 i)
+{ postWord8(eb, (StgWord8)i); }
+
+static inline void postInt16(EventsBuf *eb, StgInt16 i)
+{ postWord16(eb, (StgWord16)i); }
+
+static inline void postInt32(EventsBuf *eb, StgInt32 i)
+{ postWord32(eb, (StgWord32)i); }
+
+static inline void postInt64(EventsBuf *eb, StgInt64 i)
+{ postWord64(eb, (StgWord64)i); }
+
+static inline void postWord8(EventsBuf *eb, StgWord8 i)
+{
+    *(eb->pos++) = i; 
+}
+
+static inline void postWord16(EventsBuf *eb, StgWord16 i)
+{
+    postWord8(eb, (StgWord8)(i >> 8));
+    postWord8(eb, (StgWord8)i);
+}
+
+static inline void postWord32(EventsBuf *eb, StgWord32 i)
+{
+    postWord16(eb, (StgWord16)(i >> 16));
+    postWord16(eb, (StgWord16)i);
+}
+
+static inline void postWord64(EventsBuf *eb, StgWord64 i)
+{
+    postWord32(eb, (StgWord32)(i >> 32));
+    postWord32(eb, (StgWord32)i);
+}
+
+#endif /* EVENTLOG */
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
new file mode 100644
index 0000000000..386730106e
--- /dev/null
+++ b/rts/eventlog/EventLog.h
@@ -0,0 +1,52 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2008-2009
+ *
+ * Support for fast binary event logging.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef EVENTLOG_H
+#define EVENTLOG_H
+
+#include "Capability.h"
+#include "EventLogFormat.h"
+
+#ifdef EVENTLOG
+
+/*
+ * Descriptions of EventTags for events.
+ */
+extern char *EventTagDesc[];
+
+void initEventLogging(void);
+void endEventLogging(void);
+void freeEventLogging(void);
+
+void postEvent_(Capability *cap, EventTypeNum tag, StgThreadID id, nat from);
+
+/* 
+ * Post an event to the capability's event buffer.
+ */
+INLINE_HEADER void postEvent(Capability *cap, EventTypeNum tag, StgThreadID id, nat from)
+{
+    if (RtsFlags.EventLogFlags.doEventLogging) {
+        postEvent_(cap, tag, id, from);
+    }
+}
+
+void printAndClearEventLog(Capability *cap);
+
+#else /* !EVENTLOG */
+
+INLINE_HEADER void postEvent(Capability *cap  STG_UNUSED,
+                             EventTypeNum tag STG_UNUSED,
+                             StgThreadID id   STG_UNUSED,
+                             nat from         STG_UNUSED)
+{
+    /* nothing */
+}
+
+#endif
+
+#endif /* EVENTLOG_H */
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 501a9e52d4..cb5623ab86 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -264,7 +264,7 @@ GarbageCollect (rtsBool force_major_gc,
   n_gc_threads = 1;
 #endif
 
-  trace(TRACE_gc|DEBUG_gc, "GC (gen %d): %d KB to collect, %ld MB in use, using %d thread(s)",
+  debugTrace(DEBUG_gc, "GC (gen %d): %d KB to collect, %ld MB in use, using %d thread(s)",
         N, n * (BLOCK_SIZE / 1024), mblocks_allocated, n_gc_threads);
 
 #ifdef RTS_GTK_FRONTPANEL
@@ -534,12 +534,12 @@ GarbageCollect (rtsBool force_major_gc,
       nat i;
       for (i=0; i < n_gc_threads; i++) {
           if (n_gc_threads > 1) {
-              trace(TRACE_gc,"thread %d:", i);
-              trace(TRACE_gc,"   copied           %ld", gc_threads[i]->copied * sizeof(W_));
-              trace(TRACE_gc,"   scanned          %ld", gc_threads[i]->scanned * sizeof(W_));
-              trace(TRACE_gc,"   any_work         %ld", gc_threads[i]->any_work);
-              trace(TRACE_gc,"   no_work          %ld", gc_threads[i]->no_work);
-              trace(TRACE_gc,"   scav_find_work %ld",   gc_threads[i]->scav_find_work);
+              debugTrace(DEBUG_gc,"thread %d:", i);
+              debugTrace(DEBUG_gc,"   copied           %ld", gc_threads[i]->copied * sizeof(W_));
+              debugTrace(DEBUG_gc,"   scanned          %ld", gc_threads[i]->scanned * sizeof(W_));
+              debugTrace(DEBUG_gc,"   any_work         %ld", gc_threads[i]->any_work);
+              debugTrace(DEBUG_gc,"   no_work          %ld", gc_threads[i]->no_work);
+              debugTrace(DEBUG_gc,"   scav_find_work %ld",   gc_threads[i]->scav_find_work);
           }
           copied += gc_threads[i]->copied;
           max_copied = stg_max(gc_threads[i]->copied, max_copied);
@@ -764,7 +764,7 @@ GarbageCollect (rtsBool force_major_gc,
   IF_DEBUG(sanity, checkSanity());
 
   // extra GC trace info 
-  if (traceClass(TRACE_gc|DEBUG_gc)) statDescribeGens();
+  IF_DEBUG(gc, statDescribeGens());
 
 #ifdef DEBUG
   // symbol-table based profiling 
diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 84b7564980..86d2282980 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -194,7 +194,7 @@ todo_block_full (nat size, step_workspace *ws)
         {
             step *stp;
             stp = ws->step;
-            trace(TRACE_gc|DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld", 
+            debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld", 
                   bd->start, (unsigned long)(bd->free - bd->u.scan),
                   stp->abs_no, dequeElements(ws->todo_q));
 
diff --git a/rts/sm/Sweep.c b/rts/sm/Sweep.c
index 9251290c90..444c3d5111 100644
--- a/rts/sm/Sweep.c
+++ b/rts/sm/Sweep.c
@@ -70,7 +70,7 @@ sweep(step *step)
 
     step->live_estimate = live;
 
-    trace(DEBUG_gc|TRACE_gc, "sweeping: %d blocks, %d were copied, %d freed (%d%%), %d are fragmented, live estimate: %ld%%",
+    debugTrace(DEBUG_gc, "sweeping: %d blocks, %d were copied, %d freed (%d%%), %d are fragmented, live estimate: %ld%%",
           step->n_old_blocks + freed,
           step->n_old_blocks - blocks + freed,
           freed,