Package: emacs;
Reported by: Samir Jindel <sjindel <at> google.com>
Date: Tue, 6 Feb 2018 21:26:01 UTC
Severity: wishlist
Done: Philipp Stephani <p.stephani2 <at> gmail.com>
Bug is archived. No further changes may be made.
Message #11 received at 30373 <at> debbugs.gnu.org (full text, mbox):
From: Philipp Stephani <p.stephani2 <at> gmail.com> To: 30373 <at> debbugs.gnu.org, sjindel <at> google.com Cc: Philipp Stephani <phst <at> google.com> Subject: [PATCH] Implement finalizers for module functions (Bug#30373) Date: Thu, 26 Dec 2019 01:04:17 +0100
* 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)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.