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
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
'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.
+
\f
* Changes in Emacs 28.1 on Non-Free Operating Systems
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. */
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)
{
ptrdiff_t min_arity, max_arity;
emacs_function subr;
void *data;
+ emacs_finalizer finalizer;
} GCALIGNED_STRUCT;
static struct Lisp_Module_Function *
function->max_arity = max_arity;
function->subr = func;
function->data = data;
+ function->finalizer = NULL;
if (docstring)
function->documentation = build_string_from_utf8 (docstring);
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)
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;
}
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. */
(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);
/* 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);
}
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)
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. */
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
(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