diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2020-12-08 15:44:35 +0000 |
---|---|---|
committer | Matthew Pickering <matthewtpickering@gmail.com> | 2020-12-09 08:02:29 +0000 |
commit | 1146e18701f07311ef267633699610f853d39cd6 (patch) | |
tree | f3a5433ba1093c686438182f6adb01b456545950 | |
parent | 8fac4b9333ef3607e75b4520d847054316cb8c2d (diff) | |
download | haskell-wip/generic-block-traversal.tar.gz |
rts: Add generic block traversal function, listAllBlockswip/generic-block-traversal
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.h | 3 | ||||
-rw-r--r-- | rts/sm/Storage.c | 36 |
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 b9ae97af4c..c7d448d729 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] ~~~~~~~~~~~~~~~~~~~~~ |