From 48ffef5ef4b34799941a033591ea827d40025939 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Feb 2018 21:38:22 +0100 Subject: [PATCH] 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 d95a3e445cc..c0b3fe5a1b0 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 df12c7e8430..d6cabf8e9e4 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 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 @@ -326,6 +326,12 @@ static bool module_assertions = false; 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) { @@ -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); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 8dc9ff144af..1a0a879a1bc 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 a2cb3e9b498..4f5871be5eb 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 -- 2.39.2