Commit de7ec9dd authored by David Eichmann's avatar David Eichmann 🏋 Committed by Marge Bot

Add rts_listThreads and rts_listMiscRoots to RtsAPI.h

These are used to find the current roots of the garbage collector.
Co-authored-by: Sven Tennie's avatarSven Tennie's avatarSven Tennie <sven.tennie@gmail.com>
Co-authored-by: Matthew Pickering's avatarMatthew Pickering's avatarMatthew Pickering <matthewtpickering@gmail.com>
Co-authored-by: default avatardefault avatarBen Gamari <bgamari.foss@gmail.com>
parent 197d59fa
Pipeline #27479 canceled with stages
......@@ -17,8 +17,10 @@ extern "C" {
#include "HsFFI.h"
#include "rts/Time.h"
#include "rts/Types.h"
#include "rts/EventLogWriter.h"
/*
* Running the scheduler
*/
......@@ -566,6 +568,16 @@ void rts_resume (PauseToken *pauseToken);
// Returns true if the rts is paused. See rts_pause() and rts_resume().
bool rts_isPaused(void);
// List all live threads. The RTS must be paused and this must be called on the
// same thread that called rts_pause().
typedef void (*ListThreadsCb)(void *user, StgTSO *);
void rts_listThreads(ListThreadsCb cb, void *user);
// List all non-thread GC roots. The RTS must be paused and this must be called
// on the same thread that called rts_pause().
typedef void (*ListRootsCb)(void *user, StgClosure *);
void rts_listMiscRoots(ListRootsCb cb, void *user);
/*
* The RTS allocates some thread-local data when you make a call into
* Haskell using one of the rts_eval() functions. This data is not
......
......@@ -15,6 +15,7 @@
#include "Prelude.h"
#include "Schedule.h"
#include "Capability.h"
#include "StableName.h"
#include "StablePtr.h"
#include "Threads.h"
#include "Weak.h"
......@@ -809,6 +810,46 @@ static void assert_isPausedOnMyTask(const char *functionName)
}
}
// See RtsAPI.h
void rts_listThreads(ListThreadsCb cb, void *user)
{
assert_isPausedOnMyTask("rts_listThreads");
// The rts is paused and can only be resumed by the current thread. Hence it
// is safe to read global thread data.
for (uint32_t g=0; g < RtsFlags.GcFlags.generations; g++) {
StgTSO *tso = generations[g].threads;
while (tso != END_TSO_QUEUE) {
cb(user, tso);
tso = tso->global_link;
}
}
}
struct list_roots_ctx {
ListRootsCb cb;
void *user;
};
// This is an evac_fn.
static void list_roots_helper(void *user, StgClosure **p) {
struct list_roots_ctx *ctx = (struct list_roots_ctx *) user;
ctx->cb(ctx->user, *p);
}
// See RtsAPI.h
void rts_listMiscRoots (ListRootsCb cb, void *user)
{
assert_isPausedOnMyTask("rts_listMiscRoots");
struct list_roots_ctx ctx;
ctx.cb = cb;
ctx.user = user;
threadStableNameTable(&list_roots_helper, (void *)&ctx);
threadStablePtrTable(&list_roots_helper, (void *)&ctx);
}
#else
PauseToken GNU_ATTRIBUTE(__noreturn__)
......@@ -833,6 +874,18 @@ bool rts_isPaused()
"multithreaded RTS.");
return false;
}
// See RtsAPI.h
void rts_listThreads(ListThreadsCb cb STG_UNUSED, void *user STG_UNUSED)
{
errorBelch("Warning: rts_listThreads is only possible for multithreaded RTS.");
}
// See RtsAPI.h
void rts_listMiscRoots (ListRootsCb cb STG_UNUSED, void *user STG_UNUSED)
{
errorBelch("Warning: rts_listMiscRoots is only possible for multithreaded RTS.");
}
#endif
void rts_done (void)
......
......@@ -18,3 +18,8 @@ test('pause_and_use_rts_api',
, extra_files(['pause_resume.c','pause_resume.h'])
],
multi_compile_and_run, ['pause_and_use_rts_api', [('pause_resume.c','')], ''])
test('list_threads_and_misc_roots',
[ only_ways(['threaded1', 'threaded2'])
, extra_files(['list_threads_and_misc_roots_c.c','list_threads_and_misc_roots_c.h'])
],
multi_compile_and_run, ['list_threads_and_misc_roots', [('list_threads_and_misc_roots_c.c','')], ''])
\ No newline at end of file
foreign import ccall safe "list_threads_and_misc_roots_c.h checkGcRoots"
checkGcRoots :: IO ()
main :: IO ()
main = checkGcRoots
#include "list_threads_and_misc_roots_c.h"
static int tsoCount = 0;
static StgTSO** tsos;
static int miscRootsCount = 0;
static StgClosure** miscRoots;
void collectTSOsCallback(void *user, StgTSO* tso){
tsoCount++;
tsos = realloc(tsos, sizeof(StgTSO*) * tsoCount);
tsos[tsoCount - 1] = tso;
}
void collectMiscRootsCallback(void *user, StgClosure* closure){
miscRootsCount++;
miscRoots = realloc(miscRoots, sizeof(StgClosure*) * miscRootsCount);
miscRoots[miscRootsCount - 1] = closure;
}
void checkGcRoots(void)
{
PauseToken * token = rts_pause();
// Check TSO collection.
rts_listThreads(&collectTSOsCallback, NULL);
for (int i = 0; i < tsoCount; i++)
{
StgTSO *tso = UNTAG_CLOSURE(tsos[i]);
if (get_itbl(tso)->type != TSO)
{
fprintf(stderr, "tso returned a non-TSO type %zu at index %i\n",
tso->header.info->type,
i);
exit(1);
}
}
// Check misc GC roots collection.
rts_listMiscRoots(&collectMiscRootsCallback, NULL);
for (int i = 0; i < miscRootsCount; i++)
{
StgClosure *root = UNTAG_CLOSURE(miscRoots[i]);
if (get_itbl(root)->type == TSO)
{
fprintf(stderr, "rts_listThreads unexpectedly returned an TSO type at index %i (TSO=%zu)\n", i, TSO);
exit(1);
}
}
rts_resume(token);
}
#include "Rts.h"
#include "RtsAPI.h"
void checkGcRoots(void);
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment