Add eventlog event for thread labels

The existing GHC.Conc.labelThread will now also emit the the thread
label into the eventlog. Profiling tools like ThreadScope could then
use the thread labels rather than thread numbers.

9 files changed, 101 insertions, 10 deletions

diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 7773bae6a9..0b276b1d9f 100644
--- a/includes/rts/EventLogFormat.h
+++ b/includes/rts/EventLogFormat.h
@@ -142,9 +142,9 @@
 #define EVENT_SPARK_GC            41 /* ()                     */
 #define EVENT_INTERN_STRING       42 /* (string, id) {not used by ghc} */
 #define EVENT_WALL_CLOCK_TIME     43 /* (capset, unix_epoch_seconds, nanoseconds) */
+#define EVENT_THREAD_LABEL        44 /* (thread, name_string)  */
 
-
-/* Range 44 - 59 is available for new GHC and common events */
+/* Range 45 - 59 is available for new GHC and common events */
 
 /* Range 60 - 80 is used by eden for parallel tracing
  * see http://www.mathematik.uni-marburg.de/~eden/
@@ -157,7 +157,7 @@
  * ranges higher than this are reserved but not currently emitted by ghc.
  * This must match the size of the EventDesc[] array in EventLog.c
  */
-#define NUM_GHC_EVENT_TAGS        44
+#define NUM_GHC_EVENT_TAGS        45
 
 #if 0  /* DEPRECATED EVENTS: */
 /* we don't actually need to record the thread, it's implicit */
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index c96e459975..85920932c9 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -631,8 +631,8 @@ stg_labelThreadzh
   /* args: 
 	R1 = ThreadId#
 	R2 = Addr# */
-#ifdef DEBUG
-  foreign "C" labelThread(R1 "ptr", R2 "ptr") [];
+#if defined(DEBUG) || defined(TRACING) || defined(DTRACE)
+  foreign "C" labelThread(MyCapability() "ptr", R1 "ptr", R2 "ptr") [];
 #endif
   jump %ENTRY_CODE(Sp(0));
 }
diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index 04005108d5..1c74619e79 100644
--- a/rts/RtsProbes.d
+++ b/rts/RtsProbes.d
@@ -50,6 +50,7 @@ provider HaskellEvent {
   probe request__seq__gc (EventCapNo);
   probe request__par__gc (EventCapNo);
   probe create__spark__thread (EventCapNo, EventThreadID);
+  probe thread__label (EventCapNo, EventThreadID, char *);
 
   /* other events */
 /* This one doesn't seem to be used at all at the moment: */
diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c
index 6d2a5d641d..8838042a83 100644
--- a/rts/ThreadLabels.c
+++ b/rts/ThreadLabels.c
@@ -13,12 +13,13 @@
 #include "ThreadLabels.h"
 #include "RtsUtils.h"
 #include "Hash.h"
+#include "Trace.h"
 
 #include <stdlib.h>
 #include <string.h>
 
 #if defined(DEBUG)
-/* to the end */
+
 static HashTable * threadLabels = NULL;
 
 void
@@ -61,9 +62,14 @@ removeThreadLabel(StgWord key)
   }  
 }
 
+#endif /* DEBUG */
+
 void
-labelThread(StgPtr tso, char *label)
+labelThread(Capability *cap   STG_UNUSED,
+            StgTSO     *tso   STG_UNUSED,
+            char       *label STG_UNUSED)
 {
+#if defined(DEBUG)
   int len;
   void *buf;
 
@@ -72,7 +78,8 @@ labelThread(StgPtr tso, char *label)
   buf = stgMallocBytes(len * sizeof(char), "Schedule.c:labelThread()");
   strncpy(buf,label,len);
   /* Update will free the old memory for us */
-  updateThreadLabel(((StgTSO *)tso)->id,buf);
+  updateThreadLabel(tso->id,buf);
+#endif
+  traceThreadLabel(cap, tso, label);
 }
 
-#endif /* DEBUG */
diff --git a/rts/ThreadLabels.h b/rts/ThreadLabels.h
index 254b91ed10..742e77ae58 100644
--- a/rts/ThreadLabels.h
+++ b/rts/ThreadLabels.h
@@ -17,8 +17,10 @@ void    initThreadLabelTable (void);
 void    freeThreadLabelTable (void);
 void *  lookupThreadLabel    (StgWord key);
 void    removeThreadLabel    (StgWord key);
-void    labelThread          (StgPtr tso, char *label);
 #endif
+void    labelThread          (Capability *cap,
+                              StgTSO     *tso,
+                              char       *label);
 
 #include "EndPrivate.h"
 
diff --git a/rts/Trace.c b/rts/Trace.c
index a3aa266c4e..1671bfeb36 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -547,6 +547,24 @@ void traceUserMsg(Capability *cap, char *msg)
     traceFormatUserMsg(cap, "%s", msg);
 }
 
+void traceThreadLabel_(Capability *cap,
+                       StgTSO     *tso,
+                       char       *label)
+{
+#ifdef DEBUG
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        ACQUIRE_LOCK(&trace_utx);
+        tracePreface();
+        debugBelch("cap %d: thread %lu has label %s\n",
+                   cap->no, (lnat)tso->id, label);
+        RELEASE_LOCK(&trace_utx);
+    } else
+#endif
+    {
+        postThreadLabel(cap, tso->id, label);
+    }
+}
+
 void traceThreadStatus_ (StgTSO *tso USED_IF_DEBUG)
 {
 #ifdef DEBUG
diff --git a/rts/Trace.h b/rts/Trace.h
index a0c5e26e2d..8dacb80eda 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -152,9 +152,18 @@ void trace_(char *msg, ...);
 
 /* 
  * A message or event emitted by the program
+ * Used by Debug.Trace.{traceEvent, traceEventIO}
  */
 void traceUserMsg(Capability *cap, char *msg);
 
+/*
+ * An event to record a Haskell thread's label/name
+ * Used by GHC.Conc.labelThread
+ */
+void traceThreadLabel_(Capability *cap,
+                       StgTSO     *tso,
+                       char       *label);
+
 /* 
  * Emit a debug message (only when DEBUG is defined)
  */
@@ -221,6 +230,7 @@ void traceSparkCounters_ (Capability *cap,
 #define debugTrace(class, str, ...) /* nothing */
 #define debugTraceCap(class, cap, str, ...) /* nothing */
 #define traceThreadStatus(class, tso) /* nothing */
+#define traceThreadLabel_(cap, tso, label) /* nothing */
 INLINE_HEADER void traceEventStartup_ (int n_caps STG_UNUSED) {};
 #define traceCapsetEvent_(tag, capset, info) /* nothing */
 #define traceWallClockTime_() /* nothing */
@@ -268,6 +278,8 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
     HASKELLEVENT_REQUEST_PAR_GC(cap)
 #define dtraceCreateSparkThread(cap, spark_tid)         \
     HASKELLEVENT_CREATE_SPARK_THREAD(cap, spark_tid)
+#define dtraceThreadLabel(cap, tso, label)              \
+    HASKELLEVENT_THREAD_LABEL(cap, tso, label)
 INLINE_HEADER void dtraceStartup (int num_caps) {
     HASKELLEVENT_STARTUP(num_caps);
 }
@@ -318,6 +330,7 @@ INLINE_HEADER void dtraceStartup (int num_caps) {
 #define dtraceRequestSeqGc(cap)                         /* nothing */
 #define dtraceRequestParGc(cap)                         /* nothing */
 #define dtraceCreateSparkThread(cap, spark_tid)         /* nothing */
+#define dtraceThreadLabel(cap, tso, label)              /* nothing */
 INLINE_HEADER void dtraceStartup (int num_caps STG_UNUSED) {};
 #define dtraceUserMsg(cap, msg)                         /* nothing */
 #define dtraceGcIdle(cap)                               /* nothing */
@@ -414,6 +427,16 @@ INLINE_HEADER void traceEventThreadWakeup(Capability *cap       STG_UNUSED,
                        (EventCapNo)other_cap);
 }
 
+INLINE_HEADER void traceThreadLabel(Capability *cap   STG_UNUSED,
+                                    StgTSO     *tso   STG_UNUSED,
+                                    char       *label STG_UNUSED)
+{
+    if (RTS_UNLIKELY(TRACE_sched)) {
+        traceThreadLabel_(cap, tso, label);
+    }
+    dtraceThreadLabel((EventCapNo)cap->no, (EventThreadID)tso->id, label);
+}
+
 INLINE_HEADER void traceEventGcStart(Capability *cap STG_UNUSED)
 {
     traceGcEvent(cap, EVENT_GC_START);
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 09e12a2fa3..9547e7c788 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -62,6 +62,7 @@ char *EventDesc[] = {
   [EVENT_MIGRATE_THREAD]      = "Migrate thread",
   [EVENT_SHUTDOWN]            = "Shutdown",
   [EVENT_THREAD_WAKEUP]       = "Wakeup thread",
+  [EVENT_THREAD_LABEL]        = "Thread label",
   [EVENT_GC_START]            = "Starting GC",
   [EVENT_GC_END]              = "Finished GC",
   [EVENT_REQUEST_SEQ_GC]      = "Request sequential GC",
@@ -332,6 +333,7 @@ initEventLogging(void)
         case EVENT_RTS_IDENTIFIER:   // (capset, str)
         case EVENT_PROGRAM_ARGS:     // (capset, strvec)
         case EVENT_PROGRAM_ENV:      // (capset, strvec)
+        case EVENT_THREAD_LABEL:     // (thread, str)
             eventTypes[t].size = 0xffff;
             break;
 
@@ -791,6 +793,31 @@ void postEventStartup(EventCapNo n_caps)
     RELEASE_LOCK(&eventBufMutex);
 }
 
+void postThreadLabel(Capability    *cap,
+                     EventThreadID  id,
+                     char          *label)
+{
+    EventsBuf *eb;
+    int strsize = strlen(label);
+    int size = strsize + sizeof(EventCapsetID);
+
+    eb = &capEventBuf[cap->no];
+
+    if (!hasRoomForVariableEvent(eb, size)){
+        printAndClearEventBuf(eb);
+
+        if (!hasRoomForVariableEvent(eb, size)){
+            // Event size exceeds buffer size, bail out:
+            return;
+        }
+    }
+
+    postEventHeader(eb, EVENT_THREAD_LABEL);
+    postPayloadSize(eb, size);
+    postThreadID(eb, id);
+    postBuf(eb, (StgWord8*) label, strsize);
+}
+
 void closeBlockMarker (EventsBuf *ebuf)
 {
     StgInt8* save_pos;
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index d7368c30bf..667f34867d 100644
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -83,6 +83,13 @@ void postSparkCountersEvent (Capability *cap,
                              SparkCounters counters,
                              StgWord remaining);
 
+/*
+ * Post an event to annotate a thread with a label
+ */
+void postThreadLabel(Capability    *cap,
+                     EventThreadID  id,
+                     char          *label);
+
 #else /* !TRACING */
 
 INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
@@ -105,6 +112,12 @@ INLINE_HEADER void postCapMsg (Capability *cap STG_UNUSED,
                                va_list ap STG_UNUSED)
 { /* nothing */ }
 
+
+INLINE_HEADER void postThreadLabel(Capability    *cap   STG_UNUSED,
+                                   EventThreadID  id    STG_UNUSED,
+                                   char          *label STG_UNUSED)
+{ /* nothing */ }
+                                   
 #endif
 
 #include "EndPrivate.h"