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)

20 files changed, 809 insertions, 119 deletions

diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 31ff9d18eb..ae7b00d223 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -106,6 +106,7 @@ static_flags = [
 
         ------- ways --------------------------------------------------------
   , Flag "prof"           (NoArg (addWay WayProf)) Supported
+  , Flag "eventlog"       (NoArg (addWay WayEventLog)) Supported
   , Flag "ticky"          (NoArg (addWay WayTicky)) Supported
   , Flag "parallel"       (NoArg (addWay WayPar)) Supported
   , Flag "gransim"        (NoArg (addWay WayGran)) Supported
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index d88a33de67..99904a91b0 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -320,6 +320,7 @@ data WayName
   = WayThreaded
   | WayDebug
   | WayProf
+  | WayEventLog
   | WayTicky
   | WayPar
   | WayGran
@@ -359,6 +360,7 @@ allowed_combination way = and [ x `allowedWith` y
 
 	WayProf `allowedWith` WayNDP		= True
 	WayThreaded `allowedWith` WayProf	= True
+	WayThreaded `allowedWith` WayEventLog	= True
 	_ `allowedWith` _ 			= False
 
 
@@ -425,6 +427,10 @@ way_details =
 	, "-DPROFILING"
 	, "-optc-DPROFILING" ]),
 
+    (WayEventLog, Way  "l" True "RTS Event Logging"
+	[ "-DEVENTLOG"
+	, "-optc-DEVENTLOG" ]),
+
     (WayTicky, Way  "t" True "Ticky-ticky Profiling"  
 	[ "-DTICKY_TICKY"
 	, "-optc-DTICKY_TICKY" ]),
diff --git a/includes/EventLogFormat.h b/includes/EventLogFormat.h
new file mode 100644
index 0000000000..5fbfe9bd99
--- /dev/null
+++ b/includes/EventLogFormat.h
@@ -0,0 +1,135 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2008-2009
+ *
+ * Event log format
+ * 
+ * The log format is designed to be extensible: old tools should be
+ * able to parse (but not necessarily understand all of) new versions
+ * of the format, and new tools will be able to understand old log
+ * files.
+ * 
+ * Each event has a specific format.  If you add new events, give them
+ * new numbers: we never re-use old event numbers.
+ *
+ * - The format is endian-independent: all values are represented in 
+ *    bigendian order.
+ *
+ * - The format is extensible:
+ *
+ *    - The header describes each event type and its length.  Tools
+ *      that don't recognise a particular event type can skip those events.
+ *
+ *    - There is room for extra information in the event type
+ *      specification, which can be ignored by older tools.
+ *
+ *    - Events can have extra information added, but existing fields
+ *      cannot be changed.  Tools should ignore extra fields at the
+ *      end of the event record.
+ *
+ *    - Old event type ids are never re-used; just take a new identifier.
+ *
+ *
+ * The format
+ * ----------
+ *
+ * log : EVENT_HEADER_BEGIN
+ *       EventType*
+ *       EVENT_HEADER_END
+ *       EVENT_DATA_BEGIN
+ *       Event*
+ *       EVENT_DATA_END
+ *
+ * EventType :
+ *       EVENT_ET_BEGIN
+ *       Word16         -- unique identifier for this event
+ *       Int16          -- >=0  size of the event in bytes (minus the header)
+ *                      -- -1   variable size
+ *       Word32         -- length of the next field in bytes
+ *       Word8*         -- string describing the event
+ *       Word32         -- length of the next field in bytes
+ *       Word8*         -- extra info (for future extensions)
+ *       EVENT_ET_END
+ *
+ * Event : 
+ *       Word16         -- event_type
+ *       Word64         -- time (nanosecs)
+ *       [Word16]       -- length of the rest (for variable-sized events only)
+ *       ... extra event-specific info ...
+ *
+ *
+ * To add a new event
+ * ------------------
+ *
+ *  - In this file:
+ *    - give it a new number, add a new #define EVENT_XXX below
+ *  - In EventLog.c
+ *    - add it to the EventDesc array
+ *    - emit the event type in initEventLogging()
+ *    - emit the new event in postEvent_()
+ *    - generate the event itself by calling postEvent() somewhere
+ *  - In the Haskell code to parse the event log file:
+ *    - add types and code to read the new event
+ *
+ * -------------------------------------------------------------------------- */
+
+/*
+ * Markers for begin/end of the Header.
+ */
+#define EVENT_HEADER_BEGIN    0x68647262 /* 'h' 'd' 'r' 'b' */
+#define EVENT_HEADER_END      0x68647265 /* 'h' 'd' 'r' 'e' */
+
+#define EVENT_DATA_BEGIN      0x64617462 /* 'd' 'a' 't' 'b' */
+#define EVENT_DATA_END        0xffff
+
+/*
+ * Markers for begin/end of the list of Event Types in the Header.
+ * Header, Event Type, Begin = hetb
+ * Header, Event Type, End = hete
+ */
+#define EVENT_HET_BEGIN       0x68657462 /* 'h' 'e' 't' 'b' */
+#define EVENT_HET_END         0x68657465 /* 'h' 'e' 't' 'e' */
+
+#define EVENT_ET_BEGIN        0x65746200 /* 'e' 't' 'b' 0 */
+#define EVENT_ET_END          0x65746500 /* 'e' 't' 'e' 0 */
+
+/*
+ * Types of event
+ */
+#define EVENT_CREATE_THREAD   0 /* (cap, thread)              */
+#define EVENT_RUN_THREAD      1 /* (cap, thread)              */
+#define EVENT_STOP_THREAD     2 /* (cap, thread, status)      */
+#define EVENT_THREAD_RUNNABLE 3 /* (cap, thread)              */
+#define EVENT_MIGRATE_THREAD  4 /* (cap, thread, new_cap)     */
+#define EVENT_RUN_SPARK       5 /* (cap, thread)              */
+#define EVENT_STEAL_SPARK     6 /* (cap, thread, victim_cap)  */
+#define EVENT_SHUTDOWN        7 /* (cap)                      */
+#define EVENT_THREAD_WAKEUP   8 /* (cap, thread, other_cap)   */
+#define EVENT_GC_START        9 /* (cap) */
+#define EVENT_GC_END         10 /* (cap) */
+#define EVENT_REQUEST_SEQ_GC 11 /* (cap) */
+#define EVENT_REQUEST_PAR_GC 12 /* (cap) */
+
+#define NUM_EVENT_TAGS       13 
+
+/*
+ * Status values for EVENT_STOP_THREAD
+ *
+ * 1-5 are the StgRun return values (from includes/Constants.h):
+ *
+ * #define HeapOverflow   1
+ * #define StackOverflow  2
+ * #define ThreadYielding 3
+ * #define ThreadBlocked  4
+ * #define ThreadFinished 5
+ */
+#define THREAD_SUSPENDED_FOREIGN_CALL 6
+
+#ifndef EVENTLOG_CONSTANTS_ONLY
+
+typedef StgWord16 EventTypeNum;
+typedef StgWord64 Timestamp; // in nanoseconds
+typedef StgWord64 ThreadID;
+typedef StgWord16 CapabilityNum;
+
+#endif
diff --git a/includes/RtsFlags.h b/includes/RtsFlags.h
index 5c72bbb3e2..77097872a2 100644
--- a/includes/RtsFlags.h
+++ b/includes/RtsFlags.h
@@ -60,6 +60,7 @@ struct DEBUG_FLAGS {
     rtsBool sanity;         /* 'S'   warning: might be expensive! */
     rtsBool stable;         /* 't' */
     rtsBool prof;           /* 'p' */
+    rtsBool eventlog;       /* 'e' */
     rtsBool gran;           /* 'r' */
     rtsBool par;            /* 'P' */
     rtsBool linker;         /* 'l'   the object linker */
@@ -67,6 +68,7 @@ struct DEBUG_FLAGS {
     rtsBool stm;            /* 'm' */
     rtsBool squeeze;        /* 'z'  stack squeezing & lazy blackholing */
     rtsBool hpc; 	    /* 'c' coverage */
+    rtsBool timestamp;          /* add timestamps to traces */
 };
 
 struct COST_CENTRE_FLAGS {
@@ -113,6 +115,12 @@ struct PROFILING_FLAGS {
 
 };
 
+#ifdef EVENTLOG
+struct EVENTLOG_FLAGS {
+  rtsBool doEventLogging;
+};
+#endif
+
 struct CONCURRENT_FLAGS {
     int ctxtSwitchTime;		/* in milliseconds */
     int ctxtSwitchTicks;	/* derived */
@@ -307,12 +315,6 @@ struct TICKY_FLAGS {
     FILE   *tickyFile;
 };
 
-struct TRACE_FLAGS {
-    rtsBool sched;		/* trace scheduler events for profiling */
-    rtsBool gc;                 /* trace GC events */
-    rtsBool timestamp;          /* add timestamps to traces */
-};
-
 #ifdef USE_PAPI
 #define MAX_PAPI_USER_EVENTS 8
 
@@ -341,8 +343,10 @@ typedef struct _RTS_FLAGS {
     struct DEBUG_FLAGS	     DebugFlags;
     struct COST_CENTRE_FLAGS CcFlags;
     struct PROFILING_FLAGS   ProfFlags;
+#ifdef EVENTLOG
+    struct EVENTLOG_FLAGS    EventLogFlags;
+#endif
     struct TICKY_FLAGS	     TickyFlags;
-    struct TRACE_FLAGS       TraceFlags;
 
 #if defined(THREADED_RTS) || defined(PAR)
     struct PAR_FLAGS	ParFlags;
diff --git a/mk/config.mk.in b/mk/config.mk.in
index bdaed164d5..ae961bbd68 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -385,8 +385,11 @@ endif
 #   thr_debug_p : debugging threaded profiled
 #   t		: ticky-ticky profiling
 #   debug_t	: debugging ticky-ticky profiling
+#   l           : event logging
+#   thr_l       : threaded and event logging
+#   thr_debug_l	: threaded and debugging and event logging
 #
-GhcRTSWays=
+GhcRTSWays=l
 
 # Usually want the debug version
 ifeq "$(BootingFromHc)" "NO"
@@ -400,7 +403,8 @@ endif
 # Want the threaded versions unless we're unregisterised
 # Defer the check until later by using $(if..), because GhcUnregisterised might
 # be set in build.mk, which hasn't been read yet.
-GhcRTSWays += $(if $(findstring NO, $(GhcUnregisterised)),thr thr_p thr_debug,)
+GhcRTSWays += $(if $(findstring NO, $(GhcUnregisterised)),thr thr_debug thr_l,)
+GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_p,)
 
 # We can only build GHCi threaded if we have a threaded RTS:
 GhcThreaded = $(if $(findstring thr,$(GhcRTSWays)),YES,NO)
@@ -1248,6 +1252,10 @@ WAY_p_HC_OPTS= -prof
 WAY_t_NAME=ticky-ticky profiling
 WAY_t_HC_OPTS= -ticky
 
+# Way 'l':
+WAY_l_NAME=event logging
+WAY_l_HC_OPTS= -eventlog
+
 # Way `mp': 
 WAY_mp_NAME=parallel
 WAY_mp_HC_OPTS=-parallel
@@ -1268,6 +1276,10 @@ WAY_thr_HC_OPTS=-optc-DTHREADED_RTS
 WAY_thr_p_NAME=threaded profiled
 WAY_thr_p_HC_OPTS=-optc-DTHREADED_RTS -prof
 
+# Way 'thr_l':
+WAY_thr_l_NAME=threaded event logging
+WAY_thr_l_HC_OPTS=-optc-DTHREADED_RTS -eventlog
+
 # Way 'debug':
 WAY_debug_NAME=debug
 WAY_debug_HC_OPTS=-optc-DDEBUG
@@ -1288,6 +1300,10 @@ WAY_thr_debug_HC_OPTS=-optc-DTHREADED_RTS -optc-DDEBUG
 WAY_thr_debug_p_NAME=threaded debug profiling
 WAY_thr_debug_p_HC_OPTS=-optc-DTHREADED_RTS -optc-DDEBUG -prof
 
+# Way 'thr_debug_l':
+WAY_thr_debug_l_NAME=threaded debug event logging
+WAY_thr_debug_l_HC_OPTS=-optc-DTHREADED_RTS -optc-DDEBUG -eventlog
+
 # Way 'dyn': build dynamic shared libraries
 WAY_dyn_NAME=dyn
 WAY_dyn_HC_OPTS=-fPIC -dynamic
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,