wingo pushed a commit to branch wip-whippet
in repository guile.
commit 9b7f7f7554af58296dc88cfaa8d74dd0d8933254
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Apr 17 14:37:39 2025 +0200
Switch statistics collection, GC hooks to use Whippet API
* libguile/gc.c: Define an event listener that collects basic
statistics, runs C hooks, and arranges to run the Scheme hook if it is
nonempty.
(scm_gc_stats): Fetch statistics from the gathered event data.
(scm_gc_dump): Use scm_basic_stats_print.
(scm_storage_prehistory): Fix indentation.
(scm_init_gc_protect_object): Remove dead code.
(queue_after_gc_hook): Not really needed, as we have an after-GC C event
to run the C hooks. Scheme hook activation is inlined into the event
listener.
(start_gc_timer, accumulate_gc_timer): No need any more.
(scm_init_gc): Simplify hook registration.
---
libguile/gc.c | 394 +++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 255 insertions(+), 139 deletions(-)
diff --git a/libguile/gc.c b/libguile/gc.c
index e10ef54f0..33cd09399 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -67,6 +67,24 @@
#include <gc/gc_mark.h>
+
+
+struct scm_gc_event_listener {
+ struct gc_basic_stats stats;
+ uint64_t last_allocation_counter;
+};
+
+struct scm_gc_event_listener_mutator {
+ struct scm_gc_event_listener *scm_listener;
+ void *stats;
+};
+
+static struct gc_heap *the_gc_heap;
+static struct scm_gc_event_listener the_gc_event_listener;
+
+
+
+
/* Size in bytes of the initial heap. This should be about the size of
result of 'guile -c "(display (assq-ref (gc-stats)
'heap-total-allocated))"'. */
@@ -87,6 +105,190 @@ int scm_debug_cells_gc_interval = 0;
garbage collection. */
static SCM scm_protects;
+/* Hooks. */
+scm_t_c_hook scm_before_gc_c_hook;
+scm_t_c_hook scm_before_mark_c_hook;
+scm_t_c_hook scm_before_sweep_c_hook;
+scm_t_c_hook scm_after_sweep_c_hook;
+scm_t_c_hook scm_after_gc_c_hook;
+
+SCM scm_after_gc_hook;
+
+static SCM after_gc_async_cell;
+
+
+
+
+static void
+scm_gc_event_listener_init (void *data, size_t heap_size)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_init (&scm_listener->stats, heap_size);
+}
+
+static void
+scm_gc_event_listener_requesting_stop (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_requesting_stop (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_waiting_for_stop (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_waiting_for_stop (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_mutators_stopped (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_mutators_stopped (&scm_listener->stats);
+ scm_c_hook_run (&scm_before_gc_c_hook, NULL);
+ scm_listener->last_allocation_counter = gc_allocation_counter (the_gc_heap);
+}
+
+static inline void
+scm_gc_event_listener_prepare_gc (void *data, enum gc_collection_kind kind)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_prepare_gc (&scm_listener->stats, kind);
+}
+
+static inline void
+scm_gc_event_listener_roots_traced (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_roots_traced (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_heap_traced (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_heap_traced (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_ephemerons_traced (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_ephemerons_traced (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_finalizers_traced (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_finalizers_traced (&scm_listener->stats);
+}
+
+static inline void
+scm_gc_event_listener_restarting_mutators (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_restarting_mutators (&scm_listener->stats);
+
+ /* Run any C hooks. The mutator is not yet let go, so we can't
+ allocate here. */
+ scm_c_hook_run (&scm_after_gc_c_hook, NULL);
+
+ /* If there are Scheme hooks and we have a current Guile thread,
+ enqueue those to be run on the current thread. */
+ scm_thread *t = SCM_I_CURRENT_THREAD;
+ if (t && scm_is_false (SCM_CDR (after_gc_async_cell)) &&
+ scm_is_false (scm_hook_empty_p (scm_after_gc_hook)))
+ {
+ SCM_SETCDR (after_gc_async_cell, t->pending_asyncs);
+ t->pending_asyncs = after_gc_async_cell;
+ }
+}
+
+static inline void*
+scm_gc_event_listener_mutator_added (void *data)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ struct scm_gc_event_listener_mutator *mutator = malloc (sizeof(*mutator));
+ if (!mutator) abort();
+ mutator->scm_listener = scm_listener;
+ mutator->stats = gc_basic_stats_mutator_added (&scm_listener->stats);
+ return mutator;
+}
+
+static inline void
+scm_gc_event_listener_mutator_cause_gc (void *mutator_data)
+{
+ struct scm_gc_event_listener_mutator *mutator = mutator_data;
+ gc_basic_stats_mutator_cause_gc (mutator->stats);
+}
+
+static inline void
+scm_gc_event_listener_mutator_stopping (void *mutator_data)
+{
+ struct scm_gc_event_listener_mutator *mutator = mutator_data;
+ gc_basic_stats_mutator_stopping (mutator->stats);
+}
+
+static inline void
+scm_gc_event_listener_mutator_stopped (void *mutator_data)
+{
+ struct scm_gc_event_listener_mutator *mutator = mutator_data;
+ gc_basic_stats_mutator_stopped (mutator->stats);
+}
+
+static inline void
+scm_gc_event_listener_mutator_restarted (void *mutator_data)
+{
+ struct scm_gc_event_listener_mutator *mutator = mutator_data;
+ gc_basic_stats_mutator_restarted (mutator->stats);
+}
+
+static inline void
+scm_gc_event_listener_mutator_removed (void *mutator_data)
+{
+ struct scm_gc_event_listener_mutator *mutator = mutator_data;
+ gc_basic_stats_mutator_removed (mutator->stats);
+ free(mutator);
+}
+
+static inline void
+scm_gc_event_listener_heap_resized (void *data, size_t size)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_heap_resized (&scm_listener->stats, size);
+}
+
+static inline void
+scm_gc_event_listener_live_data_size (void *data, size_t size)
+{
+ struct scm_gc_event_listener *scm_listener = data;
+ gc_basic_stats_live_data_size (&scm_listener->stats, size);
+}
+
+#define SCM_GC_EVENT_LISTENER \
+ ((struct gc_event_listener) { \
+ scm_gc_event_listener_init, \
+ scm_gc_event_listener_requesting_stop, \
+ scm_gc_event_listener_waiting_for_stop, \
+ scm_gc_event_listener_mutators_stopped, \
+ scm_gc_event_listener_prepare_gc, \
+ scm_gc_event_listener_roots_traced, \
+ scm_gc_event_listener_heap_traced, \
+ scm_gc_event_listener_ephemerons_traced, \
+ scm_gc_event_listener_finalizers_traced, \
+ scm_gc_event_listener_restarting_mutators, \
+ scm_gc_event_listener_mutator_added, \
+ scm_gc_event_listener_mutator_cause_gc, \
+ scm_gc_event_listener_mutator_stopping, \
+ scm_gc_event_listener_mutator_stopped, \
+ scm_gc_event_listener_mutator_restarted, \
+ scm_gc_event_listener_mutator_removed, \
+ scm_gc_event_listener_heap_resized, \
+ scm_gc_event_listener_live_data_size, \
+ })
+
+
@@ -121,33 +323,9 @@ scm_gc_after_nonlocal_exit (void)
}
-
-
-/* Hooks. */
-scm_t_c_hook scm_before_gc_c_hook;
-scm_t_c_hook scm_before_mark_c_hook;
-scm_t_c_hook scm_before_sweep_c_hook;
-scm_t_c_hook scm_after_sweep_c_hook;
-scm_t_c_hook scm_after_gc_c_hook;
-
-
-static void
-run_before_gc_c_hook (void)
-{
- if (!SCM_I_CURRENT_THREAD)
- /* GC while a thread is spinning up; punt. */
- return;
-
- scm_c_hook_run (&scm_before_gc_c_hook, NULL);
-}
-
-
/* GC Statistics Keeping
*/
unsigned long scm_gc_ports_collected = 0;
-static long gc_time_taken = 0;
-static long gc_start_time = 0;
-
static unsigned long protected_obj_count = 0;
@@ -160,6 +338,19 @@ SCM_SYMBOL (sym_protected_objects, "protected-objects");
SCM_SYMBOL (sym_times, "gc-times");
+static struct scm_gc_event_listener
+get_gc_event_listener_data (void)
+{
+ struct scm_gc_event_listener data;
+ do
+ {
+ memcpy (&data, &the_gc_event_listener, sizeof data);
+ atomic_thread_fence (memory_order_seq_cst);
+ }
+ while (memcmp (&data, &the_gc_event_listener, sizeof data));
+ return data;
+}
+
/* {Scheme Interface to GC}
*/
extern int scm_gc_malloc_yield_percentage;
@@ -169,28 +360,29 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
"use of storage.\n")
#define FUNC_NAME s_scm_gc_stats
{
- SCM answer;
- GC_word heap_size, free_bytes, unmapped_bytes, bytes_since_gc, total_bytes;
- size_t gc_times;
-
- GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
- &bytes_since_gc, &total_bytes);
- gc_times = GC_get_gc_no ();
-
- answer =
- scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
- scm_cons (sym_heap_size, scm_from_size_t (heap_size)),
- scm_cons (sym_heap_free_size, scm_from_size_t (free_bytes)),
- scm_cons (sym_heap_total_allocated,
- scm_from_size_t (total_bytes)),
- scm_cons (sym_heap_allocated_since_gc,
- scm_from_size_t (bytes_since_gc)),
- scm_cons (sym_protected_objects,
- scm_from_ulong (protected_obj_count)),
- scm_cons (sym_times, scm_from_size_t (gc_times)),
- SCM_UNDEFINED);
-
- return answer;
+ struct scm_gc_event_listener data = get_gc_event_listener_data ();
+ double scale_usecs = scm_c_time_units_per_second / 1e6;
+
+ uint64_t gc_time_taken = data.stats.cpu_collector_usec * scale_usecs;
+ size_t heap_size = data.stats.heap_size;
+ uint64_t total_bytes = gc_allocation_counter (the_gc_heap);
+ uint64_t bytes_since_gc = total_bytes - data.last_allocation_counter;
+ ssize_t free_bytes = heap_size - data.stats.live_data_size;
+ free_bytes -= bytes_since_gc;
+ if (free_bytes < 0)
+ free_bytes = 0;
+ uint64_t gc_times =
+ data.stats.major_collection_count + data.stats.minor_collection_count;
+
+ return scm_list_n
+ (scm_cons (sym_gc_time_taken, scm_from_uint64 (gc_time_taken)),
+ scm_cons (sym_heap_size, scm_from_size_t (heap_size)),
+ scm_cons (sym_heap_free_size, scm_from_ssize_t (free_bytes)),
+ scm_cons (sym_heap_total_allocated, scm_from_uint64 (total_bytes)),
+ scm_cons (sym_heap_allocated_since_gc, scm_from_uint64 (bytes_since_gc)),
+ scm_cons (sym_protected_objects, scm_from_ulong (protected_obj_count)),
+ scm_cons (sym_times, scm_from_size_t (gc_times)),
+ SCM_UNDEFINED);
}
#undef FUNC_NAME
@@ -201,7 +393,8 @@ SCM_DEFINE (scm_gc_dump, "gc-dump", 0, 0, 0,
"structures and memory usage to the standard output.")
#define FUNC_NAME s_scm_gc_dump
{
- GC_dump ();
+ struct scm_gc_event_listener data = get_gc_event_listener_data ();
+ gc_basic_stats_print (&data.stats, stdout);
return SCM_UNSPECIFIED;
}
@@ -445,9 +638,6 @@ scm_gc_unregister_roots (SCM *b, unsigned long n)
-static struct gc_heap *the_gc_heap;
-static struct gc_basic_stats the_gc_stats;
-
void
scm_storage_prehistory (void)
{
@@ -468,10 +658,11 @@ scm_storage_prehistory (void)
struct gc_mutator *mut;
if (!gc_init (options, NULL, &the_gc_heap, &mut,
- GC_BASIC_STATS, &the_gc_stats)) {
- fprintf (stderr, "Failed to initialize GC\n");
- abort ();
- }
+ SCM_GC_EVENT_LISTENER, &the_gc_event_listener))
+ {
+ fprintf (stderr, "Failed to initialize GC\n");
+ abort ();
+ }
/* Sanity check. */
if (!GC_is_visible (&scm_protects))
@@ -488,91 +679,11 @@ void
scm_init_gc_protect_object ()
{
scm_protects = scm_c_make_hash_table (31);
-
-#if 0
- /* We can't have a cleanup handler since we have no thread to run it
- in. */
-
-#ifdef HAVE_ATEXIT
- atexit (cleanup);
-#else
-#ifdef HAVE_ON_EXIT
- on_exit (cleanup, 0);
-#endif
-#endif
-
-#endif
-}
-
-
-
-SCM scm_after_gc_hook;
-
-static SCM after_gc_async_cell;
-
-/* The function after_gc_async_thunk causes the execution of the
- * after-gc-hook. It is run after the gc, as soon as the asynchronous
- * events are handled by the evaluator.
- */
-static SCM
-after_gc_async_thunk (void)
-{
- /* Fun, no? Hook-run *and* run-hook? */
- scm_c_hook_run (&scm_after_gc_c_hook, NULL);
- scm_c_run_hook (scm_after_gc_hook, SCM_EOL);
- return SCM_UNSPECIFIED;
}
-/* The function queue_after_gc_hook is run by the scm_before_gc_c_hook
- * at the end of the garbage collection. The only purpose of this
- * function is to mark the after_gc_async (which will eventually lead to
- * the execution of the after_gc_async_thunk).
- */
-static void *
-queue_after_gc_hook (void * hook_data SCM_UNUSED,
- void *fn_data SCM_UNUSED,
- void *data SCM_UNUSED)
-{
- scm_thread *t = SCM_I_CURRENT_THREAD;
-
- if (scm_is_false (SCM_CDR (after_gc_async_cell)))
- {
- SCM_SETCDR (after_gc_async_cell, t->pending_asyncs);
- t->pending_asyncs = after_gc_async_cell;
- }
-
- return NULL;
-}
-
-static void *
-start_gc_timer (void * hook_data SCM_UNUSED,
- void *fn_data SCM_UNUSED,
- void *data SCM_UNUSED)
-{
- if (!gc_start_time)
- gc_start_time = scm_c_get_internal_run_time ();
-
- return NULL;
-}
-
-static void *
-accumulate_gc_timer (void * hook_data SCM_UNUSED,
- void *fn_data SCM_UNUSED,
- void *data SCM_UNUSED)
-{
- if (gc_start_time)
- {
- long now = scm_c_get_internal_run_time ();
- gc_time_taken += now - gc_start_time;
- gc_start_time = 0;
- }
-
- return NULL;
-}
-
static size_t bytes_until_gc = DEFAULT_INITIAL_HEAP_SIZE;
static scm_i_pthread_mutex_t bytes_until_gc_lock =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
@@ -595,6 +706,16 @@ scm_gc_register_allocation (size_t size)
+
+static SCM
+after_gc_async_thunk (void)
+{
+ /* Fun, no? Hook-run *and* run-hook? */
+ scm_c_run_hook (scm_after_gc_hook, SCM_EOL);
+ return SCM_UNSPECIFIED;
+}
+
+
void
scm_init_gc ()
{
@@ -609,13 +730,8 @@ scm_init_gc ()
after_gc_async_thunk),
SCM_BOOL_F);
- scm_c_hook_add (&scm_before_gc_c_hook, queue_after_gc_hook, NULL, 0);
- scm_c_hook_add (&scm_before_gc_c_hook, start_gc_timer, NULL, 0);
- scm_c_hook_add (&scm_after_gc_c_hook, accumulate_gc_timer, NULL, 0);
-
GC_set_oom_fn (scm_oom_fn);
GC_set_warn_proc (scm_gc_warn_proc);
- GC_set_start_callback (run_before_gc_c_hook);
#include "gc.x"
}
