summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam Sandberg Ericsson <adam@sandbergericsson.se>2020-05-03 18:47:20 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-12-20 20:45:55 -0500
commit35fa0786b6ded2420f0a07446c8e45bff9bb01e0 (patch)
tree6b2014ceee09be269379c28f3fa9110b6bd60eba
parent65721691ce9c4107d1cf84ad131bf167a9e42a7d (diff)
downloadhaskell-35fa0786b6ded2420f0a07446c8e45bff9bb01e0.tar.gz
rts: enable thread label table in all RTS flavours #17972
-rw-r--r--docs/users_guide/eventlog-formats.rst2
-rw-r--r--libraries/base/GHC/Conc/Sync.hs8
-rw-r--r--rts/PrimOps.cmm2
-rw-r--r--rts/RtsStartup.c4
-rw-r--r--rts/Schedule.c3
-rw-r--r--rts/ThreadLabels.c10
-rw-r--r--rts/ThreadLabels.h2
7 files changed, 9 insertions, 22 deletions
diff --git a/docs/users_guide/eventlog-formats.rst b/docs/users_guide/eventlog-formats.rst
index b687a5b48e..a1a78f8476 100644
--- a/docs/users_guide/eventlog-formats.rst
+++ b/docs/users_guide/eventlog-formats.rst
@@ -204,7 +204,7 @@ Thread and scheduling events
:field String: label
The indicated thread has been given a label (e.g. with
- :base-ref:`Control.Concurrent.setThreadLabel`).
+ :base-ref:`GHC.Conc.labelThread`).
.. _gc-events:
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index 5debee92d1..353b0ac3f2 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -480,10 +480,10 @@ yield :: IO ()
yield = IO $ \s ->
case (yield# s) of s1 -> (# s1, () #)
-{- | 'labelThread' stores a string as identifier for this thread if
-you built a RTS with debugging support. This identifier will be used in
-the debugging output to make distinction of different threads easier
-(otherwise you only have the thread state object\'s address in the heap).
+{- | 'labelThread' stores a string as identifier for this thread. This
+identifier will be used in the debugging output to make distinction of
+different threads easier (otherwise you only have the thread state object\'s
+address in the heap). It also emits an event to the RTS eventlog.
Other applications like the graphical Concurrent Haskell Debugger
(<http://www.informatik.uni-kiel.de/~fhu/chd/>) may choose to overload
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index a6b60ae1cc..7ee77c7216 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1058,9 +1058,7 @@ stg_yieldzh ()
stg_labelThreadzh ( gcptr threadid, W_ addr )
{
-#if defined(DEBUG) || defined(TRACING) || defined(DTRACE)
ccall labelThread(MyCapability() "ptr", threadid "ptr", addr "ptr");
-#endif
return ();
}
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 107a74dc5b..79c830f96d 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -362,10 +362,8 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
/* initialise file locking, if necessary */
initFileLocking();
-#if defined(DEBUG)
/* initialise thread label table (tso->char*) */
initThreadLabelTable();
-#endif
#if defined(PROFILING)
initProfiling();
@@ -544,10 +542,8 @@ hs_exit_(bool wait_foreign)
/* free the stable name table */
exitStableNameTable();
-#if defined(DEBUG)
/* free the thread label table */
freeThreadLabelTable();
-#endif
#if defined(PROFILING)
reportCCSProfiling();
diff --git a/rts/Schedule.c b/rts/Schedule.c
index a5bd11bf5e..8a07e97ba1 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1356,9 +1356,8 @@ scheduleHandleThreadFinished (Capability *cap, Task *task, StgTSO *t)
task->incall->rstat = Killed;
}
}
-#if defined(DEBUG)
+
removeThreadLabel((StgWord)task->incall->tso->id);
-#endif
// We no longer consider this thread and task to be bound to
// each other. The TSO lives on until it is GC'd, but the
diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c
index 7a06580efc..b982c7995c 100644
--- a/rts/ThreadLabels.c
+++ b/rts/ThreadLabels.c
@@ -18,8 +18,6 @@
#include <stdlib.h>
#include <string.h>
-#if defined(DEBUG)
-
#if defined(THREADED_RTS)
static Mutex threadLabels_mutex;
#endif /* THREADED_RTS */
@@ -90,23 +88,21 @@ removeThreadLabel(StgWord key)
RELEASE_LOCK(&threadLabels_mutex);
}
-#endif /* DEBUG */
-
void
labelThread(Capability *cap STG_UNUSED,
StgTSO *tso STG_UNUSED,
char *label STG_UNUSED)
{
-#if defined(DEBUG)
int len;
void *buf;
/* Caveat: Once set, you can only set the thread name to "" */
len = strlen(label)+1;
- buf = stgMallocBytes(len * sizeof(char), "Schedule.c:labelThread()");
+ buf = stgMallocBytes(len * sizeof(char), "ThreadLabels.c:labelThread()");
strncpy(buf,label,len);
+
/* Update will free the old memory for us */
updateThreadLabel(tso->id,buf);
-#endif
+
traceThreadLabel(cap, tso, label);
}
diff --git a/rts/ThreadLabels.h b/rts/ThreadLabels.h
index b70eaea4ea..0837cb53fd 100644
--- a/rts/ThreadLabels.h
+++ b/rts/ThreadLabels.h
@@ -11,12 +11,10 @@
#include "BeginPrivate.h"
-#if defined(DEBUG)
void initThreadLabelTable (void);
void freeThreadLabelTable (void);
void * lookupThreadLabel (StgWord key);
void removeThreadLabel (StgWord key);
-#endif
void labelThread (Capability *cap,
StgTSO *tso,
char *label);