summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2020-12-08 15:44:35 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-18 13:46:56 -0500
commit4dc2bcca2e0576512ad55e20651eb9e18e2a0da4 (patch)
tree34a5d771759f83372cdde1a7da9a8aa16023f47f
parent763d28551de32377a1dca8bdde02979e3686f400 (diff)
downloadhaskell-4dc2bcca2e0576512ad55e20651eb9e18e2a0da4.tar.gz
rts: Add generic block traversal function, listAllBlocks
This function is exposed in the RtsAPI.h so that external users have a blessed way to traverse all the different `bdescr`s which are known by the RTS. The main motivation is to use this function in ghc-debug but avoid having to expose the internal structure of a Capability in the API.
-rw-r--r--includes/rts/storage/GC.h3
-rw-r--r--rts/sm/Storage.c36
2 files changed, 39 insertions, 0 deletions
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index 6bc7157bd6..6acfd10cea 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -163,6 +163,9 @@ extern generation * generations;
extern generation * g0;
extern generation * oldest_gen;
+typedef void(*ListBlocksCb)(void *user, bdescr *);
+void listAllBlocks(ListBlocksCb cb, void *user);
+
/* -----------------------------------------------------------------------------
Generic allocation
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 41abbfc81c..2bab2d6432 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -321,6 +321,42 @@ freeStorage (bool free_heap)
freeGcThreads();
}
+static void
+listGenBlocks (ListBlocksCb cb, void *user, generation* gen)
+{
+ cb(user, gen->blocks);
+ cb(user, gen->large_objects);
+ cb(user, gen->compact_objects);
+ cb(user, gen->compact_blocks_in_import);
+}
+
+// Traverse all the different places that the rts stores blocks
+// and call a callback on each of them.
+void listAllBlocks (ListBlocksCb cb, void *user)
+{
+ uint32_t g, i;
+ for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+ for (i = 0; i < n_capabilities; i++) {
+ cb(user, capabilities[i]->mut_lists[g]);
+ cb(user, gc_threads[i]->gens[g].part_list);
+ cb(user, gc_threads[i]->gens[g].scavd_list);
+ cb(user, gc_threads[i]->gens[g].todo_bd);
+ }
+ listGenBlocks(cb, user, &generations[g]);
+ }
+
+ for (i = 0; i < n_nurseries; i++) {
+ cb(user, nurseries[i].blocks);
+ }
+ for (i = 0; i < n_capabilities; i++) {
+ if (capabilities[i]->pinned_object_block != NULL) {
+ cb(user, capabilities[i]->pinned_object_block);
+ }
+ cb(user, capabilities[i]->pinned_object_blocks);
+ }
+}
+
+
/* -----------------------------------------------------------------------------
Note [CAF management]
~~~~~~~~~~~~~~~~~~~~~