Add (system finalizers)

This will replace an internal interface in (system foreign-objects).

* module/system/finalizers.scm: New file.
* am/bootstrap.am (SOURCES): Add new file.
* libguile/foreign-object.h:
* libguile/foreign-object.c (invoke_finalizer):
(sys_add_finalizer_x):
(scm_init_foreign_object):
(scm_register_foreign_object): Remove.
* libguile/init.c (scm_i_init_guile): Register finalizers instead of
foreign-object.
* module/system/foreign-object.scm (allocate-instance): Use finalizers
module.
* libguile/finalizers.c (invoke_finalizer):
(scm_sys_add_finalizer): New helper.

libguile/Makefile.am

@@ -281,6 +281,7 @@ DOT_X_FILES =					\
 	fdes-finalizers.x			\
 	feature.x				\
 	filesys.x				\
+	finalizers.x				\
 	fluids.x				\
 	foreign.x				\
 	fports.x				\

libguile/finalizers.c

@@ -32,12 +32,16 @@
 #include <unistd.h>
 
 #include "async.h"
+#include "atomics-internal.h"
 #include "bdw-gc.h"
+#include "eval.h"
+#include "extensions.h"
 #include "gc.h"
 #include "gsubr.h"
 #include "init.h"
+#include "numbers.h"
 #include "threads.h"
-#include "atomics-internal.h"
+#include "version.h"
 
 #include "finalizers.h"
 
@@ -53,6 +57,13 @@ static SCM run_finalizers_subr;
 
 
 
+enum finalizer_priority
+  {
+    FINALIZER_PRIORITY_GUARDIAN,
+    FINALIZER_PRIORITY_DEFAULT
+  };
+
+
 void
 scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
 {
@@ -139,6 +150,29 @@ scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
   shuffle_resuscitators_to_front (chained_data);
 }
 
+static void
+invoke_finalizer (void *obj, void *data)
+{
+  scm_call_1 (PTR2SCM (data), PTR2SCM (obj));
+}
+
+SCM_DEFINE_STATIC(scm_sys_add_finalizer, "%add-finalizer!", 3, 0, 0,
+                  (SCM obj, SCM proc, SCM priority),
+                  "Add a finalizer @var{proc} to object @var{obj}, with "
+                  "priority @var{priority}.  Return the finalizer object.")
+#define FUNC_NAME s_scm_sys_add_finalizer
+{
+  SCM_MAKE_VALIDATE (1, obj, HEAP_OBJECT_P);
+  SCM_VALIDATE_PROC (2, proc);
+  size_t c_priority = scm_to_unsigned_integer (priority,
+                                               FINALIZER_PRIORITY_GUARDIAN,
+                                               FINALIZER_PRIORITY_DEFAULT);
+
+  (void) c_priority;
+  scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (proc));
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
 
 
 
@@ -447,6 +481,17 @@ scm_run_finalizers (void)
 
 
 
+static void scm_init_finalizers_module (void);
+
+void
+scm_register_finalizers (void)
+{
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_finalizers_module",
+                            (scm_t_extension_init_func)scm_init_finalizers_module,
+                            NULL);
+}
+
 void
 scm_init_finalizers (void)
 {
@@ -459,6 +504,14 @@ scm_init_finalizers (void)
     GC_set_finalizer_notifier (queue_finalizer_async);
 }
 
+static void
+scm_init_finalizers_module (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "finalizers.x"
+#endif
+}
+
 void
 scm_init_finalizer_thread (void)
 {

libguile/finalizers.h

@@ -48,6 +48,7 @@ SCM_INTERNAL int scm_i_is_finalizer_thread (struct scm_thread *thread);
 SCM_API int scm_set_automatic_finalization_enabled (int enabled_p);
 SCM_API int scm_run_finalizers (void);
 
+SCM_INTERNAL void scm_register_finalizers (void);
 SCM_INTERNAL void scm_init_finalizers (void);
 SCM_INTERNAL void scm_init_finalizer_thread (void);
 

libguile/foreign-object.c

@@ -1,4 +1,4 @@
-/* Copyright 2014,2017-2018
+/* Copyright 2014,2017-2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -25,10 +25,8 @@
 #endif
 
 #include "eval.h"
-#include "extensions.h"
 #include "finalizers.h"
 #include "goops.h"
-#include "gsubr.h"
 #include "list.h"
 #include "modules.h"
 #include "numbers.h"
@@ -196,37 +194,3 @@ scm_foreign_object_set_x (SCM obj, size_t n, void *val)
   scm_t_bits bits = (scm_t_bits) val;
   scm_foreign_object_unsigned_set_x (obj, n, bits);
 }
-  
-static void
-invoke_finalizer (void *obj, void *data)
-{
-  scm_call_1 (PTR2SCM (data), PTR2SCM (obj));
-}
-
-static SCM
-sys_add_finalizer_x (SCM obj, SCM finalizer)
-#define FUNC_NAME "%add-finalizer!"
-{
-  SCM_VALIDATE_PROC (SCM_ARG2, finalizer);
-
-  scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (finalizer));
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-static void
-scm_init_foreign_object (void)
-{
-  scm_c_define_gsubr ("%add-finalizer!", 2, 0, 0,
-                      (scm_t_subr) sys_add_finalizer_x);
-}
-
-void
-scm_register_foreign_object (void)
-{
-  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
-                            "scm_init_foreign_object",
-                            (scm_t_extension_init_func)scm_init_foreign_object,
-                            NULL);
-}

libguile/foreign-object.h

@@ -1,7 +1,7 @@
 #ifndef SCM_FOREIGN_OBJECT_H
 #define SCM_FOREIGN_OBJECT_H
 
-/* Copyright 2014,2018
+/* Copyright 2014,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -56,7 +56,5 @@ SCM_API scm_t_signed_bits scm_foreign_object_signed_ref (SCM obj, size_t n);
 SCM_API void scm_foreign_object_signed_set_x (SCM obj, size_t n,
                                               scm_t_signed_bits val);
 
-SCM_INTERNAL void scm_register_foreign_object (void);
-
 
 #endif  /* SCM_FOREIGN_OBJECT_H */

libguile/init.c

@@ -370,8 +370,8 @@ scm_i_init_guile (struct gc_stack_addr base)
   scm_register_atomic ();
   scm_register_custom_ports ();
   scm_register_fdes_finalizers ();
+  scm_register_finalizers ();
   scm_register_foreign ();
-  scm_register_foreign_object ();
   scm_register_srfi_60 ();
   scm_register_poll ();