From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Philipp Stephani Newsgroups: gmane.emacs.bugs Subject: bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373) Date: Fri, 3 Jan 2020 19:34:51 +0100 Message-ID: References: <20191226000417.69183-1-phst@google.com> Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="210465"; mail-complaints-to="usenet@blaine.gmane.org" Cc: Philipp Stephani To: 30373-done@debbugs.gnu.org, Samir Jindel Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Jan 03 19:36:13 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1inRnw-000sYd-Sy for geb-bug-gnu-emacs@m.gmane.org; Fri, 03 Jan 2020 19:36:13 +0100 Original-Received: from localhost ([::1]:55674 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1inRnv-000693-5y for geb-bug-gnu-emacs@m.gmane.org; Fri, 03 Jan 2020 13:36:11 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:60087) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1inRno-00068l-FJ for bug-gnu-emacs@gnu.org; Fri, 03 Jan 2020 13:36:06 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1inRnm-0002q0-FI for bug-gnu-emacs@gnu.org; Fri, 03 Jan 2020 13:36:04 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:35464) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1inRnm-0002oZ-7D for bug-gnu-emacs@gnu.org; Fri, 03 Jan 2020 13:36:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1inRnm-0003CG-4d for bug-gnu-emacs@gnu.org; Fri, 03 Jan 2020 13:36:02 -0500 Resent-From: Philipp Stephani Original-Sender: "Debbugs-submit" Resent-To: bug-gnu-emacs@gnu.org Resent-Date: Fri, 03 Jan 2020 18:36:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: cc-closed 30373 X-GNU-PR-Package: emacs Mail-Followup-To: 30373@debbugs.gnu.org, p.stephani2@gmail.com, sjindel@google.com Original-Received: via spool by 30373-done@debbugs.gnu.org id=D30373.157807651112228 (code D ref 30373); Fri, 03 Jan 2020 18:36:01 +0000 Original-Received: (at 30373-done) by debbugs.gnu.org; 3 Jan 2020 18:35:11 +0000 Original-Received: from localhost ([127.0.0.1]:41435 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1inRmw-0003B7-KR for submit@debbugs.gnu.org; Fri, 03 Jan 2020 13:35:11 -0500 Original-Received: from mail-ot1-f67.google.com ([209.85.210.67]:34646) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1inRmu-0003Ar-Px for 30373-done@debbugs.gnu.org; Fri, 03 Jan 2020 13:35:09 -0500 Original-Received: by mail-ot1-f67.google.com with SMTP id a15so62185423otf.1 for <30373-done@debbugs.gnu.org>; Fri, 03 Jan 2020 10:35:08 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to :cc; bh=WmB4kXUoO7ArDez8W9BaonsXuq07+HZImKw6kHlddDY=; b=kTMvr2F/Q08ASz2gEbTlskJxpeNW45Opgpf/WdMFyEtjeY4OkX/4aC9cK2UTGC5aWw k87d7oxA5zM0ILdsuYrpLFmUITeXY7ir/Us0cKRgPlBd5pKio4Ozyrq/77XQg264ztEm pAHnvza5f1PuVl3UPCfxROA7RLJmxq51iSfXVGhXYk/nG3FBDJoIJzPa6LiqluyPe1k6 B4bYwEgQHQz4SqtDPfGk7mscDBPzheMeeikp8zcPbjmMRjvfpO79OuqKXvD0q5HHJmw1 pX941UUrnjJBilQyysUvoyI/CwugfumBmyFhHu8cgj4YIXJajzLzy+arspd+/5kmuI8Y JOXQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:references:in-reply-to:from:date :message-id:subject:to:cc; bh=WmB4kXUoO7ArDez8W9BaonsXuq07+HZImKw6kHlddDY=; b=nGr9nz5OFqPVhs/Es/FbVnsB6TsgDAFEF/2h0Cfu1jipdBZnH/Kk8smowM7+T6t0vZ PxxL5qRL4tqCCWvqPcGjMm5PNma64c0sh42MWDre/ZHozvVXatakM5clOWnQMbJ1y208 jw2Y9htQpNOezGhEfWwnWfYpFBLxJ+Z0U/2m0ipgZJ7i9VGfnfSvB8AtBmbLRbZyHiPL eYuABbMXqqyIofyOzu62CXVRODtm7YVB4r87e6xHWPBTQxiS4aO0Trd1wPsCCtx8SUTa Yccn6MyJI/55QLQXgbADHxChrGlVnOg1uyDKPS6QMX8Nx+L6C92f2uPfll7e7Y4KifVV biGA== X-Gm-Message-State: APjAAAU3tg9/L3vWnxyegD4TEN0WoHkuQ3UxGzW8Y0IfZQKQcFt57nmn 3A+LgL8kmm1tBWMbP5VWhJTNg3aThfvqdJIP+eWNOpNY9xM= X-Google-Smtp-Source: APXvYqzamxRTmNflJLNfrOHr+LSUEXFweIimelm2GMCIZfMdErl2LbLRpjLStgRf8S/xJ0fitk3yN4y8h4kik0cL0q4= X-Received: by 2002:a9d:4b05:: with SMTP id q5mr84103223otf.174.1578076502831; Fri, 03 Jan 2020 10:35:02 -0800 (PST) In-Reply-To: <20191226000417.69183-1-phst@google.com> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:174128 Archived-At: 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 : > > * 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) > > > >