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

@@ -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;
+  struct scm_gc_event_listener data = get_gc_event_listener_data ();
-  GC_word heap_size, free_bytes, unmapped_bytes, bytes_since_gc, total_bytes;
+  double scale_usecs = scm_c_time_units_per_second / 1e6;
-  size_t gc_times;
 
-  GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
+  uint64_t gc_time_taken = data.stats.cpu_collector_usec * scale_usecs;
-                          &bytes_since_gc, &total_bytes);
+  size_t heap_size = data.stats.heap_size;
-  gc_times = GC_get_gc_no ();
+  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;
 
-  answer =
+  return scm_list_n
-    scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
+    (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_size, scm_from_size_t (heap_size)),
-		scm_cons (sym_heap_free_size, scm_from_size_t (free_bytes)),
+     scm_cons (sym_heap_free_size, scm_from_ssize_t (free_bytes)),
-		scm_cons (sym_heap_total_allocated,
+     scm_cons (sym_heap_total_allocated, scm_from_uint64 (total_bytes)),
-			  scm_from_size_t (total_bytes)),
+     scm_cons (sym_heap_allocated_since_gc, scm_from_uint64 (bytes_since_gc)),
-                scm_cons (sym_heap_allocated_since_gc,
+     scm_cons (sym_protected_objects, scm_from_ulong (protected_obj_count)),
-			  scm_from_size_t (bytes_since_gc)),
+     scm_cons (sym_times, scm_from_size_t (gc_times)),
-		scm_cons (sym_protected_objects,
+     SCM_UNDEFINED);
-			  scm_from_ulong (protected_obj_count)),
-		scm_cons (sym_times, scm_from_size_t (gc_times)),
-		SCM_UNDEFINED);
-
-  return answer;
 }
 #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)) {
+                SCM_GC_EVENT_LISTENER, &the_gc_event_listener))
-    fprintf (stderr, "Failed to initialize GC\n");
+    {
-    abort ();
+      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;
 
@@ -594,6 +705,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"
 }