Replace after-gc-hook with {add,remove}-after-gc-callback!

* libguile/gc.c:
(scm_gc_event_listener_restarting_mutators):
(after_gc_async_thunk):
(scm_init_gc): Instead of using a hook for after-gc callbacks, just use
a list of thunks.  Will allow us to move hooks to Scheme.
(add-after-gc-callback!, remove-after-gc-callback!): New functions.
* libguile/gc.h (scm_after_gc_hook): Remove.
* libguile/scmsigs.c (signal_delivery_thread): Update comment.
* module/statprof.scm (gcprof):
* test-suite/tests/gc.test ("gc"): Update to use new functions.

libguile/gc.c

@@ -40,13 +40,13 @@
 #include "gen-scmconfig.h"
 #include "gsubr.h"
 #include "hashtab.h"
-#include "hooks.h"
 #include "init.h"
 #include "list.h"
 #include "modules.h"
 #include "numbers.h"
 #include "pairs.h"
 #include "ports.h"
+#include "procs.h"
 #include "simpos.h"
 #include "smob.h"
 #include "stackchk.h"
@@ -106,8 +106,7 @@ 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_thunks = SCM_EOL;
-
 static SCM after_gc_async_cell;
 
 /* This counter is decremented at each off-heap allocation.  When it
@@ -195,9 +194,7 @@ scm_gc_event_listener_restarting_mutators (void *data)
   /* 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_initialized_p &&
+  if (t && !scm_is_null (after_gc_thunks))
-      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;
@@ -381,6 +378,32 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE_STATIC (scm_add_after_gc_callback_x, "add-after-gc-callback!",
+                   1, 0, 0, (SCM thunk),
+                   "Add @var{thunk} to the set of functions that will be "
+                   "called after GC, by the thread that caused GC.")
+#define FUNC_NAME s_scm_add_after_gc_callback_x
+{
+  SCM_VALIDATE_THUNK (1, thunk);
+  after_gc_thunks = scm_cons (thunk, after_gc_thunks);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE_STATIC (scm_remove_after_gc_callback_x, "remove-after-gc-callback!",
+                   1, 0, 0, (SCM thunk),
+                   "Remove @var{thunk} from the set of functions that will be "
+                   "called after GC.")
+#define FUNC_NAME s_scm_remove_after_gc_callback_x
+{
+  SCM_VALIDATE_THUNK (1, thunk);
+  after_gc_thunks = scm_delq1_x (thunk, after_gc_thunks);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_gc_dump, "gc-dump", 0, 0, 0,
 	    (void),
 	    "Dump information about the garbage collector's internal data "
@@ -672,8 +695,8 @@ scm_gc_register_allocation (size_t size)
 static SCM
 after_gc_async_thunk (void)
 {
-  /* Fun, no? Hook-run *and* run-hook?  */
+  for (SCM ls = after_gc_thunks; !scm_is_null (ls); ls = scm_cdr (ls))
-  scm_c_run_hook (scm_after_gc_hook, SCM_EOL);
+    scm_call_0 (scm_car (ls));
   return SCM_UNSPECIFIED;
 }
 
@@ -681,9 +704,6 @@ after_gc_async_thunk (void)
 void
 scm_init_gc ()
 {
-  scm_after_gc_hook = scm_make_hook (SCM_INUM0);
-  scm_c_define ("after-gc-hook", scm_after_gc_hook);
-
   /* When the async is to run, the cdr of the gc_async pair gets set to
      the asyncs queue of the current thread.  */
   after_gc_async_cell = scm_cons (scm_c_make_gsubr ("%after-gc-thunk", 0, 0, 0,

libguile/gc.h

@@ -88,8 +88,6 @@ typedef struct scm_t_cell
 
 SCM_API unsigned long scm_gc_ports_collected;
 
-SCM_API SCM scm_after_gc_hook;
-
 SCM_API scm_t_c_hook scm_before_gc_c_hook;
 SCM_API scm_t_c_hook scm_before_mark_c_hook;
 SCM_API scm_t_c_hook scm_before_sweep_c_hook;

libguile/scmsigs.c

@@ -174,8 +174,8 @@ signal_delivery_thread (void *data)
          block indefinitely waiting for a signal to arrive.  For example
          it can happen that the garbage collector is triggered while
          marking the signal handler for future execution.  Due to the
-         way the after-gc-hook is designed, without a call to
+         way the after-gc callback is designed, without a call to
-         scm_async_tick, the after-gc-hook will not be triggered. */
+         scm_async_tick, the after-gc callback will not be triggered. */
       scm_async_tick ();
 
       scm_without_guile (read_signal_pipe_data, &sigdata);

module/ice-9/sandbox.scm

@@ -139,7 +139,7 @@ the allocation limit."
       (lambda ()
         (dynamic-wind
           (lambda ()
-            (add-hook! after-gc-hook check-allocation))
+            (add-after-gc-callback! check-allocation))
           (lambda ()
             (call-with-stack-overflow-handler
              ;; The limit is in "words", which used to be 4 or 8 but now
@@ -148,7 +148,7 @@ the allocation limit."
              thunk
              (lambda () (abort-to-prompt tag))))
           (lambda ()
-            (remove-hook! after-gc-hook check-allocation))))
+            (remove-after-gc-callback! check-allocation))))
       (lambda (k)
         (limit-reached)))))
 

module/statprof.scm

@@ -1,7 +1,7 @@
 ;;;; (statprof) -- a statistical profiler for Guile
 ;;;; -*-scheme-*-
 ;;;;
-;;;; 	Copyright (C) 2009, 2010, 2011, 2013-2018, 2020  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2011, 2013-2018, 2020, 2025  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;;    Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
 ;;;; 
@@ -888,14 +888,14 @@ times."
           (set-profile-level! state 1)
           (set-last-start-time! state (get-internal-run-time))
           (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
-          (add-hook! after-gc-hook gc-callback))
+          (add-after-gc-callback! gc-callback))
         (lambda ()
           (let lp ((i loop))
             (unless (zero? i)
               (call-thunk thunk)
               (lp (1- i)))))
         (lambda ()
-          (remove-hook! after-gc-hook gc-callback)
+          (remove-after-gc-callback! gc-callback)
           (set-gc-time-taken! state
                               (- (assq-ref (gc-stats) 'gc-time-taken)
                                  (gc-time-taken state)))

test-suite/tests/gc.test

@@ -63,12 +63,12 @@
 
 (with-test-prefix "gc"
 
-  (pass-if "after-gc-hook gets called"
+  (pass-if "after-gc callback gets called"
     (let* ((foo #f)
 	   (thunk (lambda () (set! foo #t))))
-      (add-hook! after-gc-hook thunk)
+      (add-after-gc-callback! thunk)
       (gc)
-      (remove-hook! after-gc-hook thunk)
+      (remove-after-gc-callback! thunk)
       foo))
 
   (pass-if "Unused modules are removed"