Merge remote branch 'mikolaj/dcoutts'

11 files changed, 335 insertions, 40 deletions

diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 0463f15ad8..c0896f7c6a 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -553,6 +553,14 @@ rts_lock (void)
 
     cap = NULL;
     waitForReturnCapability(&cap, task);
+
+    if (task->incall->prev_stack == NULL) {
+      // This is a new outermost call from C into Haskell land.
+      // Until the corresponding call to rts_unlock, this task
+      // is doing work on behalf of the RTS.
+      traceTaskCreate(task, cap);
+    }
+
     return (Capability *)cap;
 }
 
@@ -586,4 +594,11 @@ rts_unlock (Capability *cap)
     // Finally, we can release the Task to the free list.
     boundTaskExiting(task);
     RELEASE_LOCK(&cap->lock);
+
+    if (task->incall == NULL) {
+      // This is the end of an outermost call from C into Haskell land.
+      // From here on, the task goes back to C land and we should not count
+      // it as doing work on behalf of the RTS.
+      traceTaskDelete(task);
+    }
 }
diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index 40665acc56..fd47b7574d 100644
--- a/rts/RtsProbes.d
+++ b/rts/RtsProbes.d
@@ -55,14 +55,13 @@ provider HaskellEvent {
   probe gc__idle (EventCapNo);
   probe gc__work (EventCapNo);
   probe gc__done (EventCapNo);
-  probe gc__sync (EventCapNo);
-/* FIXME: leads to a validate failure on OS X (Lion)
-  probe gc__stats (CapsetID, StgWord, StgWord, StgWord, StgWord, StgWord, StgWord, StgWord);
-  probe heap__info (CapsetID, StgWord, StgWord, StgWord, StgWord, StgWord);
-  probe heap__allocated (EventCapNo, CapsetID, StgWord64);
-  probe heap__size (CapsetID, StgWord);
-  probe heap__live (CapsetID, StgWord);
- */
+  probe gc__global__sync (EventCapNo);
+  probe gc__stats (EventCapsetID, StgWord, StgWord, StgWord, StgWord, StgWord, StgWord, StgWord);
+  probe heap__info (EventCapsetID, StgWord, StgWord, StgWord, StgWord, StgWord);
+  probe heap__allocated (EventCapNo, EventCapsetID, StgWord64);
+  probe heap__size (EventCapsetID, StgWord);
+  probe heap__live (EventCapsetID, StgWord);
+
   /* capability events */
   probe startup (EventCapNo);
   probe cap__create (EventCapNo);
@@ -90,6 +89,11 @@ provider HaskellEvent {
   probe spark__fizzle   (EventCapNo);
   probe spark__gc       (EventCapNo);
 
+  /* task events */
+  probe task__create(EventTaskId, EventCapNo, EventKernelThreadId);
+  probe task__migrate(EventTaskId, EventCapNo, EventCapNo);
+  probe task__delete(EventTaskId);
+
   /* other events */
 /* This one doesn't seem to be used at all at the moment: */
 /*  probe log__msg (char *); */
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 5a8c35f0cb..dee71c4676 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1634,7 +1634,12 @@ delete_threads_and_gc:
             while (!emptyRunQueue(tmp_cap)) {
                 tso = popRunQueue(tmp_cap);
                 migrateThread(tmp_cap, tso, dest_cap);
-                if (tso->bound) { tso->bound->task->cap = dest_cap; }
+                if (tso->bound) {
+                  traceTaskMigrate(tso->bound->task,
+                                   tso->bound->task->cap,
+                                   dest_cap);
+                  tso->bound->task->cap = dest_cap;
+                }
             }
         }
     }
@@ -1899,6 +1904,10 @@ forkProcess(HsStablePtr *entry
         initTimer();
         startTimer();
 
+        // TODO: need to trace various other things in the child
+        // like startup event, capabilities, process info etc
+        traceTaskCreate(task, cap);
+
 #if defined(THREADED_RTS)
         ioManagerStartCap(&cap);
 #endif
@@ -2521,6 +2530,8 @@ performGC_(rtsBool force_major)
     // associated with a particular Capability, and chained onto the 
     // suspended_ccalls queue.
     task = newBoundTask();
+    
+    // TODO: do we need to traceTask*() here?
 
     waitForReturnCapability(&cap,task);
     scheduleDoGC(&cap,task,force_major);
diff --git a/rts/Task.c b/rts/Task.c
index 125000b914..6c814886ba 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -321,6 +321,11 @@ discardTasksExcept (Task *keep)
         next = task->all_next;
         if (task != keep) {
             debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task));
+            // Note that we do not traceTaskDelete here because
+            // we are not really deleting a task.
+            // The OS threads for all these tasks do not exist in
+            // this process (since we're currently
+            // in the child of a forkProcess).
             freeTask(task);
         }
     }
@@ -383,13 +388,18 @@ workerTaskStop (Task *task)
 
     RELEASE_LOCK(&all_tasks_mutex);
 
+    traceTaskDelete(task);
+
     freeTask(task);
 }
 
 #endif
 
 #ifdef DEBUG
-
+// We don't replace this function with serialisableTaskId,
+// because debug prints as pointers are more readable than random
+// 64-bit intergers (especially on 32-bit architectures)
+// and because we want to use this function also for non-treaded RTS.
 static void *taskId(Task *task)
 {
 #ifdef THREADED_RTS
@@ -422,6 +432,9 @@ workerStart(Task *task)
 
     newInCall(task);
 
+    // Everything set up; emit the event before the worker starts working.
+    traceTaskCreate(task, cap);
+
     scheduleWorker(cap,task);
 }
 
@@ -440,6 +453,8 @@ startWorkerTask (Capability *cap)
   // worker thread reads it.
   ACQUIRE_LOCK(&task->lock);
 
+  // We don't emit a task creation event here, but in workerStart,
+  // where the kernel thread id is known.
   task->cap = cap;
 
   // Give the capability directly to the worker; we can't let anyone
diff --git a/rts/Task.h b/rts/Task.h
index ab47a07fc3..7c9c86e40b 100644
--- a/rts/Task.h
+++ b/rts/Task.h
@@ -159,7 +159,6 @@ isBoundTask (Task *task)
     return (task->incall->tso != NULL);
 }
 
-
 // Linked list of all tasks.
 //
 extern Task *all_tasks;
@@ -275,6 +274,44 @@ setMyTask (Task *task)
 #endif
 }
 
+// Tasks are identified by their OS thread ID, which can be serialised
+// to StgWord64, as defined below.
+typedef StgWord64 TaskId;
+
+// Get a unique serialisable representation for a task id.
+//
+// It's only unique within the process. For example if they are emitted in a
+// log file then it is suitable to work out which log entries are releated.
+//
+// This is needed because OSThreadId is an opaque type
+// and in practice on some platforms it is a pointer type.
+//
+#if defined(THREADED_RTS)
+INLINE_HEADER TaskId serialiseTaskId (OSThreadId taskID) {
+#if defined(freebsd_HOST_OS) || defined(darwin_HOST_OS)
+    // Here OSThreadId is a pthread_t and pthread_t is a pointer, but within
+    // the process we can still use that pointer value as a unique id.
+    return (TaskId) taskID
+#else
+    // On Windows, Linux and others it's an integral type to start with.
+    return taskID;
+#endif
+}
+#endif
+
+//
+// Get a serialisable Id for the Task's OS thread
+// Needed mainly for logging since the OSThreadId is an opaque type
+INLINE_HEADER TaskId
+serialisableTaskId (Task *task STG_UNUSED)
+{
+#if defined(THREADED_RTS)
+    return serialiseTaskId(task->id);
+#else
+    return 1;
+#endif
+}
+
 #include "EndPrivate.h"
 
 #endif /* TASK_H */
diff --git a/rts/Trace.c b/rts/Trace.c
index 9fa8eb177b..a946f2c5d3 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -574,6 +574,52 @@ void traceSparkCounters_ (Capability *cap,
     }
 }
 
+void traceTaskCreate_ (Task       *task,
+                       Capability *cap)
+{
+#ifdef DEBUG
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        /* We currently don't do debug tracing of tasks but we must
+           test for TRACE_STDERR because of the !eventlog_enabled case. */
+    } else
+#endif
+    {
+        EventTaskId         taskid = serialisableTaskId(task);
+        EventKernelThreadId tid    = kernelThreadId();
+        postTaskCreateEvent(taskid, cap->no, tid);
+    }
+}
+
+void traceTaskMigrate_ (Task       *task,
+                        Capability *cap,
+                        Capability *new_cap)
+{
+#ifdef DEBUG
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        /* We currently don't do debug tracing of tasks but we must
+           test for TRACE_STDERR because of the !eventlog_enabled case. */
+    } else
+#endif
+    {
+        EventTaskId taskid = serialisableTaskId(task);
+        postTaskMigrateEvent(taskid, cap->no, new_cap->no);
+    }
+}
+
+void traceTaskDelete_ (Task *task)
+{
+#ifdef DEBUG
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        /* We currently don't do debug tracing of tasks but we must
+           test for TRACE_STDERR because of the !eventlog_enabled case. */
+    } else
+#endif
+    {
+        EventTaskId taskid = serialisableTaskId(task);
+        postTaskDeleteEvent(taskid);
+    }
+}
+
 #ifdef DEBUG
 static void traceCap_stderr(Capability *cap, char *msg, va_list ap)
 {
diff --git a/rts/Trace.h b/rts/Trace.h
index 58ce43df68..dcd00b8cc1 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -262,6 +262,15 @@ void traceSparkCounters_ (Capability *cap,
                           SparkCounters counters,
                           StgWord remaining);
 
+void traceTaskCreate_ (Task       *task,
+                       Capability *cap);
+
+void traceTaskMigrate_ (Task       *task,
+                        Capability *cap,
+                        Capability *new_cap);
+
+void traceTaskDelete_ (Task       *task);
+
 #else /* !TRACING */
 
 #define traceSchedEvent(cap, tag, tso, other) /* nothing */
@@ -289,6 +298,9 @@ INLINE_HEADER void traceEventStartup_ (int n_caps STG_UNUSED) {};
 #define traceWallClockTime_() /* nothing */
 #define traceOSProcessInfo_() /* nothing */
 #define traceSparkCounters_(cap, counters, remaining) /* nothing */
+#define traceTaskCreate_(taskID, cap) /* nothing */
+#define traceTaskMigrate_(taskID, cap, new_cap) /* nothing */
+#define traceTaskDelete_(taskID) /* nothing */
 
 #endif /* TRACING */
 
@@ -352,7 +364,6 @@ INLINE_HEADER void dtraceStartup (int num_caps) {
     HASKELLEVENT_GC_DONE(cap)
 #define dtraceGcGlobalSync(cap)                         \
     HASKELLEVENT_GC_GLOBAL_SYNC(cap)
-/* FIXME: leads to a validate failure on OS X (Lion)
 #define dtraceEventGcStats(heap_capset, gens,           \
                            copies, slop, fragmentation, \
                            par_n_threads,               \
@@ -377,20 +388,6 @@ INLINE_HEADER void dtraceStartup (int num_caps) {
     HASKELLEVENT_HEAP_SIZE(heap_capset, size)
 #define dtraceEventHeapLive(heap_capset, live)          \
     HASKELLEVENT_HEAP_LIVE(heap_capset, live)
- */
-#define dtraceEventGcStats(heap_capset, gens,           \
-                           copies, slop, fragmentation, \
-                           par_n_threads,               \
-                           par_max_copied,              \
-                           par_tot_copied)              
-#define dtraceHeapInfo(heap_capset, gens,               \
-                       maxHeapSize, allocAreaSize,      \
-                       mblockSize, blockSize)           
-#define dtraceEventHeapAllocated(cap, heap_capset,      \
-                                 allocated)             
-#define dtraceEventHeapSize(heap_capset, size)          
-#define dtraceEventHeapLive(heap_capset, live)          
- 
 #define dtraceCapsetCreate(capset, capset_type)         \
     HASKELLEVENT_CAPSET_CREATE(capset, capset_type)
 #define dtraceCapsetDelete(capset)                      \
@@ -415,6 +412,12 @@ INLINE_HEADER void dtraceStartup (int num_caps) {
     HASKELLEVENT_SPARK_FIZZLE(cap)
 #define dtraceSparkGc(cap)                              \
     HASKELLEVENT_SPARK_GC(cap)
+#define dtraceTaskCreate(taskID, cap)                   \
+    HASKELLEVENT_TASK_CREATE(taskID, cap)
+#define dtraceTaskMigrate(taskID, cap, new_cap)         \
+    HASKELLEVENT_TASK_MIGRATE(taskID, cap, new_cap)
+#define dtraceTaskDelete(taskID)                        \
+    HASKELLEVENT_TASK_DELETE(taskID)
 
 #else /* !defined(DTRACE) */
 
@@ -464,6 +467,9 @@ INLINE_HEADER void dtraceStartup (int num_caps STG_UNUSED) {};
 #define dtraceSparkSteal(cap, victim_cap)               /* nothing */
 #define dtraceSparkFizzle(cap)                          /* nothing */
 #define dtraceSparkGc(cap)                              /* nothing */
+#define dtraceTaskCreate(taskID, cap)                   /* nothing */
+#define dtraceTaskMigrate(taskID, cap, new_cap)         /* nothing */
+#define dtraceTaskDelete(taskID)                        /* nothing */
 
 #endif
 
@@ -531,9 +537,7 @@ INLINE_HEADER void traceEventMigrateThread(Capability *cap     STG_UNUSED,
 INLINE_HEADER void traceCapCreate(Capability *cap STG_UNUSED)
 {
     traceCapEvent(cap, EVENT_CAP_CREATE);
-/* FIXME: leads to a validate failure on OS X (Lion)
     dtraceCapCreate((EventCapNo)cap->no);
-    */
 }
 
 INLINE_HEADER void traceCapDelete(Capability *cap STG_UNUSED)
@@ -632,9 +636,7 @@ INLINE_HEADER void traceEventGcDone(Capability *cap STG_UNUSED)
 INLINE_HEADER void traceEventGcGlobalSync(Capability *cap STG_UNUSED)
 {
     traceGcEvent(cap, EVENT_GC_GLOBAL_SYNC);
-/* FIXME: leads to a validate failure on OS X (Lion)
     dtraceGcGlobalSync((EventCapNo)cap->no);
-    */
 }
 
 INLINE_HEADER void traceEventGcStats(Capability *cap            STG_UNUSED,
@@ -822,6 +824,47 @@ INLINE_HEADER void traceEventSparkGC(Capability *cap STG_UNUSED)
     dtraceSparkGc((EventCapNo)cap->no);
 }
 
+INLINE_HEADER void traceTaskCreate(Task       *task STG_UNUSED,
+                                   Capability *cap  STG_UNUSED)
+{
+    ASSERT(task->cap == cap);
+    // TODO: asserting task->cap == NULL would be much stronger
+    // (the intention being that the task structure is just created and empty)
+    // but would require large changes of traceTaskCreate calls.
+    ASSERT(cap != NULL);
+    // A new task gets associated with a cap. We also record
+    // the kernel thread id of the task, which should never change.
+    if (RTS_UNLIKELY(TRACE_sched)) {
+        traceTaskCreate_(task, cap);
+    }
+    dtraceTaskCreate(serialisableTaskId(task), (EventCapNo)cap->no);
+}
+
+INLINE_HEADER void traceTaskMigrate(Task       *task    STG_UNUSED,
+                                    Capability *cap     STG_UNUSED,
+                                    Capability *new_cap STG_UNUSED)
+{
+    ASSERT(task->cap == cap);
+    ASSERT(cap != NULL);
+    ASSERT(cap != new_cap);
+    ASSERT(new_cap != NULL);
+    // A task migrates from a cap to another.
+    if (RTS_UNLIKELY(TRACE_sched)) {
+        traceTaskMigrate_(task, cap, new_cap);
+    }
+    dtraceTaskMigrate(serialisableTaskId(task), (EventCapNo)cap->no,
+                                                (EventCapNo)new_cap->no);
+}
+
+INLINE_HEADER void traceTaskDelete(Task *task STG_UNUSED)
+{
+    ASSERT(task->cap != NULL);
+    if (RTS_UNLIKELY(TRACE_sched)) {
+        traceTaskDelete_(task);
+    }
+    dtraceTaskDelete(serialisableTaskId(task));
+}
+
 #include "EndPrivate.h"
 
 #endif /* TRACE_H */
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 66b589e282..b6614b940c 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -102,6 +102,9 @@ char *EventDesc[] = {
   [EVENT_SPARK_STEAL]         = "Spark steal",
   [EVENT_SPARK_FIZZLE]        = "Spark fizzle",
   [EVENT_SPARK_GC]            = "Spark GC",
+  [EVENT_TASK_CREATE]         = "Task create",
+  [EVENT_TASK_MIGRATE]        = "Task migrate",
+  [EVENT_TASK_DELETE]         = "Task delete",
 };
 
 // Event type. 
@@ -178,6 +181,15 @@ static inline void postCapsetID(EventsBuf *eb, EventCapsetID id)
 static inline void postCapsetType(EventsBuf *eb, EventCapsetType type)
 { postWord16(eb,type); }
 
+static inline void postOSProcessId(EventsBuf *eb, pid_t pid)
+{ postWord32(eb, pid); }
+
+static inline void postKernelThreadId(EventsBuf *eb, EventKernelThreadId tid)
+{ postWord64(eb, tid); }
+
+static inline void postTaskId(EventsBuf *eb, EventTaskId tUniq)
+{ postWord64(eb, tUniq); }
+
 static inline void postPayloadSize(EventsBuf *eb, EventPayloadSize size)
 { postWord16(eb,size); }
 
@@ -393,6 +405,20 @@ initEventLogging(void)
                                + sizeof(StgWord64) * 2;
             break;
 
+        case EVENT_TASK_CREATE:   // (taskId, cap, tid)
+            eventTypes[t].size =
+                sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventKernelThreadId);
+            break;
+
+        case EVENT_TASK_MIGRATE:   // (taskId, cap, new_cap)
+            eventTypes[t].size =
+                sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventCapNo);
+            break;
+
+        case EVENT_TASK_DELETE:   // (taskId)
+            eventTypes[t].size = sizeof(EventTaskId);
+            break;
+
         case EVENT_BLOCK_MARKER:
             eventTypes[t].size = sizeof(StgWord32) + sizeof(EventTimestamp) + 
                 sizeof(EventCapNo);
@@ -699,7 +725,7 @@ void postCapsetEvent (EventTypeNum tag,
     case EVENT_OSPROCESS_PID:   // (capset, pid)
     case EVENT_OSPROCESS_PPID:  // (capset, parent_pid)
     {
-        postWord32(&eventBuf, info);
+        postOSProcessId(&eventBuf, info);
         break;
     }
     default:
@@ -914,6 +940,62 @@ void postEventGcStats  (Capability    *cap,
     postWord64(eb, par_tot_copied);
 }
 
+void postTaskCreateEvent (EventTaskId taskId,
+                          EventCapNo capno,
+                          EventKernelThreadId tid)
+{
+    ACQUIRE_LOCK(&eventBufMutex);
+
+    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_CREATE)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(&eventBuf);
+    }
+
+    postEventHeader(&eventBuf, EVENT_TASK_CREATE);
+    /* EVENT_TASK_CREATE (taskID, cap, tid) */
+    postTaskId(&eventBuf, taskId);
+    postCapNo(&eventBuf, capno);
+    postKernelThreadId(&eventBuf, tid);
+
+    RELEASE_LOCK(&eventBufMutex);
+}
+
+void postTaskMigrateEvent (EventTaskId taskId,
+                           EventCapNo capno,
+                           EventCapNo new_capno)
+{
+    ACQUIRE_LOCK(&eventBufMutex);
+
+    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_MIGRATE)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(&eventBuf);
+    }
+
+    postEventHeader(&eventBuf, EVENT_TASK_MIGRATE);
+    /* EVENT_TASK_MIGRATE (taskID, cap, new_cap) */
+    postTaskId(&eventBuf, taskId);
+    postCapNo(&eventBuf, capno);
+    postCapNo(&eventBuf, new_capno);
+
+    RELEASE_LOCK(&eventBufMutex);
+}
+
+void postTaskDeleteEvent (EventTaskId taskId)
+{
+    ACQUIRE_LOCK(&eventBufMutex);
+
+    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_DELETE)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(&eventBuf);
+    }
+
+    postEventHeader(&eventBuf, EVENT_TASK_DELETE);
+    /* EVENT_TASK_DELETE (taskID) */
+    postTaskId(&eventBuf, taskId);
+
+    RELEASE_LOCK(&eventBufMutex);
+}
+
 void
 postEvent (Capability *cap, EventTypeNum tag)
 {
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index b8ee56aa3b..93dd9a8144 100644
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -28,11 +28,11 @@ void abortEventLogging(void); // #4512 - after fork child needs to abort
 void flushEventLog(void);     // event log inherited from parent
 void moreCapEventBufs (nat from, nat to);
 
-/* 
+/*
  * Post a scheduler event to the capability's event buffer (an event
  * that has an associated thread).
  */
-void postSchedEvent(Capability *cap, EventTypeNum tag, 
+void postSchedEvent(Capability *cap, EventTypeNum tag,
                     StgThreadID id, StgWord info1, StgWord info2);
 
 /*
@@ -40,7 +40,7 @@ void postSchedEvent(Capability *cap, EventTypeNum tag,
  */
 void postEvent(Capability *cap, EventTypeNum tag);
 
-void postEventAtTimestamp (Capability *cap, EventTimestamp ts, 
+void postEventAtTimestamp (Capability *cap, EventTimestamp ts,
                            EventTypeNum tag);
 
 void postMsg(char *msg, va_list ap);
@@ -81,7 +81,7 @@ void postCapsetVecEvent (EventTypeNum tag,
 
 void postWallClockTime (EventCapsetID capset);
 
-/* 
+/*
  * Post a `par` spark event
  */
 void postSparkEvent(Capability *cap, EventTypeNum tag, StgWord info1);
@@ -89,7 +89,7 @@ void postSparkEvent(Capability *cap, EventTypeNum tag, StgWord info1);
 /*
  * Post an event with several counters relating to `par` sparks.
  */
-void postSparkCountersEvent (Capability *cap, 
+void postSparkCountersEvent (Capability *cap,
                              SparkCounters counters,
                              StgWord remaining);
 
@@ -125,6 +125,16 @@ void postEventGcStats  (Capability    *cap,
                         lnat           par_max_copied,
                         lnat           par_tot_copied);
 
+void postTaskCreateEvent (EventTaskId taskId,
+                          EventCapNo cap,
+                          EventKernelThreadId tid);
+
+void postTaskMigrateEvent (EventTaskId taskId,
+                           EventCapNo capno,
+                           EventCapNo new_capno);
+
+void postTaskDeleteEvent (EventTaskId taskId);
+
 #else /* !TRACING */
 
 INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
@@ -138,12 +148,12 @@ INLINE_HEADER void postEvent (Capability *cap  STG_UNUSED,
                               EventTypeNum tag STG_UNUSED)
 { /* nothing */ }
 
-INLINE_HEADER void postMsg (char *msg STG_UNUSED, 
+INLINE_HEADER void postMsg (char *msg STG_UNUSED,
                             va_list ap STG_UNUSED)
 { /* nothing */ }
 
 INLINE_HEADER void postCapMsg (Capability *cap STG_UNUSED,
-                               char *msg STG_UNUSED, 
+                               char *msg STG_UNUSED,
                                va_list ap STG_UNUSED)
 { /* nothing */ }
 
@@ -152,7 +162,7 @@ INLINE_HEADER void postThreadLabel(Capability    *cap   STG_UNUSED,
                                    EventThreadID  id    STG_UNUSED,
                                    char          *label STG_UNUSED)
 { /* nothing */ }
-                                   
+
 #endif
 
 #include "EndPrivate.h"
diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c
index c29454809f..5fd09982de 100644
--- a/rts/posix/OSThreads.c
+++ b/rts/posix/OSThreads.c
@@ -23,6 +23,12 @@
 
 #include "Rts.h"
 
+#if defined(linux_HOST_OS)
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/syscall.h>
+#endif
+
 #if defined(THREADED_RTS)
 #include "RtsUtils.h"
 #include "Task.h"
@@ -312,4 +318,24 @@ nat getNumberOfProcessors (void)
     return 1;
 }
 
+#endif /* defined(THREADED_RTS) */
+
+KernelThreadId kernelThreadId (void)
+{
+#if defined(linux_HOST_OS)
+    pid_t tid = syscall(SYS_gettid); // no really, see man gettid
+    return tid;
+
+#elif defined(freebsd_HOST_OS)
+    return pthread_getthreadid_np();
+
+#elif defined(darwin_HOST_OS)
+    uint64_t ktid;
+    pthread_threadid_np(NULL, &ktid);
+    return ktid;
+
+#else
+    // unsupported
+    return 0;
 #endif
+}
diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c
index 818f97b879..d0d97b3c4d 100644
--- a/rts/win32/OSThreads.c
+++ b/rts/win32/OSThreads.c
@@ -10,9 +10,9 @@
 #define _WIN32_WINNT 0x0500
 
 #include "Rts.h"
+#include <windows.h>
 #if defined(THREADED_RTS)
 #include "RtsUtils.h"
-#include <windows.h>
 
 /* For reasons not yet clear, the entire contents of process.h is protected 
  * by __STRICT_ANSI__ not being defined.
@@ -314,3 +314,9 @@ nat getNumberOfProcessors (void)
 }
 
 #endif /* !defined(THREADED_RTS) */
+
+KernelThreadId kernelThreadId (void)
+{
+    DWORD tid = GetCurrentThreadId();
+    return tid;
+}