Ian, Simon,
The following patch is attached.
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.
It should help us a bit with things like IO manager profiling.
I've validated it, but I've not pushed since I'm aware that we're in the
process of making the 7.4 branch. Ideally I'd like to include it in
7.4.x but it's not critical (I expect this to be my last eventlog patch
targeting the 7.4 branch).
--
Duncan Coutts, Haskell Consultant
Well-Typed LLP, http://www.well-typed.com/
>From b84c9fd7bc6402ca296f0970644383d05132dac1 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <[email protected]>
Date: Wed, 2 Nov 2011 12:02:09 +0000
Subject: [PATCH] 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.
---
includes/rts/EventLogFormat.h | 6 +++---
rts/PrimOps.cmm | 4 ++--
rts/RtsProbes.d | 1 +
rts/ThreadLabels.c | 15 +++++++++++----
rts/ThreadLabels.h | 4 +++-
rts/Trace.c | 18 ++++++++++++++++++
rts/Trace.h | 23 +++++++++++++++++++++++
rts/eventlog/EventLog.c | 27 +++++++++++++++++++++++++++
rts/eventlog/EventLog.h | 13 +++++++++++++
9 files changed, 101 insertions(+), 10 deletions(-)
diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 7773bae..0b276b1 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 bb4f73b..ed310a6 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 0400510..1c74619 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 6d2a5d6..8838042 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 254b91e..742e77a 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 a3aa266..1671bfe 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 a0c5e26..8dacb80 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 09e12a2..9547e7c 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 d7368c3..667f348 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"
--
1.7.3.4
_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc
