bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Philipp Stephani]

Since there were no objections, I've installed this patch (plus some
documentation) as commit 48ffef5ef4 into master.

Am Do., 26. Dez. 2019 um 01:05 Uhr schrieb Philipp Stephani
<p.stephani2@gmail.com>:
>
> * src/module-env-28.h: Add new module environment functions to
> module environment for Emacs 28.
>
> * 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.
> ---
>  src/alloc.c                       |  6 ++++
>  src/emacs-module.c                | 45 +++++++++++++++++++++++++---
>  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 +++++
>  6 files changed, 111 insertions(+), 6 deletions(-)
>
> diff --git a/src/alloc.c b/src/alloc.c
> index 6a17bedc75..94c1433124 100644
> --- a/src/alloc.c
> +++ b/src/alloc.c
> @@ -3023,6 +3023,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 ff1a05450c..9ec25d57af 100644
> --- a/src/emacs-module.c
> +++ b/src/emacs-module.c
> @@ -122,10 +122,11 @@ Copyright (C) 2015-2019 Free Software Foundation, Inc.
>  /* Function prototype for the module init function.  */
>  typedef int (*emacs_init_function) (struct emacs_runtime *);
>
> -/* Function prototype for module user-pointer finalizers.  These
> -   should not throw C++ exceptions, so emacs-module.h declares the
> -   corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
> -   in this module, though, so this constraint is not enforced here.  */
> +/* Function prototype for module user-pointer and function finalizers.
> +   These should not throw C++ exceptions, so emacs-module.h declares
> +   the corresponding interfaces with EMACS_NOEXCEPT.  There is only C
> +   code in this module, though, so this constraint is not enforced
> +   here.  */
>  typedef void (*emacs_finalizer) (void *);
>
>
> @@ -332,6 +333,12 @@ #define MODULE_FUNCTION_BEGIN(error_retval)      \
>    MODULE_FUNCTION_BEGIN_NO_CATCH (error_retval); \
>    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)
>  {
> @@ -488,6 +495,7 @@ module_non_local_exit_throw (emacs_env *env, emacs_value 
> tag, emacs_value value)
>    ptrdiff_t min_arity, max_arity;
>    emacs_subr subr;
>    void *data;
> +  emacs_finalizer finalizer;
>  } GCALIGNED_STRUCT;
>
>  static struct Lisp_Module_Function *
> @@ -521,6 +529,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);
> @@ -532,6 +541,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)
> @@ -1339,6 +1374,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/lisp.h b/src/lisp.h
> index e0ae2c4262..1bd78284d7 100644
> --- a/src/lisp.h
> +++ b/src/lisp.h
> @@ -4245,6 +4245,7 @@ XMODULE_FUNCTION (Lisp_Object o)
>    (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 dec8704edd..a2479a8f74 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 5addf61147..6a70a7ab57 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 @@ #define DEFUN(lsym, csym, amin, amax, doc, data) \
>    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 322500ff60..d9a57aecf6 100644
> --- a/test/src/emacs-module-tests.el
> +++ b/test/src/emacs-module-tests.el
> @@ -402,4 +402,12 @@ module-darwin-secondary-suffix
>          (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
> --
> 2.21.0 (Apple Git-122.2)
>
>
>
>