From b624c806746d6b375ade398a13695f5e2294b083 Mon Sep 17 00:00:00 2001 From: David Eichmann Date: Mon, 2 Nov 2020 13:53:28 +0000 Subject: 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 Co-authored-by: Matthew Pickering's avatarMatthew Pickering Co-authored-by: default avatarBen Gamari --- includes/RtsAPI.h | 12 +++++ rts/RtsAPI.c | 53 +++++++++++++++++++++ testsuite/tests/rts/pause-resume/all.T | 5 ++ .../pause-resume/list_threads_and_misc_roots.hs | 6 +++ .../pause-resume/list_threads_and_misc_roots_c.c | 54 ++++++++++++++++++++++ .../pause-resume/list_threads_and_misc_roots_c.h | 5 ++ 6 files changed, 135 insertions(+) create mode 100644 testsuite/tests/rts/pause-resume/list_threads_and_misc_roots.hs create mode 100644 testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.c create mode 100644 testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.h diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index 6c782e504a..36ab4d4b04 100644 --- a/includes/RtsAPI.h +++ b/includes/RtsAPI.h @@ -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 diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index bf58f53735..aaea838f72 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -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) diff --git a/testsuite/tests/rts/pause-resume/all.T b/testsuite/tests/rts/pause-resume/all.T index 3099a8f12c..88c6f6e483 100644 --- a/testsuite/tests/rts/pause-resume/all.T +++ b/testsuite/tests/rts/pause-resume/all.T @@ -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 diff --git a/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots.hs b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots.hs new file mode 100644 index 0000000000..1de3fa926b --- /dev/null +++ b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots.hs @@ -0,0 +1,6 @@ + +foreign import ccall safe "list_threads_and_misc_roots_c.h checkGcRoots" + checkGcRoots :: IO () + +main :: IO () +main = checkGcRoots diff --git a/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.c b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.c new file mode 100644 index 0000000000..634bab75e2 --- /dev/null +++ b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.c @@ -0,0 +1,54 @@ + +#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); +} diff --git a/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.h b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.h new file mode 100644 index 0000000000..408c3a79ca --- /dev/null +++ b/testsuite/tests/rts/pause-resume/list_threads_and_misc_roots_c.h @@ -0,0 +1,5 @@ + +#include "Rts.h" +#include "RtsAPI.h" + +void checkGcRoots(void); -- cgit v1.2.1