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: Thu, 26 Dec 2019 01:04:17 +0100 Message-ID: <20191226000417.69183-1-phst@google.com> References: Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="107920"; mail-complaints-to="usenet@blaine.gmane.org" Cc: Philipp Stephani To: 30373@debbugs.gnu.org, sjindel@google.com Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Dec 26 01:05:13 2019 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 1ikGeO-000Rtr-H1 for geb-bug-gnu-emacs@m.gmane.org; Thu, 26 Dec 2019 01:05:12 +0100 Original-Received: from localhost ([::1]:49962 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ikGeM-0003er-Ng for geb-bug-gnu-emacs@m.gmane.org; Wed, 25 Dec 2019 19:05:10 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:44533) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ikGeG-0003dU-1H for bug-gnu-emacs@gnu.org; Wed, 25 Dec 2019 19:05:05 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ikGeE-0001eM-7o for bug-gnu-emacs@gnu.org; Wed, 25 Dec 2019 19:05:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:48806) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ikGeE-0001eC-3s for bug-gnu-emacs@gnu.org; Wed, 25 Dec 2019 19:05:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ikGeD-0000b8-VH for bug-gnu-emacs@gnu.org; Wed, 25 Dec 2019 19:05:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Philipp Stephani Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 26 Dec 2019 00:05:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30373 X-GNU-PR-Package: emacs Original-Received: via spool by 30373-submit@debbugs.gnu.org id=B30373.15773186832224 (code B ref 30373); Thu, 26 Dec 2019 00:05:01 +0000 Original-Received: (at 30373) by debbugs.gnu.org; 26 Dec 2019 00:04:43 +0000 Original-Received: from localhost ([127.0.0.1]:54779 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ikGdv-0000Zn-8V for submit@debbugs.gnu.org; Wed, 25 Dec 2019 19:04:43 -0500 Original-Received: from mail-wr1-f47.google.com ([209.85.221.47]:40642) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ikGdt-0000ZO-4O for 30373@debbugs.gnu.org; Wed, 25 Dec 2019 19:04:42 -0500 Original-Received: by mail-wr1-f47.google.com with SMTP id c14so22491905wrn.7 for <30373@debbugs.gnu.org>; Wed, 25 Dec 2019 16:04:41 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=BLxZKhsEkK3AP1HvwW++QwGBmn69KVoVYNqMFfWrphk=; b=jIgqjisYWKBKpnZGYlpblZTbClNuyYG6AziPjLQySmTMhcTOW3w11KgEncRn0goLge /8BtuX6a67XHTlYytUERd8SH2ck6axlyKr5ggo32+NFvIbR8hpymcqT3skpPlI2UQi0f ECBvxkIUkSBR0xoVUglvH4SXmRUHvnTLrj/O3RNIXkW+KvIlCmwsQikqvLzprxLMGlPR +zz6Q7qD91ytuvlpxju6Qxlgij7x6g0FlEoaUSlu2qI6gTeUzSgzFoA4hejnvzru83/a dQRF3zBxKGCWJXmWe9P0K0aq1oM++QTfniekS0EePWv4QtqEo4MkD+gL9DnsbVO5Tv+I HCfw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=BLxZKhsEkK3AP1HvwW++QwGBmn69KVoVYNqMFfWrphk=; b=JesyfLHW/ofHLRsVcljHNcHR9bdGXlnJRB3wgc//Xb19PLHgu0nHYnWgdhgr73RAjg MVT0Z0xxwYt9A9rHQvhfgj0WR5vLjRNbHwFijLyxraiFe3V1rngx1WFsYALVm9xw+IJK 6OfhjGw9Nryg5lLAmPPkPliAxy6W9ckYygadBV6aeDVQoe+lbGYPEXRhAgTrIHqOrzpx 9aIC0sflPWN4QM8hdb8KQiPY6V1+9xU2Qv0X+8EZzIrUrPvNEZaVkEwXFxrUX53bmDZi Rv0wK5a7qAMd9mG/VfOR7a+UpnW+Xz1GDd9y0qggYqvFnXgVyf3xMvbAbh4Z6PU03H80 y1Dg== X-Gm-Message-State: APjAAAWU7sqzGdNh0hUugaPIQujyhg/XiL7zgia97cqhXM2dQU29o5Kb 3ife6G0OY/RkFM9Ip0mrnVzVos7dHa4= X-Google-Smtp-Source: APXvYqxpgYRwYvG+tRp3wxHZQzDs6ewzBbk03qOGhE64na6LFLnVYvzD+WUzCOspfXJpgFOazpfTJg== X-Received: by 2002:a5d:5452:: with SMTP id w18mr28694010wrv.333.1577318674535; Wed, 25 Dec 2019 16:04:34 -0800 (PST) Original-Received: from p.fritz.box (p57AAFE71.dip0.t-ipconnect.de. [87.170.254.113]) by smtp.gmail.com with ESMTPSA id p15sm6848696wma.40.2019.12.25.16.04.32 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 25 Dec 2019 16:04:33 -0800 (PST) X-Google-Original-From: Philipp Stephani X-Mailer: git-send-email 2.21.0 (Apple Git-122.2) In-Reply-To: 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:173768 Archived-At: * 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)