master 48ffef5: Implement finalizers for module functions (Bug#30373)

[Philipp Stephani]

branch: master
commit 48ffef5ef4b34799941a033591ea827d40025939
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    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.
---
 doc/lispref/internals.texi        | 55 +++++++++++++++++++++++++++++++++++----
 etc/NEWS                          |  5 ++++
 src/alloc.c                       |  6 +++++
 src/emacs-module.c                | 36 +++++++++++++++++++++++++
 src/emacs-module.h.in             |  4 +--
 src/lisp.h                        |  1 +
 src/module-env-28.h               |  8 ++++++
 test/data/emacs-module/mod-test.c | 49 ++++++++++++++++++++++++++++++++--
 test/src/emacs-module-tests.el    |  8 ++++++
 9 files changed, 163 insertions(+), 9 deletions(-)

diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index d95a3e4..c0b3fe5 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1447,6 +1447,54 @@ The Lisp package which goes with your module could then 
load the
 module using the @code{load} primitive (@pxref{Dynamic Modules}) when
 the package is loaded into Emacs.
 
+@anchor{Module Function Finalizers}
+If you want to run some code when a module function object (i.e., an
+object returned by @code{make_function}) is garbage-collected, you can
+install a @dfn{function finalizer}.  Function finalizers are available
+since Emacs 28.  For example, if you have passed some heap-allocated
+structure to the @var{data} argument of @code{make_function}, you can
+use the finalizer to deallocate the structure.  @xref{Basic
+Allocation,,,libc}, and @pxref{Freeing after Malloc,,,libc}.  The
+finalizer function has the following signature:
+
+@example
+void finalizer (void *@var{data})
+@end example
+
+Here, @var{data} receives the value passed to @var{data} when calling
+@code{make_function}.  Note that the finalizer can't interact with
+Emacs in any way.
+
+Directly after calling @code{make_function}, the newly-created
+function doesn't have a finalizer.  Use @code{set_function_finalizer}
+to add one, if desired.
+
+@deftypefun void emacs_finalizer (void *@var{ptr})
+The header @file{emacs-module.h} provides the type
+@code{emacs_finalizer} as a type alias for an Emacs finalizer
+function.
+@end deftypefun
+
+@deftypefun emacs_finalizer get_function_finalizer (emacs_env *@var{env}, 
emacs_value @var{arg})
+This function, which is available since Emacs 28, returns the function
+finalizer associated with the module function represented by
+@var{arg}.  @var{arg} must refer to a module function, that is, an
+object returned by @code{make_function}.  If no finalizer is
+associated with the function, @code{NULL} is returned.
+@end deftypefun
+
+@deftypefun void set_function_finalizer (emacs_env *@var{env}, emacs_value 
@var{arg}, emacs_finalizer @var{fin})
+This function, which is available since Emacs 28, sets the function
+finalizer associated with the module function represented by @var{arg}
+to @var{fin}.  @var{arg} must refer to a module function, that is, an
+object returned by @code{make_function}.  @var{fin} can either be
+@code{NULL} to clear @var{arg}'s function finalizer, or a pointer to a
+function to be called when the object represented by @var{arg} is
+garbage-collected.  At most one function finalizer can be set per
+function; if @var{arg} already has a finalizer, it is replaced by
+@var{fin}.
+@end deftypefun
+
 @node Module Values
 @subsection Conversion Between Lisp and Module Values
 @cindex module values, conversion
@@ -1865,11 +1913,8 @@ represented by @var{arg} to be @var{fin}.  If @var{fin} 
is a
 finalizer.
 @end deftypefn
 
-@deftypefun void emacs_finalizer (void *@var{ptr})
-The header @file{emacs-module.h} provides the type
-@code{emacs_finalizer} as a type alias for an Emacs finalizer
-function.
-@end deftypefun
+Note that the @code{emacs_finalizer} type works for both user pointer
+an module function finalizers.  @xref{Module Function Finalizers}.
 
 @node Module Misc
 @subsection Miscellaneous Convenience Functions for Modules
diff --git a/etc/NEWS b/etc/NEWS
index df12c7e..d6cabf8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -49,6 +49,11 @@ applies, and please also update docstrings as needed.
 'emacs_function' and 'emacs_finalizer' for module functions and
 finalizers, respectively.
 
+** Module functions can now install an optional finalizer that is
+called when the function object is garbage-collected.  Use
+'set_function_finalizer' to set the finalizer and
+'get_function_finalizer' to retrieve it.
+
 
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/src/alloc.c b/src/alloc.c
index dbe37f4..f59f8cb 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 bbb0e3d..3855a33 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 7065f13..b5ddd7d 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 356692d..36bb79d 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 dec8704..a2479a8 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);
diff --git a/test/data/emacs-module/mod-test.c 
b/test/data/emacs-module/mod-test.c
index 8dc9ff1..1a0a879 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -373,15 +373,20 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t 
nargs, emacs_value *args,
 }
 
 static void
-memory_full (emacs_env *env)
+signal_error (emacs_env *env, const char *message)
 {
-  const char *message = "Memory exhausted";
   emacs_value data = env->make_string (env, message, strlen (message));
   env->non_local_exit_signal (env, env->intern (env, "error"),
                               env->funcall (env, env->intern (env, "list"), 1,
                                             &data));
 }
 
+static void
+memory_full (emacs_env *env)
+{
+  signal_error (env, "Memory exhausted");
+}
+
 enum
 {
   max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX)
@@ -490,6 +495,42 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, 
emacs_value *args,
   return result;
 }
 
+static int function_data;
+static int finalizer_calls_with_correct_data;
+static int finalizer_calls_with_incorrect_data;
+
+static void
+finalizer (void *data)
+{
+  if (data == &function_data)
+    ++finalizer_calls_with_correct_data;
+  else
+    ++finalizer_calls_with_incorrect_data;
+}
+
+static emacs_value
+Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs,
+                                        emacs_value *args, void *data)
+{
+  emacs_value fun
+    = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data);
+  env->set_function_finalizer (env, fun, finalizer);
+  if (env->get_function_finalizer (env, fun) != finalizer)
+    signal_error (env, "Invalid finalizer");
+  return fun;
+}
+
+static emacs_value
+Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
+                                    emacs_value *args, void *data)
+{
+  emacs_value Flist = env->intern (env, "list");
+  emacs_value list_args[]
+    = {env->make_integer (env, finalizer_calls_with_correct_data),
+       env->make_integer (env, finalizer_calls_with_incorrect_data)};
+  return env->funcall (env, Flist, 2, list_args);
+}
+
 /* Lisp utilities for easier readability (simple wrappers).  */
 
 /* Provide FEATURE to Emacs.  */
@@ -566,6 +607,10 @@ emacs_module_init (struct emacs_runtime *ert)
   DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, 
NULL);
   DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL);
   DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL);
+  DEFUN ("mod-test-make-function-with-finalizer",
+         Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
+  DEFUN ("mod-test-function-finalizer-calls",
+         Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index a2cb3e9..4f5871b 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -402,4 +402,12 @@ See Bug#36226."
         (load so nil nil :nosuffix :must-suffix)
       (delete-file so))))
 
+(ert-deftest module/function-finalizer ()
+  (mod-test-make-function-with-finalizer)
+  (let* ((previous-calls (mod-test-function-finalizer-calls))
+         (expected-calls (copy-sequence previous-calls)))
+    (cl-incf (car expected-calls))
+    (garbage-collect)
+    (should (equal (mod-test-function-finalizer-calls) expected-calls))))
+
 ;;; emacs-module-tests.el ends here