From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Philipp Stephani Newsgroups: gmane.emacs.devel Subject: [PATCH] Introduce new misc type for module function Date: Sat, 29 Apr 2017 19:27:53 +0200 Message-ID: <20170429172753.18650-1-phst@google.com> References: <83wpa3kxx1.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1493486898 14888 195.159.176.226 (29 Apr 2017 17:28:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 29 Apr 2017 17:28:18 +0000 (UTC) Cc: Philipp Stephani To: eliz@gnu.org, emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Apr 29 19:28:06 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d4WAA-0003fM-LN for ged-emacs-devel@m.gmane.org; Sat, 29 Apr 2017 19:28:06 +0200 Original-Received: from localhost ([::1]:41836 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d4WAG-00085N-ED for ged-emacs-devel@m.gmane.org; Sat, 29 Apr 2017 13:28:12 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45359) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d4WA9-00085I-Vg for emacs-devel@gnu.org; Sat, 29 Apr 2017 13:28:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d4WA8-0004Bq-C2 for emacs-devel@gnu.org; Sat, 29 Apr 2017 13:28:05 -0400 Original-Received: from mail-wm0-x242.google.com ([2a00:1450:400c:c09::242]:36383) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d4WA4-0004BN-FR; Sat, 29 Apr 2017 13:28:00 -0400 Original-Received: by mail-wm0-x242.google.com with SMTP id u65so16586365wmu.3; Sat, 29 Apr 2017 10:28:00 -0700 (PDT) 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; bh=Hzk3IsT8Or3euaasmQnNinNdrx/Mx6Gvzxbb0OO/TGM=; b=NvsoyLgnTsIhCreFSavz38mSj8X87DJa7FbclWtTuXxzOmSbSoFWaflSHkuijkvK8d +ejGMYmf8J/sQbqt3J8J2dTUau4GAA13aie2jHq+K2zOeMUzDcRarYEzn4hRYhhxHOCH W1wd50bd7q0/ImxIsvb/xie3j/WiiEKa/hpkMADvAGk+C/V+euiX2gO18oolCDkihQ3V /+PGOEIsUMse3wmj0XnN4Lu3oNumn4hHtd7nEPL/2QoUio4oB1MA+9kEHzE73U0fgFIz Io+/6Qp7DFayP7N/eNoPQFX0qei9oXyrGD5r182Ajj4sLeQrnoSObfIVXsLzAHvKddEA qCMw== 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; bh=Hzk3IsT8Or3euaasmQnNinNdrx/Mx6Gvzxbb0OO/TGM=; b=BVdsCaMLrnS3nOKr76WTSEDpkHLnNM/1HZ4xSfXh3YoVPcM6zDoFqRgkTpR5E0zMmc S1OmI9HgjG6o5bC3bTnLMgH39EsgNfata5F6WIh79T8NRFQl1pJ434E2TkpZ+aw2OklS WbIyCY6XowwC3nj7mObyWRZK2FCMcs8YI28xTNdUs1yj1UGnrjKASneSNmyTP839T/TL OoL/sd87t39uHbBOLnNwDs11mSKrhygo+O8o8Q17tuYSk+PVjfXXWqMW4hUxvfkjhS4G bSDy5e3DbjwIvyrC45g1t+EC0nlttloZNkzeVaDYA5D7K8sg4N8PmFJqVYSFpjqwk1KZ K9AQ== X-Gm-Message-State: AN3rC/74H8q1cV0liVyG9gnM4ES7rtgmxqLy5i6nzUxGzNsqTcd8xCtJ U2BLZDpnWnuUww== X-Received: by 10.28.33.66 with SMTP id h63mr2202458wmh.86.1493486879202; Sat, 29 Apr 2017 10:27:59 -0700 (PDT) Original-Received: from p.cm.cablesurf.de (46.128.198.151.dynamic.cablesurf.de. [46.128.198.151]) by smtp.gmail.com with ESMTPSA id 23sm12197382wrx.26.2017.04.29.10.27.58 (version=TLS1 cipher=AES128-SHA bits=128/128); Sat, 29 Apr 2017 10:27:58 -0700 (PDT) X-Google-Original-From: Philipp Stephani X-Mailer: git-send-email 2.12.2 In-Reply-To: <83wpa3kxx1.fsf@gnu.org> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c09::242 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:214413 Archived-At: This resolves a couple of FIXMEs in emacs-module.c. * src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions. * src/alloc.c (make_module_function): New function. (mark_object): GC support. * src/data.c (Ftype_of, syms_of_data): Handle module function type. * src/print.c (print_object): Print support for new type. * src/emacs-module.c (module_make_function, Finternal_module_call): Use new module function type, remove FIXMEs. (module_format_fun_env): Adapt and give it external linkage. * test/src/emacs-module-tests.el (module-function-object): Add unit test. --- src/alloc.c | 7 ++++++ src/data.c | 3 +++ src/emacs-module.c | 48 ++++++++---------------------------------- src/lisp.h | 39 ++++++++++++++++++++++++++++++++++ src/print.c | 5 +++++ test/src/emacs-module-tests.el | 23 ++++++++++++++++++++ 6 files changed, 86 insertions(+), 39 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 88a1a1ed66..9be570fe59 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3937,6 +3937,12 @@ make_user_ptr (void (*finalizer) (void *), void *p) return obj; } +/* Create a new module function environment object. */ +Lisp_Object +make_module_function () +{ + return allocate_misc (Lisp_Misc_Module_Function); +} #endif static void @@ -6628,6 +6634,7 @@ mark_object (Lisp_Object arg) #ifdef HAVE_MODULES case Lisp_Misc_User_Ptr: + case Lisp_Misc_Module_Function: XMISCANY (obj)->gcmarkbit = true; break; #endif diff --git a/src/data.c b/src/data.c index 141b26ccf3..44f7ba0e88 100644 --- a/src/data.c +++ b/src/data.c @@ -233,6 +233,8 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Misc_Finalizer: return Qfinalizer; #ifdef HAVE_MODULES + case Lisp_Misc_Module_Function: + return Qmodule_function; case Lisp_Misc_User_Ptr: return Quser_ptr; #endif @@ -3729,6 +3731,7 @@ syms_of_data (void) DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); #ifdef HAVE_MODULES + DEFSYM (Qmodule_function, "module-function"); DEFSYM (Quser_ptr, "user-ptr"); #endif DEFSYM (Qfloat, "float"); diff --git a/src/emacs-module.c b/src/emacs-module.c index 1b445dcc3b..cd025a1396 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -62,10 +62,6 @@ enum /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); -/* Function prototype for the module Lisp functions. */ -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, - emacs_value [], void *); - /* 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 @@ -102,7 +98,6 @@ struct emacs_runtime_private struct module_fun_env; -static Lisp_Object module_format_fun_env (const struct module_fun_env *); static Lisp_Object value_to_lisp (emacs_value); static emacs_value lisp_to_value (Lisp_Object); static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); @@ -184,22 +179,6 @@ static emacs_value const module_nil = 0; do { } while (false) -/* Function environments. */ - -/* A function environment is an auxiliary structure used by - `module_make_function' to store information about a module - function. It is stored in a save pointer and retrieved by - `internal--module-call'. Its members correspond to the arguments - given to `module_make_function'. */ - -struct module_fun_env -{ - ptrdiff_t min_arity, max_arity; - emacs_subr subr; - void *data; -}; - - /* Implementation of runtime and environment functions. These should abide by the following rules: @@ -382,14 +361,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, : min_arity <= max_arity))) xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); - /* FIXME: This should be freed when envobj is GC'd. */ - struct module_fun_env *envptr = xmalloc (sizeof *envptr); + Lisp_Object envobj = make_module_function (); + struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); envptr->min_arity = min_arity; envptr->max_arity = max_arity; envptr->subr = subr; envptr->data = data; - Lisp_Object envobj = make_save_ptr (envptr); Lisp_Object doc = Qnil; if (documentation) { @@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST) */) (ptrdiff_t nargs, Lisp_Object *arglist) { Lisp_Object envobj = arglist[0]; - /* FIXME: Rather than use a save_value, we should create a new object type. - Making save_value visible to Lisp is wrong. */ - CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj); - struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj); - CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj); - /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0) - is a module_fun_env pointer. If some other part of Emacs also - exports save_value objects to Elisp, than we may be getting here this - other kind of save_value which will likely hold something completely - different in this field. */ - struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0); + CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj); + struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); EMACS_INT len = nargs - 1; eassume (0 <= envptr->min_arity); if (! (envptr->min_arity <= len @@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val) /* Return a string object that contains a user-friendly representation of the function environment. */ -static Lisp_Object -module_format_fun_env (const struct module_fun_env *env) +Lisp_Object +module_format_fun_env (const struct Lisp_Module_Function *env) { /* Try to print a function name if possible. */ + /* FIXME: Move this function into print.c, then use prin1-to-string + above. */ const char *path, *sym; static char const noaddr_format[] = "#"; char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256]; @@ -1048,8 +1019,7 @@ syms_of_module (void) code or modules should not access it. */ Funintern (Qmodule_refs_hash, Qnil); - DEFSYM (Qsave_value_p, "save-value-p"); - DEFSYM (Qsave_pointer_p, "save-pointer-p"); + DEFSYM (Qmodule_function_p, "module-function-p"); defsubr (&Smodule_load); diff --git a/src/lisp.h b/src/lisp.h index daf57ed906..5d4c64a2e5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -464,6 +464,7 @@ enum Lisp_Misc_Type Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, #ifdef HAVE_MODULES + Lisp_Misc_Module_Function, Lisp_Misc_User_Ptr, #endif /* Currently floats are not a misc type, @@ -2385,6 +2386,28 @@ struct Lisp_User_Ptr void (*finalizer) (void *); void *p; }; + +#include "emacs-module.h" + +/* Function prototype for the module Lisp functions. */ +typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, + emacs_value [], void *); + +/* Function environments. */ + +/* A function environment is an auxiliary structure used by + `module_make_function' to store information about a module + function. It is stored in a save pointer and retrieved by + `internal--module-call'. Its members correspond to the arguments + given to `module_make_function'. */ + +struct Lisp_Module_Function +{ + struct Lisp_Misc_Any base; + ptrdiff_t min_arity, max_arity; + emacs_subr subr; + void *data; +}; #endif /* A finalizer sentinel. */ @@ -2437,6 +2460,7 @@ union Lisp_Misc struct Lisp_Finalizer u_finalizer; #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; + struct Lisp_Module_Function u_module_function; #endif }; @@ -2485,6 +2509,19 @@ XUSER_PTR (Lisp_Object a) eassert (USER_PTRP (a)); return XUNTAG (a, Lisp_Misc); } + +INLINE bool +MODULE_FUNCTIONP (Lisp_Object o) +{ + return MISCP (o) && XMISCTYPE (o) == Lisp_Misc_Module_Function; +} + +INLINE struct Lisp_Module_Function * +XMODULE_FUNCTION (Lisp_Object o) +{ + eassert (MODULE_FUNCTIONP (o)); + return XUNTAG (o, Lisp_Misc); +} #endif @@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); #ifdef HAVE_MODULES /* Defined in alloc.c. */ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p); +extern Lisp_Object make_module_function (void); /* Defined in emacs-module.c. */ +extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Function *); extern void syms_of_module (void); #endif diff --git a/src/print.c b/src/print.c index 872103bd4c..7e411a80c8 100644 --- a/src/print.c +++ b/src/print.c @@ -2103,6 +2103,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printchar ('>', printcharfun); break; } + + case Lisp_Misc_Module_Function: + print_string (module_format_fun_env (XMODULE_FUNCTION (obj)), + printcharfun); + break; #endif case Lisp_Misc_Finalizer: diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 93e85ae22d..7859fc5dce 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -59,6 +59,29 @@ (ert-deftest mod-test-sum-docstring () (should (string= (documentation 'mod-test-sum) "Return A + B"))) +(ert-deftest module-function-object () + "Extract and test the implementation of a module function. +This test needs to be changed whenever the implementation +changes." + (let ((func (symbol-function #'mod-test-sum))) + (should (consp func)) + (should (equal (length func) 4)) + (should (equal (nth 0 func) 'lambda)) + (should (equal (nth 1 func) '(&rest args))) + (should (equal (nth 2 func) "Return A + B")) + (let ((body (nth 3 func))) + (should (consp body)) + (should (equal (length body) 4)) + (should (equal (nth 0 body) #'apply)) + (should (equal (nth 1 body) '#'internal--module-call)) + (should (equal (nth 3 body) 'args)) + (let ((obj (nth 2 body))) + (should (equal (type-of obj) 'module-function)) + (should (string-match-p + (rx "#") + (prin1-to-string obj))))))) + ;; ;; Non-local exists (throw, signal). ;; -- 2.12.2