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, 22 Apr 2017 18:05:53 +0200
Message-ID: <20170422160553.63385-1-phst@google.com>
NNTP-Posting-Host: blaine.gmane.org
X-Trace: blaine.gmane.org 1492877204 19993 195.159.176.226 (22 Apr 2017 16:06:44 GMT)
X-Complaints-To: usenet@blaine.gmane.org
NNTP-Posting-Date: Sat, 22 Apr 2017 16:06:44 +0000 (UTC)
Cc: Philipp Stephani
To: emacs-devel@gnu.org
Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Apr 22 18:06:40 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 1d1xYW-00054u-63
for ged-emacs-devel@m.gmane.org; Sat, 22 Apr 2017 18:06:40 +0200
Original-Received: from localhost ([::1]:36163 helo=lists.gnu.org)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from )
id 1d1xYc-0007ht-2U
for ged-emacs-devel@m.gmane.org; Sat, 22 Apr 2017 12:06:46 -0400
Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42345)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from ) id 1d1xY2-0007hl-SM
for emacs-devel@gnu.org; Sat, 22 Apr 2017 12:06:12 -0400
Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
(envelope-from ) id 1d1xXx-0004R0-Qf
for emacs-devel@gnu.org; Sat, 22 Apr 2017 12:06:10 -0400
Original-Received: from mail-wr0-x229.google.com ([2a00:1450:400c:c0c::229]:33687)
by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16)
(Exim 4.71) (envelope-from )
id 1d1xXx-0004Pj-G2
for emacs-devel@gnu.org; Sat, 22 Apr 2017 12:06:05 -0400
Original-Received: by mail-wr0-x229.google.com with SMTP id w50so46064515wrc.0
for ; Sat, 22 Apr 2017 09:06:05 -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;
bh=X2snG3Oo3wJVZAym/3X3vlUuuVMD0/yZivvyVdk1O7A=;
b=EZg9Su939N/g/05cUliU2TanqMx9eAMHIk0jyxV+57SCiwDo6ksv3dqRQO48Ig3O+9
aytCnGzigtDYW1H/aA3ou4bzogVqSErn77oY2sPB2ZxfuRNG3jYI61mKLjtu5i7lbS+e
7R9hSzsYdgDTe2brj8fRnoGf75ua15YYRi0+4yKLYcj3yhBMKTa5VoEcIGNAlFI8gtWG
xOHTBEciWpyKWpPeQYGFZHkLhewWJk7z7mmtMBdolwiXeOzOFhvPH44QH33XM4h2vlWV
2TOXx6w1AKFY7p6rPQ+WZOcHCr71/uYYu/0fGW6pDGgJTyTx+ZyRjhGN4gHsSgrX5fBU
Zziw==
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;
bh=X2snG3Oo3wJVZAym/3X3vlUuuVMD0/yZivvyVdk1O7A=;
b=MyZToOpe/6ZmzkdxdWiw7jDMfha8Mv6gdrPwEQdJEi4sIawZ0hX42QKCF7eH81keGx
TYj4Jg09W6dXBfemhEEUrXdXvFLNduLNoSR1zPc0i6MdkWqUBJVOQppPBnZ+urajprA3
EPXYEHqeNFz32cHLeDqT9T5QsT5dv30jZUe5kSd7UEEkEsrXqhQ63Il6s4lnMI3HKAdw
iLHELIkihydNtmHTl9J0Sgo1xhXgLD4MrOOlvtcSfguMVAxXq/qXHGjoR+qEK7GO9JI7
5v/MNTYtng9hFii2r+ODLw0gkoe3xuKxepdqE+/eizTSIOhc+m3CYAM5ZVerVy/ZkJVt
THqQ==
X-Gm-Message-State: AN3rC/4kDIgdNQy9c2H7RwqojIYQQIv1aunPtWoFwxmSRf61XDV0fv1e
PCmnU8pviaklng==
X-Received: by 10.223.139.86 with SMTP id v22mr1908449wra.47.1492877164026;
Sat, 22 Apr 2017 09:06:04 -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
l68sm15802227wrc.52.2017.04.22.09.06.02
(version=TLS1 cipher=AES128-SHA bits=128/128);
Sat, 22 Apr 2017 09:06:03 -0700 (PDT)
X-Google-Original-From: Philipp Stephani
X-Mailer: git-send-email 2.12.2
X-detected-operating-system: by eggs.gnu.org: Genre and OS details not
recognized.
X-Received-From: 2a00:1450:400c:c0c::229
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:214219
Archived-At:
This resolves a couple of FIXMEs in emacs-module.c.
* lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.
* alloc.c (make_module_function): New function.
(mark_object): GC support.
* print.c (print_object): Print support for new type.
* 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.
---
src/alloc.c | 7 +++++++
src/emacs-module.c | 48 +++++++++---------------------------------------
src/lisp.h | 39 +++++++++++++++++++++++++++++++++++++++
src/print.c | 5 +++++
4 files changed, 60 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/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:
--
2.12.2