From mboxrd@z Thu Jan 1 00:00:00 1970
Path: news.gmane.org!.POSTED!not-for-mail
From: Philipp
Newsgroups: gmane.emacs.devel
Subject: Re: [PATCH] Introduce new misc type for module function
Date: Sat, 06 May 2017 19:30:02 +0000
Message-ID:
References: <83wpa3kxx1.fsf@gnu.org> <20170429172753.18650-1-phst@google.com>
NNTP-Posting-Host: blaine.gmane.org
Mime-Version: 1.0
Content-Type: multipart/alternative; boundary=001a11442822eec0ab054ee00816
X-Trace: blaine.gmane.org 1494099071 10021 195.159.176.226 (6 May 2017 19:31:11 GMT)
X-Complaints-To: usenet@blaine.gmane.org
NNTP-Posting-Date: Sat, 6 May 2017 19:31:11 +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 May 06 21:31: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 1d75Pz-0002Sn-8d
for ged-emacs-devel@m.gmane.org; Sat, 06 May 2017 21:31:03 +0200
Original-Received: from localhost ([::1]:52480 helo=lists.gnu.org)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from )
id 1d75Q4-0002IE-W4
for ged-emacs-devel@m.gmane.org; Sat, 06 May 2017 15:31:09 -0400
Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41249)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from ) id 1d75PI-0002Hq-IX
for emacs-devel@gnu.org; Sat, 06 May 2017 15:30:23 -0400
Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
(envelope-from ) id 1d75PG-0002aX-3C
for emacs-devel@gnu.org; Sat, 06 May 2017 15:30:20 -0400
Original-Received: from mail-wm0-x233.google.com ([2a00:1450:400c:c09::233]:36107)
by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16)
(Exim 4.71) (envelope-from )
id 1d75PC-0002ZZ-Ce; Sat, 06 May 2017 15:30:14 -0400
Original-Received: by mail-wm0-x233.google.com with SMTP id u65so48222791wmu.1;
Sat, 06 May 2017 12:30:14 -0700 (PDT)
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=n0/pyHakI5LmtBpjXVTrcLF0uUuIZc/ygTp3fy97hzU=;
b=WDDAMHeXC/1jQ3qN9tVt2vdDfhlW6TyBwimMl7c6o5Ng7KHAT1kghxzSnfdMlh/79T
awYdttncu876/D7zobEcHl1AOvV0/bfcUH2BUyy4ry4xstP1tIwV+nInknFdzSpxXfCz
1POjWnHlyNUaeeLpULPYnPlsMhaIxDRkHIcfqm2VmL1zajTUjrrMu+m1xlylDAVwcRf7
jlovbFglEYGjvbAzk2W8z1cCeGdjB3SaQBsrv3HgXpQPRB0GFsEMmuIG6oZk4oRSQcCp
n79qdsGjXRlMaS552RVrgRHzKMykUDZ2lJ7tbHyRX3RTXtprharmXToqrYcVvn2nlk62
n9lA==
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=n0/pyHakI5LmtBpjXVTrcLF0uUuIZc/ygTp3fy97hzU=;
b=Vm49flm/J/tENrgeg5TbCvcf5Laq34hfoN7bIzBaDkVbnuSPGZQSR+cTS9U7Br8bRm
OoRGruzH9Xlh2I1r6Fi1sa39rfD0Axg6kbRN/kdZQvCYKe2AZZr44rd315gSb2296WKE
8Pal8iUK5JsErgXpY+4dcevbCM6HrexJzA0v9GfjOiJTWvXny83GoMcbnWpXyLOa/jAk
mPabVuZKzIghf/4q8DsAMOWlgajEzwZk2MAiHNyg15a/Hp9hpg0DaMI7YJA6qv7pdzdz
H1gbJILIOzobFEJvMIIkpxuGFVZ12Wrg7owWQtIPx9h7Z5s+J+P+wAzrombWFbHiQqfm
U5Yw==
X-Gm-Message-State: AN3rC/4wi5+guaDcN9VMQ2ukoKPRQujuWD+8bj3Gntyjs8lbIeQxJR2c
lqEBe4hQEe/LC1VqJ2nDO/USmDtQascB
X-Received: by 10.28.174.195 with SMTP id x186mr8760226wme.95.1494099013054;
Sat, 06 May 2017 12:30:13 -0700 (PDT)
In-Reply-To: <20170429172753.18650-1-phst@google.com>
X-detected-operating-system: by eggs.gnu.org: Genre and OS details not
recognized.
X-Received-From: 2a00:1450:400c:c09::233
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:214633
Archived-At:
--001a11442822eec0ab054ee00816
Content-Type: text/plain; charset=UTF-8
Philipp Stephani schrieb am Sa., 29. Apr. 2017 um
19:27 Uhr:
> 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 "# + (* nonl) "mod-test" (* nonl) ">")
> + (prin1-to-string obj)))))))
> +
> ;;
> ;; Non-local exists (throw, signal).
> ;;
> --
> 2.12.2
>
>
No further comments, so I've pushed this as a3e9694078.
--001a11442822eec0ab054ee00816
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
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.
---
=C2=A0src/alloc.c=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 |=C2=A0 7 ++++++
=C2=A0src/data.c=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0|=C2=A0 3 +++
=C2=A0src/emacs-module.c=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0| 4=
8 ++++++++----------------------------------
=C2=A0src/lisp.h=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0| 39 ++++++++++++++++++++++++++++++++++
=C2=A0src/print.c=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 |=C2=A0 5 +++++
=C2=A0test/src/emacs-module-tests.el | 23 ++++++++++++++++++++
=C2=A06 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)<=
br>
=C2=A0 =C2=A0return obj;
=C2=A0}
+/* Create a new module function environment object.=C2=A0 */
+Lisp_Object
+make_module_function ()
+{
+=C2=A0 return allocate_misc (Lisp_Misc_Module_Function);
+}
=C2=A0#endif
=C2=A0static void
@@ -6628,6 +6634,7 @@ mark_object (Lisp_Object arg)
=C2=A0#ifdef HAVE_MODULES
=C2=A0 =C2=A0 =C2=A0 =C2=A0 case Lisp_Misc_User_Ptr:
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 case Lisp_Misc_Module_Function:
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 XMISCANY (obj)->gcmarkbit =3D true;
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 break;
=C2=A0#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'.=C2=A0 *=
/)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0case Lisp_Misc_Finalizer:
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0return Qfinalizer;
=C2=A0#ifdef HAVE_MODULES
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 case Lisp_Misc_Module_Function:
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 return Qmodule_function;
=C2=A0 =C2=A0 =C2=A0 =C2=A0 case Lisp_Misc_User_Ptr:
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 return Quser_ptr;
=C2=A0#endif
@@ -3729,6 +3731,7 @@ syms_of_data (void)
=C2=A0 =C2=A0DEFSYM (Qoverlay, "overlay");
=C2=A0 =C2=A0DEFSYM (Qfinalizer, "finalizer");
=C2=A0#ifdef HAVE_MODULES
+=C2=A0 DEFSYM (Qmodule_function, "module-function");
=C2=A0 =C2=A0DEFSYM (Quser_ptr, "user-ptr");
=C2=A0#endif
=C2=A0 =C2=A0DEFSYM (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
=C2=A0/* Function prototype for the module init function.=C2=A0 */
=C2=A0typedef int (*emacs_init_function) (struct emacs_runtime *);
-/* Function prototype for the module Lisp functions.=C2=A0 */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
-=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 emacs_value [], void *);
-
=C2=A0/* Function prototype for module user-pointer finalizers.=C2=A0 These=
=C2=A0 =C2=A0 should not throw C++ exceptions, so emacs-module.h declares t=
he
=C2=A0 =C2=A0 corresponding interfaces with EMACS_NOEXCEPT.=C2=A0 There is =
only C code
@@ -102,7 +98,6 @@ struct emacs_runtime_private
=C2=A0struct module_fun_env;
-static Lisp_Object module_format_fun_env (const struct module_fun_env *);<=
br>
=C2=A0static Lisp_Object value_to_lisp (emacs_value);
=C2=A0static emacs_value lisp_to_value (Lisp_Object);
=C2=A0static enum emacs_funcall_exit module_non_local_exit_check (emacs_env=
*);
@@ -184,22 +179,6 @@ static emacs_value const module_nil =3D 0;
=C2=A0 =C2=A0do { } while (false)
-/* Function environments.=C2=A0 */
-
-/* A function environment is an auxiliary structure used by
-=C2=A0 =C2=A0`module_make_function' to store information about a modul=
e
-=C2=A0 =C2=A0function.=C2=A0 It is stored in a save pointer and retrieved =
by
-=C2=A0 =C2=A0`internal--module-call'.=C2=A0 Its members correspond to =
the arguments
-=C2=A0 =C2=A0given to `module_make_function'.=C2=A0 */
-
-struct module_fun_env
-{
-=C2=A0 ptrdiff_t min_arity, max_arity;
-=C2=A0 emacs_subr subr;
-=C2=A0 void *data;
-};
-
-=0C
=C2=A0/* Implementation of runtime and environment functions.
=C2=A0 =C2=A0 These should abide by the following rules:
@@ -382,14 +361,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_a=
rity, ptrdiff_t max_arity,
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0: min_arity <=3D max_ari=
ty)))
=C2=A0 =C2=A0 =C2=A0xsignal2 (Qinvalid_arity, make_number (min_arity), make=
_number (max_arity));
-=C2=A0 /* FIXME: This should be freed when envobj is GC'd.=C2=A0 */
-=C2=A0 struct module_fun_env *envptr =3D xmalloc (sizeof *envptr);
+=C2=A0 Lisp_Object envobj =3D make_module_function ();
+=C2=A0 struct Lisp_Module_Function *envptr =3D XMODULE_FUNCTION (envobj);<=
br>
=C2=A0 =C2=A0envptr->min_arity =3D min_arity;
=C2=A0 =C2=A0envptr->max_arity =3D max_arity;
=C2=A0 =C2=A0envptr->subr =3D subr;
=C2=A0 =C2=A0envptr->data =3D data;
-=C2=A0 Lisp_Object envobj =3D make_save_ptr (envptr);
=C2=A0 =C2=A0Lisp_Object doc =3D Qnil;
=C2=A0 =C2=A0if (documentation)
=C2=A0 =C2=A0 =C2=A0{
@@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST)=C2=A0 =
=C2=A0*/)
=C2=A0 =C2=A0(ptrdiff_t nargs, Lisp_Object *arglist)
=C2=A0{
=C2=A0 =C2=A0Lisp_Object envobj =3D arglist[0];
-=C2=A0 /* FIXME: Rather than use a save_value, we should create a new obje=
ct type.
-=C2=A0 =C2=A0 =C2=A0Making save_value visible to Lisp is wrong.=C2=A0 */
-=C2=A0 CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
-=C2=A0 struct Lisp_Save_Value *save_value =3D XSAVE_VALUE (envobj);
-=C2=A0 CHECK_TYPE (save_type (save_value, 0) =3D=3D SAVE_POINTER, Qsave_po=
inter_p, envobj);
-=C2=A0 /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, =
0)
-=C2=A0 =C2=A0 =C2=A0is a module_fun_env pointer.=C2=A0 If some other part =
of Emacs also
-=C2=A0 =C2=A0 =C2=A0exports save_value objects to Elisp, than we may be ge=
tting here this
-=C2=A0 =C2=A0 =C2=A0other kind of save_value which will likely hold someth=
ing completely
-=C2=A0 =C2=A0 =C2=A0different in this field.=C2=A0 */
-=C2=A0 struct module_fun_env *envptr =3D XSAVE_POINTER (envobj, 0);
+=C2=A0 CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);=
+=C2=A0 struct Lisp_Module_Function *envptr =3D XMODULE_FUNCTION (envobj);<=
br>
=C2=A0 =C2=A0EMACS_INT len =3D nargs - 1;
=C2=A0 =C2=A0eassume (0 <=3D envptr->min_arity);
=C2=A0 =C2=A0if (! (envptr->min_arity <=3D len
@@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_=
val)
=C2=A0/* Return a string object that contains a user-friendly
=C2=A0 =C2=A0 representation of the function environment.=C2=A0 */
-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)
=C2=A0{
=C2=A0 =C2=A0/* Try to print a function name if possible.=C2=A0 */
+=C2=A0 /* FIXME: Move this function into print.c, then use prin1-to-string=
+=C2=A0 =C2=A0 =C2=A0above.=C2=A0 */
=C2=A0 =C2=A0const char *path, *sym;
=C2=A0 =C2=A0static char const noaddr_format[] =3D "#<module functi=
on at %p>";
=C2=A0 =C2=A0char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t)=
+ 256];
@@ -1048,8 +1019,7 @@ syms_of_module (void)
=C2=A0 =C2=A0 =C2=A0 code or modules should not access it.=C2=A0 */
=C2=A0 =C2=A0Funintern (Qmodule_refs_hash, Qnil);
-=C2=A0 DEFSYM (Qsave_value_p, "save-value-p");
-=C2=A0 DEFSYM (Qsave_pointer_p, "save-pointer-p");
+=C2=A0 DEFSYM (Qmodule_function_p, "module-function-p");
=C2=A0 =C2=A0defsubr (&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
=C2=A0 =C2=A0 =C2=A0Lisp_Misc_Save_Value,
=C2=A0 =C2=A0 =C2=A0Lisp_Misc_Finalizer,
=C2=A0#ifdef HAVE_MODULES
+=C2=A0 =C2=A0 Lisp_Misc_Module_Function,
=C2=A0 =C2=A0 =C2=A0Lisp_Misc_User_Ptr,
=C2=A0#endif
=C2=A0 =C2=A0 =C2=A0/* Currently floats are not a misc type,
@@ -2385,6 +2386,28 @@ struct Lisp_User_Ptr
=C2=A0 =C2=A0void (*finalizer) (void *);
=C2=A0 =C2=A0void *p;
=C2=A0};
+
+#include "emacs-module.h"
+
+/* Function prototype for the module Lisp functions.=C2=A0 */
+typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 emacs_value [], void *);
+
+/* Function environments.=C2=A0 */
+
+/* A function environment is an auxiliary structure used by
+=C2=A0 =C2=A0`module_make_function' to store information about a modul=
e
+=C2=A0 =C2=A0function.=C2=A0 It is stored in a save pointer and retrieved =
by
+=C2=A0 =C2=A0`internal--module-call'.=C2=A0 Its members correspond to =
the arguments
+=C2=A0 =C2=A0given to `module_make_function'.=C2=A0 */
+
+struct Lisp_Module_Function
+{
+=C2=A0 struct Lisp_Misc_Any base;
+=C2=A0 ptrdiff_t min_arity, max_arity;
+=C2=A0 emacs_subr subr;
+=C2=A0 void *data;
+};
=C2=A0#endif
=C2=A0/* A finalizer sentinel.=C2=A0 */
@@ -2437,6 +2460,7 @@ union Lisp_Misc
=C2=A0 =C2=A0 =C2=A0struct Lisp_Finalizer u_finalizer;
=C2=A0#ifdef HAVE_MODULES
=C2=A0 =C2=A0 =C2=A0struct Lisp_User_Ptr u_user_ptr;
+=C2=A0 =C2=A0 struct Lisp_Module_Function u_module_function;
=C2=A0#endif
=C2=A0 =C2=A0};
@@ -2485,6 +2509,19 @@ XUSER_PTR (Lisp_Object a)
=C2=A0 =C2=A0eassert (USER_PTRP (a));
=C2=A0 =C2=A0return XUNTAG (a, Lisp_Misc);
=C2=A0}
+
+INLINE bool
+MODULE_FUNCTIONP (Lisp_Object o)
+{
+=C2=A0 return MISCP (o) && XMISCTYPE (o) =3D=3D Lisp_Misc_Module_F=
unction;
+}
+
+INLINE struct Lisp_Module_Function *
+XMODULE_FUNCTION (Lisp_Object o)
+{
+=C2=A0 eassert (MODULE_FUNCTIONP (o));
+=C2=A0 return XUNTAG (o, Lisp_Misc);
+}
=C2=A0#endif
@@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lis=
p_Symbol *symbol);
=C2=A0#ifdef HAVE_MODULES
=C2=A0/* Defined in alloc.c.=C2=A0 */
=C2=A0extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p=
);
+extern Lisp_Object make_module_function (void);
=C2=A0/* Defined in emacs-module.c.=C2=A0 */
+extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Functio=
n *);
=C2=A0extern void syms_of_module (void);
=C2=A0#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 printchar=
fun, bool escapeflag)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 printchar ('>', printc=
harfun);
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 break;
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
+
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 case Lisp_Misc_Module_Function:
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 print_string (module_format_fun_env (XM=
ODULE_FUNCTION (obj)),
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 printcharfun);
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 break;
=C2=A0#endif
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0case Lisp_Misc_Finalizer:
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.e=
l
index 93e85ae22d..7859fc5dce 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -59,6 +59,29 @@
=C2=A0(ert-deftest mod-test-sum-docstring ()
=C2=A0 =C2=A0(should (string=3D (documentation 'mod-test-sum) "Ret=
urn A + B")))
+(ert-deftest module-function-object ()
+=C2=A0 "Extract and test the implementation of a module function.
+This test needs to be changed whenever the implementation
+changes."
+=C2=A0 (let ((func (symbol-function #'mod-test-sum)))
+=C2=A0 =C2=A0 (should (consp func))
+=C2=A0 =C2=A0 (should (equal (length func) 4))
+=C2=A0 =C2=A0 (should (equal (nth 0 func) 'lambda))
+=C2=A0 =C2=A0 (should (equal (nth 1 func) '(&rest args)))
+=C2=A0 =C2=A0 (should (equal (nth 2 func) "Return A + B"))
+=C2=A0 =C2=A0 (let ((body (nth 3 func)))
+=C2=A0 =C2=A0 =C2=A0 (should (consp body))
+=C2=A0 =C2=A0 =C2=A0 (should (equal (length body) 4))
+=C2=A0 =C2=A0 =C2=A0 (should (equal (nth 0 body) #'apply))
+=C2=A0 =C2=A0 =C2=A0 (should (equal (nth 1 body) '#'internal--modu=
le-call))
+=C2=A0 =C2=A0 =C2=A0 (should (equal (nth 3 body) 'args))
+=C2=A0 =C2=A0 =C2=A0 (let ((obj (nth 2 body)))
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 (should (equal (type-of obj) 'module-funct=
ion))
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 (should (string-match-p
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(rx "#&=
lt;module function Fmod_test_sum from "
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0(* nonl) "mod-test" (* nonl) ">")
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(prin1-to-st=
ring obj)))))))
+
=C2=A0;;
=C2=A0;; Non-local exists (throw, signal).
=C2=A0;;
--
2.12.2
No further comments, so I've pushe=
d this as a3e9694078.=C2=A0
--001a11442822eec0ab054ee00816--