Implement finalizers for module functions (Bug#30373)

* src/module-env-28.h: Add new module environment functions to
module environment for Emacs 28.

* src/emacs-module.h.in: Document that 'emacs_finalizer' also works
for function finalizers.

* src/emacs-module.c (CHECK_MODULE_FUNCTION): New function.
(struct Lisp_Module_Function): Add finalizer data member.
(module_make_function): Initialize finalizer.
(module_get_function_finalizer)
(module_set_function_finalizer): New module environment functions.
(module_finalize_function): New function.
(initialize_environment): Initialize new environment functions.

* src/alloc.c (cleanup_vector): Call potential module function
finalizer during garbage collection.

* test/data/emacs-module/mod-test.c (signal_error): New helper
function.
(memory_full): Use it.
(finalizer): New example function finalizer.
(Fmod_test_make_function_with_finalizer)
(Fmod_test_function_finalizer_calls): New test module functions.
(emacs_module_init): Define them.

* test/src/emacs-module-tests.el (module/function-finalizer): New unit
test.

* doc/lispref/internals.texi (Module Functions): Document new
functionality.
(Module Misc): Move description of 'emacs_finalizer' type to 'Module
Functions' node, and add a reference to it.

* etc/NEWS: Mention new functionality.

5 files changed, 53 insertions, 2 deletions

diff --git a/src/alloc.c b/src/alloc.c
index dbe37f44d7c..f59f8cbde9a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3027,6 +3027,12 @@ cleanup_vector (struct Lisp_Vector *vector)
       if (uptr->finalizer)
         uptr->finalizer (uptr->p);
     }
+  else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
+    {
+      ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
+        = (struct Lisp_Module_Function *) vector;
+      module_finalize_function (function);
+    }
 }
 
 /* Reclaim space used by unmarked vectors.  */
diff --git a/src/emacs-module.c b/src/emacs-module.c
index bbb0e3dadd9..3855a33f254 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -327,6 +327,12 @@ static bool module_assertions = false;
   MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
 
 static void
+CHECK_MODULE_FUNCTION (Lisp_Object obj)
+{
+  CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj);
+}
+
+static void
 CHECK_USER_PTR (Lisp_Object obj)
 {
   CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
@@ -478,6 +484,7 @@ struct Lisp_Module_Function
   ptrdiff_t min_arity, max_arity;
   emacs_function subr;
   void *data;
+  emacs_finalizer finalizer;
 } GCALIGNED_STRUCT;
 
 static struct Lisp_Module_Function *
@@ -511,6 +518,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
   function->max_arity = max_arity;
   function->subr = func;
   function->data = data;
+  function->finalizer = NULL;
 
   if (docstring)
     function->documentation = build_string_from_utf8 (docstring);
@@ -522,6 +530,32 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
   return lisp_to_value (env, result);
 }
 
+static emacs_finalizer
+module_get_function_finalizer (emacs_env *env, emacs_value arg)
+{
+  MODULE_FUNCTION_BEGIN (NULL);
+  Lisp_Object lisp = value_to_lisp (arg);
+  CHECK_MODULE_FUNCTION (lisp);
+  return XMODULE_FUNCTION (lisp)->finalizer;
+}
+
+static void
+module_set_function_finalizer (emacs_env *env, emacs_value arg,
+                               emacs_finalizer fin)
+{
+  MODULE_FUNCTION_BEGIN ();
+  Lisp_Object lisp = value_to_lisp (arg);
+  CHECK_MODULE_FUNCTION (lisp);
+  XMODULE_FUNCTION (lisp)->finalizer = fin;
+}
+
+void
+module_finalize_function (const struct Lisp_Module_Function *func)
+{
+  if (func->finalizer != NULL)
+    func->finalizer (func->data);
+}
+
 static emacs_value
 module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
                 emacs_value *args)
@@ -1329,6 +1363,8 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
   env->make_time = module_make_time;
   env->extract_big_integer = module_extract_big_integer;
   env->make_big_integer = module_make_big_integer;
+  env->get_function_finalizer = module_get_function_finalizer;
+  env->set_function_finalizer = module_set_function_finalizer;
   Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
   return env;
 }
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 7065f13f2b1..b5ddd7d5fd8 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -90,8 +90,8 @@ typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs,
                                        void *data)
   EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL (1);
 
-/* Function prototype for module user-pointer finalizers.  These must
-   not throw C++ exceptions.  */
+/* Function prototype for module user-pointer and function finalizers.
+   These must not throw C++ exceptions.  */
 typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT;
 
 /* Possible Emacs function call outcomes.  */
diff --git a/src/lisp.h b/src/lisp.h
index 356692d53a1..36bb79d67e1 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4244,6 +4244,7 @@ extern Lisp_Object module_function_documentation
   (struct Lisp_Module_Function const *);
 extern module_funcptr module_function_address
   (struct Lisp_Module_Function const *);
+extern void module_finalize_function (const struct Lisp_Module_Function *);
 extern void mark_modules (void);
 extern void init_module_assertions (bool);
 extern void syms_of_module (void);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index dec8704edde..a2479a8f744 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -1,3 +1,11 @@
   /* Add module environment functions newly added in Emacs 28 here.
      Before Emacs 28 is released, remove this comment and start
      module-env-29.h on the master branch.  */
+
+  void (*(*EMACS_ATTRIBUTE_NONNULL (1)
+            get_function_finalizer) (emacs_env *env,
+                                     emacs_value arg)) (void *) EMACS_NOEXCEPT;
+
+  void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
+                                  void (*fin) (void *) EMACS_NOEXCEPT)
+    EMACS_ATTRIBUTE_NONNULL (1);