From 48ffef5ef4b34799941a033591ea827d40025939 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Sun, 11 Feb 2018 21:38:22 +0100
Subject: 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.
---
src/emacs-module.c | 36 ++++++++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
(limited to 'src/emacs-module.c')
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;
}
--
cgit v1.2.3