* emacs-module.c, eassert, and nonnull args
@ 2017-06-05 2:48 Paul Eggert
2017-06-05 13:56 ` Philipp Stephani
0 siblings, 1 reply; 7+ messages in thread
From: Paul Eggert @ 2017-06-05 2:48 UTC (permalink / raw)
To: Philipp Stephani; +Cc: Emacs Development
Thanks for your recent improvements to emacs-module.c. One thing I noticed,
though, was that it added several easserts. However, there's a comment at the
start of emacs-module.c that says "Do NOT use 'eassert'". To play it safe for
now I removed the easserts, and thought I'd raise this on emacs-discuss.
As I understand it, emacs-module.c's use of eassert is intended for bugs in
Emacs itself, not for bugs in user-supplied modules. Although perhaps we need a
more-systematic way of issuing signals for screwups in modules, 'eassert' sounds
dicey for that as assertion failures are so drastic. Even though modules can
dump core on their own, should Emacs be on high alert and dump core merely
because a module has an invalid value? Plus, should ENABLE_CHECKING affect
module-screwup checking the same way that it affects eassert?
One other thing. We typically don't need 'eassert (p != NULL)' if P is a pointer
that is about to be dereferenced, as Emacs platforms with ENABLE_CHECKING catch
null-pointer deferences in the hardware nowadays.
Instead of using runtime checks, perhaps we should decorate emacs-module.h's
function declarations with __attribute__ ((__nonnull__ ((N)))) if argument N of
a module function is supposed to be nonnull, so that problems in this area can
(mostly) be caught statically. We could add a macro like the following to
src/emacs-module.h, after the definition of EMACS_NOEXCEPT:
#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
# define EMACS_ARG_NONNULL(...) __attribute__ ((__nonnull__ ((__VA_ARGS__))))
#else
# define EMACS_ARG_NONNULL(...)
#endif
and then use EMACS_ARG_NONNULL calls for function pointers whose arguments are
supposed to be nonnull.
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-05 2:48 emacs-module.c, eassert, and nonnull args Paul Eggert
@ 2017-06-05 13:56 ` Philipp Stephani
2017-06-05 15:33 ` Eli Zaretskii
0 siblings, 1 reply; 7+ messages in thread
From: Philipp Stephani @ 2017-06-05 13:56 UTC (permalink / raw)
To: Paul Eggert, Philipp Stephani; +Cc: Emacs Development
[-- Attachment #1.1: Type: text/plain, Size: 2246 bytes --]
Paul Eggert <eggert@cs.ucla.edu> schrieb am Mo., 5. Juni 2017 um 04:48 Uhr:
> Thanks for your recent improvements to emacs-module.c. One thing I noticed,
> though, was that it added several easserts. However, there's a comment at
> the
> start of emacs-module.c that says "Do NOT use 'eassert'". To play it safe
> for
> now I removed the easserts, and thought I'd raise this on emacs-discuss.
>
> As I understand it, emacs-module.c's use of eassert is intended for bugs in
> Emacs itself, not for bugs in user-supplied modules. Although perhaps we
> need a
> more-systematic way of issuing signals for screwups in modules, 'eassert'
> sounds
> dicey for that as assertion failures are so drastic. Even though modules
> can
> dump core on their own, should Emacs be on high alert and dump core merely
> because a module has an invalid value? Plus, should ENABLE_CHECKING affect
> module-screwup checking the same way that it affects eassert?
>
I think you are right, eassert is the wrong tool here. If at all, module
developers can be expected to use normal release builds of Emacs, so
eassert wouldn't help them.
In the attached patch I've implemented a command-line option
'-module-assertions' that allows these assertions to be enabled at runtime.
The option is meant to be used during development for batch jobs and
sessions where crashing is OK.
(The commit doesn't contain documentation yet.)
> Instead of using runtime checks, perhaps we should decorate
> emacs-module.h's
> function declarations with __attribute__ ((__nonnull__ ((N)))) if argument
> N of
> a module function is supposed to be nonnull, so that problems in this area
> can
> (mostly) be caught statically. We could add a macro like the following to
> src/emacs-module.h, after the definition of EMACS_NOEXCEPT:
>
> #if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
> # define EMACS_ARG_NONNULL(...) __attribute__ ((__nonnull__
> ((__VA_ARGS__))))
> #else
> # define EMACS_ARG_NONNULL(...)
> #endif
>
> and then use EMACS_ARG_NONNULL calls for function pointers whose arguments
> are
> supposed to be nonnull.
>
>
Yes, that makes sense. Instead of the explicit version check (that might
not work with other compilers), __has_attribute should be used if
available.
[-- Attachment #1.2: Type: text/html, Size: 2827 bytes --]
[-- Attachment #2: 0001-Implement-module-assertions-for-users.txt --]
[-- Type: text/plain, Size: 16969 bytes --]
From af5c3e201428bb3d0c092a25fae0d0cb205329b9 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Mon, 5 Jun 2017 13:29:14 +0200
Subject: [PATCH] Implement module assertions for users
Add a new command-line option '-module-assertions' that users can
enable developing or debugging a module. If this option is present,
Emacs performs additional checks to verify that modules fulfill their
requirements. These checks are expensive and crash Emacs if modules
are invalid, so disable them by default.
This is a command-line option instead of an ordinary variable because
changing it while Emacs is running would cause data structure
imbalances.
* src/emacs.c (main): New command line option '-module-assertions'.
* src/emacs-module.c (assert_main_thread, assert_runtime, assert_env)
(assert_value): New functions to assert module requirements.
(syms_of_module): New uninterned variable 'module-runtimes'.
(init_module_assertions, in_main_thread): New helper functions.
(initialize_environment): Initialize value list.
(finalize_environment): Reset value list.
(finalize_runtime_unwind): Pop module runtime object stack.
(value_to_lisp): Assert that the value is valid.
(lisp_to_value): Record new value if assertions are enabled.
(MODULE_FUNCTION_BEGIN_NO_CATCH)
(module_non_local_exit_check, module_non_local_exit_clear)
(module_non_local_exit_get, module_non_local_exit_signal)
(module_non_local_exit_throw): Assert thread and environment.
(module_get_environment): Assert thread and runtime.
(module_make_function, module_funcall, module_intern)
(module_funcall, module_make_integer, module_make_float)
(module_make_string, module_make_user_ptr, module_vec_get)
(funcall_module): Adapt callers.
* test/Makefile.in (EMACSOPT): Enable module assertions when testing
modules.
---
src/emacs-module.c | 151 +++++++++++++++++++++++++++++++++++++++++++----------
src/emacs.c | 7 +++
src/lisp.h | 1 +
test/Makefile.in | 2 +-
4 files changed, 132 insertions(+), 29 deletions(-)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index bebfe59442..f4218aa012 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -77,6 +77,10 @@ struct emacs_env_private
storage is always available for them, even in an out-of-memory
situation. */
Lisp_Object non_local_exit_symbol, non_local_exit_data;
+
+ /* Values allocated from this environment. Only used if
+ `module-assertions' is t. */
+ Lisp_Object values;
};
/* The private parts of an `emacs_runtime' object contain the initial
@@ -92,9 +96,12 @@ struct emacs_runtime_private
struct module_fun_env;
static Lisp_Object value_to_lisp (emacs_value);
-static emacs_value lisp_to_value (Lisp_Object);
+static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
-static void check_main_thread (void);
+static void assert_main_thread (void);
+static void assert_runtime (struct emacs_runtime *);
+static void assert_env (emacs_env *);
+static void assert_value (Lisp_Object);
static void initialize_environment (emacs_env *, struct emacs_env_private *);
static void finalize_environment (emacs_env *);
static void finalize_environment_unwind (void *);
@@ -112,6 +119,8 @@ static void module_reset_handlerlist (struct handler *const *);
code should not assume this. */
verify (NIL_IS_ZERO);
static emacs_value const module_nil = 0;
+
+static bool module_assertions;
\f
/* Convenience macros for non-local exit handling. */
@@ -215,7 +224,8 @@ static emacs_value const module_nil = 0;
#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
do { \
- check_main_thread (); \
+ assert_main_thread (); \
+ assert_env (env); \
if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
return error_retval; \
} while (false)
@@ -241,7 +251,8 @@ CHECK_USER_PTR (Lisp_Object obj)
static emacs_env *
module_get_environment (struct emacs_runtime *ert)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_runtime (ert);
return &ert->private_members->pub;
}
@@ -271,7 +282,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
hash_put (h, new_obj, make_natnum (1), hashcode);
}
- return lisp_to_value (new_obj);
+ return lisp_to_value (env, new_obj);
}
static void
@@ -303,27 +314,30 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
static enum emacs_funcall_exit
module_non_local_exit_check (emacs_env *env)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_env (env);
return env->private_members->pending_non_local_exit;
}
static void
module_non_local_exit_clear (emacs_env *env)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_env (env);
env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
}
static enum emacs_funcall_exit
module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_env (env);
struct emacs_env_private *p = env->private_members;
if (p->pending_non_local_exit != emacs_funcall_exit_return)
{
/* FIXME: lisp_to_value can exit non-locally. */
- *sym = lisp_to_value (p->non_local_exit_symbol);
- *data = lisp_to_value (p->non_local_exit_data);
+ *sym = lisp_to_value (env, p->non_local_exit_symbol);
+ *data = lisp_to_value (env, p->non_local_exit_data);
}
return p->pending_non_local_exit;
}
@@ -332,7 +346,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
static void
module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_signal_1 (env, value_to_lisp (sym),
value_to_lisp (data));
@@ -341,7 +356,8 @@ module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
static void
module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
{
- check_main_thread ();
+ assert_main_thread ();
+ assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_throw_1 (env, value_to_lisp (tag),
value_to_lisp (value));
@@ -381,7 +397,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
XSET_MODULE_FUNCTION (result, function);
eassert (MODULE_FUNCTIONP (result));
- return lisp_to_value (result);
+ return lisp_to_value (env, result);
}
static emacs_value
@@ -401,7 +417,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
newargs[0] = value_to_lisp (fun);
for (ptrdiff_t i = 0; i < nargs; i++)
newargs[1 + i] = value_to_lisp (args[i]);
- emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs));
+ emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
SAFE_FREE ();
return result;
}
@@ -410,14 +426,14 @@ static emacs_value
module_intern (emacs_env *env, const char *name)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (intern (name));
+ return lisp_to_value (env, intern (name));
}
static emacs_value
module_type_of (emacs_env *env, emacs_value value)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (Ftype_of (value_to_lisp (value)));
+ return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
}
static bool
@@ -449,7 +465,7 @@ module_make_integer (emacs_env *env, intmax_t n)
MODULE_FUNCTION_BEGIN (module_nil);
if (FIXNUM_OVERFLOW_P (n))
xsignal0 (Qoverflow_error);
- return lisp_to_value (make_number (n));
+ return lisp_to_value (env, make_number (n));
}
static double
@@ -465,7 +481,7 @@ static emacs_value
module_make_float (emacs_env *env, double d)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_float (d));
+ return lisp_to_value (env, make_float (d));
}
static bool
@@ -507,14 +523,15 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
if (! (0 <= length && length <= STRING_BYTES_BOUND))
xsignal0 (Qoverflow_error);
AUTO_STRING_WITH_LEN (lstr, str, length);
- return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
+ return lisp_to_value (env,
+ code_convert_string_norecord (lstr, Qutf_8, false));
}
static emacs_value
module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_user_ptr (fin, ptr));
+ return lisp_to_value (env, make_user_ptr (fin, ptr));
}
static void *
@@ -581,7 +598,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
MODULE_FUNCTION_BEGIN (module_nil);
Lisp_Object lvec = value_to_lisp (vec);
check_vec_index (lvec, i);
- return lisp_to_value (AREF (lvec, i));
+ return lisp_to_value (env, AREF (lvec, i));
}
static ptrdiff_t
@@ -636,6 +653,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
.private_members = &rt,
.get_environment = module_get_environment
};
+ Vmodule_runtimes = Fcons (make_save_ptr (&pub), Vmodule_runtimes);
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_ptr (finalize_runtime_unwind, &pub);
@@ -668,13 +686,13 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
USE_SAFE_ALLOCA;
ATTRIBUTE_MAY_ALIAS emacs_value *args;
- if (plain_values)
+ if (plain_values && ! module_assertions)
args = (emacs_value *) arglist;
else
{
args = SAFE_ALLOCA (nargs * sizeof *args);
for (ptrdiff_t i = 0; i < nargs; i++)
- args[i] = lisp_to_value (arglist[i]);
+ args[i] = lisp_to_value (&pub, arglist[i]);
}
emacs_value ret = func->subr (&pub, nargs, args, func->data);
@@ -711,17 +729,72 @@ module_function_arity (const struct Lisp_Module_Function *const function)
\f
/* Helper functions. */
-static void
-check_main_thread (void)
+static bool
+in_main_thread (void)
{
#ifdef HAVE_PTHREAD
- eassert (pthread_equal (pthread_self (), main_thread_id));
+ return pthread_equal (pthread_self (), main_thread_id);
#elif defined WINDOWSNT
- eassert (GetCurrentThreadId () == dwMainThreadId);
+ return GetCurrentThreadId () == dwMainThreadId;
#endif
}
static void
+assert_main_thread (void)
+{
+ if (! module_assertions || in_main_thread ())
+ return;
+ die ("Module function called from outside the main thread",
+ __FILE__, __LINE__);
+}
+
+static void
+assert_runtime (struct emacs_runtime *ert)
+{
+ if (! module_assertions)
+ return;
+ Lisp_Object tail = Vmodule_runtimes;
+ FOR_EACH_TAIL_SAFE (tail)
+ {
+ if (XSAVE_POINTER (XCAR (tail), 0) == ert)
+ return;
+ }
+ die ("Invalid runtime pointer passed to module function", __FILE__, __LINE__);
+}
+
+static void
+assert_env (emacs_env *env)
+{
+ if (! module_assertions)
+ return;
+ Lisp_Object tail = Vmodule_environments;
+ FOR_EACH_TAIL_SAFE (tail)
+ if (XSAVE_POINTER (XCAR (tail), 0) == env)
+ return;
+ die ("Invalid environment pointer passed to module function",
+ __FILE__, __LINE__);
+}
+
+static void
+assert_value (Lisp_Object object)
+{
+ if (! module_assertions)
+ return;
+ Lisp_Object environments = Vmodule_environments;
+ FOR_EACH_TAIL_SAFE (environments)
+ {
+ emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
+ Lisp_Object values = env->private_members->values;
+ FOR_EACH_TAIL_SAFE (values)
+ if (EQ (XCAR (values), object))
+ return;
+ }
+ if (hash_lookup (XHASH_TABLE (Vmodule_refs_hash), object, NULL) >= 0)
+ return;
+ die ("Invalid value passed to module function", __FILE__, __LINE__);
+}
+
+static void
module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
Lisp_Object data)
{
@@ -809,6 +882,7 @@ value_to_lisp (emacs_value v)
Lisp_Object o = value_to_lisp_bits (v);
if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
o = XCAR (o);
+ assert_value (o);
return o;
}
@@ -834,7 +908,7 @@ enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
/* Convert O to an emacs_value. Allocate storage if needed; this can
signal if memory is exhausted. Must be an injective function. */
static emacs_value
-lisp_to_value (Lisp_Object o)
+lisp_to_value (emacs_env *env, Lisp_Object o)
{
emacs_value v = lisp_to_value_bits (o);
@@ -859,6 +933,9 @@ lisp_to_value (Lisp_Object o)
v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons);
}
+ if (module_assertions)
+ env->private_members->values = Fcons (o, env->private_members->values);
+
eassert (EQ (o, value_to_lisp (v)));
return v;
}
@@ -871,6 +948,7 @@ static void
initialize_environment (emacs_env *env, struct emacs_env_private *priv)
{
priv->pending_non_local_exit = emacs_funcall_exit_return;
+ priv->values = Qnil;
env->size = sizeof *env;
env->private_members = priv;
env->make_global_ref = module_make_global_ref;
@@ -909,6 +987,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
static void
finalize_environment (emacs_env *env)
{
+ env->private_members->values = Qnil;
eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
Vmodule_environments = XCDR (Vmodule_environments);
}
@@ -923,6 +1002,8 @@ static void
finalize_runtime_unwind (void* raw_ert)
{
struct emacs_runtime *ert = raw_ert;
+ eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
+ Vmodule_runtimes = XCDR (Vmodule_runtimes);
finalize_environment (&ert->private_members->pub);
}
@@ -961,6 +1042,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
/* Segment initializer. */
void
+init_module_assertions (bool enable)
+{
+ module_assertions = enable;
+}
+
+void
syms_of_module (void)
{
if (!plain_values)
@@ -977,6 +1064,14 @@ syms_of_module (void)
Qnil, false);
Funintern (Qmodule_refs_hash, Qnil);
+ DEFSYM (Qmodule_runtimes, "module-runtimes");
+ DEFVAR_LISP ("module-runtimes", Vmodule_runtimes,
+ doc: /* List of active module runtimes. */);
+ Vmodule_runtimes = Qnil;
+ /* Unintern `module-runtimes' because it is only used
+ internally. */
+ Funintern (Qmodule_runtimes, Qnil);
+
DEFSYM (Qmodule_environments, "module-environments");
DEFVAR_LISP ("module-environments", Vmodule_environments,
doc: /* List of active module environments. */);
diff --git a/src/emacs.c b/src/emacs.c
index 49ebb81767..74b906a18e 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1263,6 +1263,12 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
build_details = ! argmatch (argv, argc, "-no-build-details",
"--no-build-details", 7, NULL, &skip_args);
+#ifdef HAVE_MODULES
+ init_module_assertions (argmatch (argv, argc, "-module-assertions",
+ "--module-assertions", 15, NULL,
+ &skip_args));
+#endif
+
#ifdef HAVE_NS
ns_pool = ns_alloc_autorelease_pool ();
#ifdef NS_IMPL_GNUSTEP
@@ -1720,6 +1726,7 @@ static const struct standard_args standard_args[] =
{ "-nl", "--no-loadup", 70, 0 },
{ "-nsl", "--no-site-lisp", 65, 0 },
{ "-no-build-details", "--no-build-details", 63, 0 },
+ { "-module-assertions", "--module-assertions", 62, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
diff --git a/src/lisp.h b/src/lisp.h
index c35bd1f6df..91de75e4a3 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3958,6 +3958,7 @@ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
/* Defined in emacs-module.c. */
extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
+extern void init_module_assertions (bool);
extern void syms_of_module (void);
#endif
diff --git a/test/Makefile.in b/test/Makefile.in
index 7b8c967128..0c24c48e60 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -68,7 +68,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = -batch --no-site-file --no-site-lisp -module-assertions -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
--
2.13.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-05 13:56 ` Philipp Stephani
@ 2017-06-05 15:33 ` Eli Zaretskii
2017-06-11 13:50 ` Philipp Stephani
0 siblings, 1 reply; 7+ messages in thread
From: Eli Zaretskii @ 2017-06-05 15:33 UTC (permalink / raw)
To: Philipp Stephani; +Cc: phst, eggert, emacs-devel
> From: Philipp Stephani <p.stephani2@gmail.com>
> Date: Mon, 05 Jun 2017 13:56:57 +0000
> Cc: Emacs Development <emacs-devel@gnu.org>
>
> * src/emacs-module.c (assert_main_thread, assert_runtime, assert_env)
> (assert_value): New functions to assert module requirements.
I'd prefer to have these functions called module_assert_SOMETHING.
Thanks.
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-05 15:33 ` Eli Zaretskii
@ 2017-06-11 13:50 ` Philipp Stephani
2017-06-11 17:45 ` Paul Eggert
0 siblings, 1 reply; 7+ messages in thread
From: Philipp Stephani @ 2017-06-11 13:50 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: phst, eggert, emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 576 bytes --]
Eli Zaretskii <eliz@gnu.org> schrieb am Mo., 5. Juni 2017 um 17:34 Uhr:
> > From: Philipp Stephani <p.stephani2@gmail.com>
> > Date: Mon, 05 Jun 2017 13:56:57 +0000
> > Cc: Emacs Development <emacs-devel@gnu.org>
> >
> > * src/emacs-module.c (assert_main_thread, assert_runtime, assert_env)
> > (assert_value): New functions to assert module requirements.
>
> I'd prefer to have these functions called module_assert_SOMETHING.
>
>
Here's a new patch. It makes this change, and also changes the allocation
slightly so that objects have unique addresses (useful for checking).
[-- Attachment #1.2: Type: text/html, Size: 1023 bytes --]
[-- Attachment #2: 0001-Implement-module-assertions-for-users.txt --]
[-- Type: text/plain, Size: 29646 bytes --]
From 7063694052481abeeb3bb426bae4e8853e023ac4 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Mon, 5 Jun 2017 13:29:14 +0200
Subject: [PATCH] Implement module assertions for users
Add a new command-line option '-module-assertions' that users can
enable developing or debugging a module. If this option is present,
Emacs performs additional checks to verify that modules fulfill their
requirements. These checks are expensive and crash Emacs if modules
are invalid, so disable them by default.
This is a command-line option instead of an ordinary variable because
changing it while Emacs is running would cause data structure
imbalances.
* src/emacs.c (main): New command line option '-module-assertions'.
* src/emacs-module.c (module_assert_main_thread)
(module_assert_runtime, module_assert_env, module_assert_value):
New functions to assert module requirements.
(syms_of_module): New uninterned variable 'module-runtimes'.
(init_module_assertions, in_main_thread): New helper functions.
(initialize_environment): Initialize value list. If assertions are
enabled, use a heap-allocated environment object.
(finalize_environment): Add assertion that environment list is never
empty.
(finalize_runtime_unwind): Pop module runtime object stack.
(value_to_lisp): Assert that the value is valid.
(lisp_to_value): Record new value if assertions are enabled.
(mark_modules): Mark allocated object list.
(MODULE_FUNCTION_BEGIN_NO_CATCH)
(module_non_local_exit_check, module_non_local_exit_clear)
(module_non_local_exit_get, module_non_local_exit_signal)
(module_non_local_exit_throw): Assert thread and environment.
(module_get_environment): Assert thread and runtime.
(module_make_function, module_funcall, module_intern)
(module_funcall, module_make_integer, module_make_float)
(module_make_string, module_make_user_ptr, module_vec_get)
(funcall_module, Fmodule_load): Adapt callers.
(module_make_global_ref): If assertions are enabled, use the global
environment to store global values.
(module_free_global_ref): Remove value from global value list.
* test/Makefile.in (EMACSOPT): Enable module assertions when testing
modules.
* test/data/emacs-module/mod-test.c (Fmod_test_invalid_store)
(Fmod_test_invalid_load): New functions to test module assertions.
(emacs_module_init): Bind the new functions.
* test/src/emacs-module-tests.el (mod-test-emacs): New constant for
the Emacs binary file.
(mod-test-file): New constant for the test module file name.
(module--test-assertions): New unit test.
---
etc/NEWS | 6 +
src/emacs-module.c | 279 +++++++++++++++++++++++++++++++-------
src/emacs.c | 8 ++
src/lisp.h | 1 +
test/Makefile.in | 2 +-
test/data/emacs-module/mod-test.c | 24 ++++
test/src/emacs-module-tests.el | 39 +++++-
7 files changed, 303 insertions(+), 56 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7972511f7a..feed62c1ca 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -85,6 +85,12 @@ modern init systems such as systemd, which manage many of the traditional
aspects of daemon behavior themselves. '--bg-daemon' is now an alias
for '--daemon'.
+** New option '--module-assertions'. If the user supplies this
+option, Emacs will perform expensive correctness checks when dealing
+with dynamic modules. This is intended for module authors that wish
+to verify that their module conforms to the module requirements. The
+option makes Emacs abort if a module-related assertion triggers.
+
+++
** Emacs now supports 24-bit colors on capable text terminals
Terminal is automatically initialized to use 24-bit colors if the
diff --git a/src/emacs-module.c b/src/emacs-module.c
index c0f2c3fcd0..6ac6f892c7 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -34,6 +34,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <intprops.h>
#include <verify.h>
+/* We use different strategies for allocating the user-visible objects
+ (struct emacs_runtime, emacs_env, emacs_value), depending on
+ whether the user supplied the -module-assertions flag. If
+ assertions are disabled, all objects are allocated from the stack.
+ If assertions are enabled, all objects are allocated from the free
+ store, and objects are never freed; this guarantees that they all
+ have different addresses. We use that for checking which objects
+ are live. Without unique addresses, we might consider some dead
+ objects live because their addresses would have been reused in the
+ meantime. */
+
\f
/* Feature tests. */
@@ -77,25 +88,30 @@ struct emacs_env_private
storage is always available for them, even in an out-of-memory
situation. */
Lisp_Object non_local_exit_symbol, non_local_exit_data;
+
+ /* List of values allocated from this environment. The code uses
+ this only if the user gave the -module-assertions command-line
+ option. */
+ Lisp_Object values;
};
/* The private parts of an `emacs_runtime' object contain the initial
environment. */
struct emacs_runtime_private
{
- emacs_env pub;
+ emacs_env *env;
};
\f
/* Forward declarations. */
-struct module_fun_env;
-
static Lisp_Object value_to_lisp (emacs_value);
-static emacs_value lisp_to_value (Lisp_Object);
+static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
-static void check_main_thread (void);
-static void initialize_environment (emacs_env *, struct emacs_env_private *);
+static void module_assert_main_thread (void);
+static void module_assert_runtime (struct emacs_runtime *);
+static void module_assert_env (emacs_env *);
+static emacs_env *initialize_environment (emacs_env *, struct emacs_env_private *);
static void finalize_environment (emacs_env *);
static void finalize_environment_unwind (void *);
static void finalize_runtime_unwind (void *);
@@ -112,6 +128,10 @@ static void module_reset_handlerlist (struct handler *const *);
code should not assume this. */
verify (NIL_IS_ZERO);
static emacs_value const module_nil = 0;
+
+static bool module_assertions = false;
+static emacs_env *global_env;
+static struct emacs_env_private global_env_private;
\f
/* Convenience macros for non-local exit handling. */
@@ -215,7 +235,8 @@ static emacs_value const module_nil = 0;
#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
do { \
- check_main_thread (); \
+ module_assert_main_thread (); \
+ module_assert_env (env); \
if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
return error_retval; \
} while (false)
@@ -241,8 +262,9 @@ CHECK_USER_PTR (Lisp_Object obj)
static emacs_env *
module_get_environment (struct emacs_runtime *ert)
{
- check_main_thread ();
- return &ert->private_members->pub;
+ module_assert_main_thread ();
+ module_assert_runtime (ert);
+ return ert->private_members->env;
}
/* To make global refs (GC-protected global values) keep a hash that
@@ -271,7 +293,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
hash_put (h, new_obj, make_natnum (1), hashcode);
}
- return lisp_to_value (new_obj);
+ return lisp_to_value (module_assertions ? global_env : env, new_obj);
}
static void
@@ -298,32 +320,55 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
else
hash_remove_from_table (h, value);
}
+
+ if (module_assertions)
+ {
+ Lisp_Object globals = global_env_private.values;
+ Lisp_Object prev = Qnil;
+ FOR_EACH_TAIL_SAFE (globals)
+ {
+ emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
+ if (global == ref)
+ {
+ if (NILP (prev))
+ global_env_private.values = XCDR (globals);
+ else
+ XSETCDR (prev, XCDR (globals));
+ return;
+ }
+ prev = globals;
+ }
+ die ("Global value was not allocated", __FILE__, __LINE__);
+ }
}
static enum emacs_funcall_exit
module_non_local_exit_check (emacs_env *env)
{
- check_main_thread ();
+ module_assert_main_thread ();
+ module_assert_env (env);
return env->private_members->pending_non_local_exit;
}
static void
module_non_local_exit_clear (emacs_env *env)
{
- check_main_thread ();
+ module_assert_main_thread ();
+ module_assert_env (env);
env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
}
static enum emacs_funcall_exit
module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
{
- check_main_thread ();
+ module_assert_main_thread ();
+ module_assert_env (env);
struct emacs_env_private *p = env->private_members;
if (p->pending_non_local_exit != emacs_funcall_exit_return)
{
/* FIXME: lisp_to_value can exit non-locally. */
- *sym = lisp_to_value (p->non_local_exit_symbol);
- *data = lisp_to_value (p->non_local_exit_data);
+ *sym = lisp_to_value (env, p->non_local_exit_symbol);
+ *data = lisp_to_value (env, p->non_local_exit_data);
}
return p->pending_non_local_exit;
}
@@ -332,7 +377,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
static void
module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
{
- check_main_thread ();
+ module_assert_main_thread ();
+ module_assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_signal_1 (env, value_to_lisp (sym),
value_to_lisp (data));
@@ -341,7 +387,8 @@ module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
static void
module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
{
- check_main_thread ();
+ module_assert_main_thread ();
+ module_assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_throw_1 (env, value_to_lisp (tag),
value_to_lisp (value));
@@ -381,7 +428,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
XSET_MODULE_FUNCTION (result, function);
eassert (MODULE_FUNCTIONP (result));
- return lisp_to_value (result);
+ return lisp_to_value (env, result);
}
static emacs_value
@@ -401,7 +448,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
newargs[0] = value_to_lisp (fun);
for (ptrdiff_t i = 0; i < nargs; i++)
newargs[1 + i] = value_to_lisp (args[i]);
- emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs));
+ emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
SAFE_FREE ();
return result;
}
@@ -410,14 +457,14 @@ static emacs_value
module_intern (emacs_env *env, const char *name)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (intern (name));
+ return lisp_to_value (env, intern (name));
}
static emacs_value
module_type_of (emacs_env *env, emacs_value value)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (Ftype_of (value_to_lisp (value)));
+ return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
}
static bool
@@ -449,7 +496,7 @@ module_make_integer (emacs_env *env, intmax_t n)
MODULE_FUNCTION_BEGIN (module_nil);
if (FIXNUM_OVERFLOW_P (n))
xsignal0 (Qoverflow_error);
- return lisp_to_value (make_number (n));
+ return lisp_to_value (env, make_number (n));
}
static double
@@ -465,7 +512,7 @@ static emacs_value
module_make_float (emacs_env *env, double d)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_float (d));
+ return lisp_to_value (env, make_float (d));
}
static bool
@@ -507,14 +554,15 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
if (! (0 <= length && length <= STRING_BYTES_BOUND))
xsignal0 (Qoverflow_error);
AUTO_STRING_WITH_LEN (lstr, str, length);
- return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
+ return lisp_to_value (env,
+ code_convert_string_norecord (lstr, Qutf_8, false));
}
static emacs_value
module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_user_ptr (fin, ptr));
+ return lisp_to_value (env, make_user_ptr (fin, ptr));
}
static void *
@@ -581,7 +629,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
MODULE_FUNCTION_BEGIN (module_nil);
Lisp_Object lvec = value_to_lisp (vec);
check_vec_index (lvec, i);
- return lisp_to_value (AREF (lvec, i));
+ return lisp_to_value (env, AREF (lvec, i));
}
static ptrdiff_t
@@ -643,19 +691,27 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
if (!module_init)
xsignal1 (Qmissing_module_init_function, file);
- struct emacs_runtime_private rt; /* Includes the public emacs_env. */
- struct emacs_env_private priv;
- initialize_environment (&rt.pub, &priv);
- struct emacs_runtime pub =
- {
- .size = sizeof pub,
- .private_members = &rt,
- .get_environment = module_get_environment
- };
+ struct emacs_runtime rt_pub;
+ struct emacs_runtime_private rt_priv;
+ emacs_env env_pub;
+ struct emacs_env_private env_priv;
+ rt_priv.env = initialize_environment (&env_pub, &env_priv);
+
+ /* If we should use module assertions, reallocate the runtime object
+ from the free store, but never free it. That way the addresses
+ for two different runtime objects are guaranteed to be distinct,
+ which we can use for checking the liveness of runtime
+ pointers. */
+ struct emacs_runtime *rt = module_assertions ? xmalloc (sizeof *rt) : &rt_pub;
+ rt->size = sizeof *rt;
+ rt->private_members = &rt_priv;
+ rt->get_environment = module_get_environment;
+
+ Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_runtime_unwind, &pub);
+ record_unwind_protect_ptr (finalize_runtime_unwind, rt);
- int r = module_init (&pub);
+ int r = module_init (rt);
/* Process the quit flag first, so that quitting doesn't get
overridden by other non-local exits. */
@@ -683,25 +739,25 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
emacs_env pub;
struct emacs_env_private priv;
- initialize_environment (&pub, &priv);
+ emacs_env *env = initialize_environment (&pub, &priv);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_environment_unwind, &pub);
+ record_unwind_protect_ptr (finalize_environment_unwind, env);
USE_SAFE_ALLOCA;
ATTRIBUTE_MAY_ALIAS emacs_value *args;
- if (plain_values)
+ if (plain_values && ! module_assertions)
args = (emacs_value *) arglist;
else
{
args = SAFE_ALLOCA (nargs * sizeof *args);
for (ptrdiff_t i = 0; i < nargs; i++)
- args[i] = lisp_to_value (arglist[i]);
+ args[i] = lisp_to_value (env, arglist[i]);
}
- emacs_value ret = func->subr (&pub, nargs, args, func->data);
+ emacs_value ret = func->subr (env, nargs, args, func->data);
SAFE_FREE ();
- eassert (&priv == pub.private_members);
+ eassert (&priv == env->private_members);
/* Process the quit flag first, so that quitting doesn't get
overridden by other non-local exits. */
@@ -723,17 +779,53 @@ module_function_arity (const struct Lisp_Module_Function *const function)
\f
/* Helper functions. */
-static void
-check_main_thread (void)
+static bool
+in_main_thread (void)
{
#ifdef HAVE_PTHREAD
- eassert (pthread_equal (pthread_self (), main_thread_id));
+ return pthread_equal (pthread_self (), main_thread_id);
#elif defined WINDOWSNT
- eassert (GetCurrentThreadId () == dwMainThreadId);
+ return GetCurrentThreadId () == dwMainThreadId;
#endif
}
static void
+module_assert_main_thread (void)
+{
+ if (! module_assertions || in_main_thread ())
+ return;
+ die ("Module function called from outside the main thread",
+ __FILE__, __LINE__);
+}
+
+static void
+module_assert_runtime (struct emacs_runtime *ert)
+{
+ if (! module_assertions)
+ return;
+ Lisp_Object tail = Vmodule_runtimes;
+ FOR_EACH_TAIL_SAFE (tail)
+ {
+ if (XSAVE_POINTER (XCAR (tail), 0) == ert)
+ return;
+ }
+ die ("Invalid runtime pointer passed to module function", __FILE__, __LINE__);
+}
+
+static void
+module_assert_env (emacs_env *env)
+{
+ if (! module_assertions)
+ return;
+ Lisp_Object tail = Vmodule_environments;
+ FOR_EACH_TAIL_SAFE (tail)
+ if (XSAVE_POINTER (XCAR (tail), 0) == env)
+ return;
+ die ("Invalid environment pointer passed to module function",
+ __FILE__, __LINE__);
+}
+
+static void
module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
Lisp_Object data)
{
@@ -772,6 +864,14 @@ module_out_of_memory (emacs_env *env)
\f
/* Value conversion. */
+/* We represent Lisp objects differently depending on whether the user
+ gave -module-assertions. If assertions are disabled, emacs_value
+ objects are Lisp_Objects cast to emacs_value. If assertions are
+ enabled, emacs_value objects are pointers to Lisp_Object objects
+ allocated from the free store; they are never freed, which ensures
+ that their addresses are unique and can be used for liveness
+ checking. */
+
/* Unique Lisp_Object used to mark those emacs_values which are really
just containers holding a Lisp_Object that does not fit as an emacs_value,
either because it is an integer out of range, or is not properly aligned.
@@ -818,6 +918,27 @@ value_to_lisp_bits (emacs_value v)
static Lisp_Object
value_to_lisp (emacs_value v)
{
+ if (module_assertions)
+ {
+ /* Check the liveness of the value by iterating over all live
+ environments. */
+ void *vptr = v;
+ ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr;
+ Lisp_Object environments = Vmodule_environments;
+ FOR_EACH_TAIL_SAFE (environments)
+ {
+ emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
+ Lisp_Object values = env->private_members->values;
+ FOR_EACH_TAIL_SAFE (values)
+ {
+ Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0);
+ if (p == optr)
+ return *p;
+ }
+ }
+ die ("Emacs value is not live", __FILE__, __LINE__);
+ }
+
Lisp_Object o = value_to_lisp_bits (v);
if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
o = XCAR (o);
@@ -846,8 +967,23 @@ enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
/* Convert O to an emacs_value. Allocate storage if needed; this can
signal if memory is exhausted. Must be an injective function. */
static emacs_value
-lisp_to_value (Lisp_Object o)
+lisp_to_value (emacs_env *env, Lisp_Object o)
{
+ if (module_assertions)
+ {
+ /* Add the new value to the list of values allocated from this
+ environment. The value is actually a pointer to the
+ Lisp_Object cast to emacs_value. We make a copy of the
+ object on the free store to guarantee unique addresses. */
+ ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o);
+ *optr = o;
+ void *vptr = optr;
+ ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
+ struct emacs_env_private *priv = env->private_members;
+ priv->values = Fcons (make_save_ptr (ret), priv->values);
+ return ret;
+ }
+
emacs_value v = lisp_to_value_bits (o);
if (! EQ (o, value_to_lisp_bits (v)))
@@ -878,12 +1014,20 @@ lisp_to_value (Lisp_Object o)
\f
/* Environment lifetime management. */
-/* Must be called before the environment can be used. */
-static void
+/* Must be called before the environment can be used. Returns another
+ pointer that callers should use instead of the ENV argument. If
+ module assertions are disabled, the return value is ENV. If module
+ assertions are enabled, the return value points to a heap-allocated
+ object. That object is never freed to guarantee unique
+ addresses. */
+static emacs_env *
initialize_environment (emacs_env *env, struct emacs_env_private *priv)
{
+ if (module_assertions)
+ env = xmalloc (sizeof *env);
+
priv->pending_non_local_exit = emacs_funcall_exit_return;
- priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
+ priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
env->size = sizeof *env;
env->private_members = priv;
env->make_global_ref = module_make_global_ref;
@@ -915,6 +1059,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->vec_size = module_vec_size;
env->should_quit = module_should_quit;
Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
+ return env;
}
/* Must be called before the lifetime of the environment object
@@ -924,6 +1069,9 @@ finalize_environment (emacs_env *env)
{
eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
Vmodule_environments = XCDR (Vmodule_environments);
+ if (module_assertions)
+ /* There is always at least the global environment. */
+ eassert (CONSP (Vmodule_environments));
}
static void
@@ -936,7 +1084,9 @@ static void
finalize_runtime_unwind (void* raw_ert)
{
struct emacs_runtime *ert = raw_ert;
- finalize_environment (&ert->private_members->pub);
+ eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
+ Vmodule_runtimes = XCDR (Vmodule_runtimes);
+ finalize_environment (ert->private_members->env);
}
void
@@ -949,6 +1099,7 @@ mark_modules (void)
struct emacs_env_private *priv = env->private_members;
mark_object (priv->non_local_exit_symbol);
mark_object (priv->non_local_exit_data);
+ mark_object (priv->values);
}
}
@@ -984,6 +1135,22 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
}
\f
+/* Support for assertions. */
+void
+init_module_assertions (bool enable)
+{
+ module_assertions = enable;
+ if (enable)
+ {
+ /* We use a hidden environment for storing the globals. This
+ environment is never freed. */
+ emacs_env env;
+ global_env = initialize_environment (&env, &global_env_private);
+ eassert (global_env != &env);
+ }
+}
+
+\f
/* Segment initializer. */
void
@@ -1003,6 +1170,14 @@ syms_of_module (void)
Qnil, false);
Funintern (Qmodule_refs_hash, Qnil);
+ DEFSYM (Qmodule_runtimes, "module-runtimes");
+ DEFVAR_LISP ("module-runtimes", Vmodule_runtimes,
+ doc: /* List of active module runtimes. */);
+ Vmodule_runtimes = Qnil;
+ /* Unintern `module-runtimes' because it is only used
+ internally. */
+ Funintern (Qmodule_runtimes, Qnil);
+
DEFSYM (Qmodule_environments, "module-environments");
DEFVAR_LISP ("module-environments", Vmodule_environments,
doc: /* List of active module environments. */);
diff --git a/src/emacs.c b/src/emacs.c
index 49ebb81767..adefb1aa74 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -223,6 +223,7 @@ Initialization options:\n\
--fg-daemon[=NAME] start a (named) server in the foreground\n\
--debug-init enable Emacs Lisp debugger for init file\n\
--display, -d DISPLAY use X server DISPLAY\n\
+--module-assertions assert behavior of dynamic modules\n\
",
"\
--no-build-details do not add build details such as time stamps\n\
@@ -1263,6 +1264,12 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
build_details = ! argmatch (argv, argc, "-no-build-details",
"--no-build-details", 7, NULL, &skip_args);
+#ifdef HAVE_MODULES
+ init_module_assertions (argmatch (argv, argc, "-module-assertions",
+ "--module-assertions", 15, NULL,
+ &skip_args));
+#endif
+
#ifdef HAVE_NS
ns_pool = ns_alloc_autorelease_pool ();
#ifdef NS_IMPL_GNUSTEP
@@ -1720,6 +1727,7 @@ static const struct standard_args standard_args[] =
{ "-nl", "--no-loadup", 70, 0 },
{ "-nsl", "--no-site-lisp", 65, 0 },
{ "-no-build-details", "--no-build-details", 63, 0 },
+ { "-module-assertions", "--module-assertions", 62, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
diff --git a/src/lisp.h b/src/lisp.h
index ee703893e2..e7e98fb66c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3959,6 +3959,7 @@ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
extern void mark_modules (void);
+extern void init_module_assertions (bool);
extern void syms_of_module (void);
#endif
diff --git a/test/Makefile.in b/test/Makefile.in
index 7b8c967128..0c24c48e60 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -68,7 +68,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = -batch --no-site-file --no-site-lisp -module-assertions -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 309179d150..fc29a0d6b9 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -213,6 +213,28 @@ Fmod_test_vector_eq (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
return env->intern (env, "t");
}
+static emacs_value invalid_stored_value;
+
+/* The next two functions perform a possibly-invalid operation: they
+ store a value in a static variable and load it. This causes
+ undefined behavior if the environment that the value was created
+ from is no longer live. The module assertions check for this
+ error. */
+
+static emacs_value
+Fmod_test_invalid_store (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ return invalid_stored_value = env->make_integer (env, 123);
+}
+
+static emacs_value
+Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ return invalid_stored_value;
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
@@ -260,6 +282,8 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
+ DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
#undef DEFUN
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 622bbadb3e..8366eb1642 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -19,9 +19,17 @@
(require 'ert)
-(require 'mod-test
- (expand-file-name "data/emacs-module/mod-test"
- (getenv "EMACS_TEST_DIRECTORY")))
+(defconst mod-test-emacs
+ (expand-file-name invocation-name invocation-directory)
+ "File name of the Emacs binary currently running.")
+
+(eval-and-compile
+ (defconst mod-test-file
+ (substitute-in-file-name
+ "$EMACS_TEST_DIRECTORY/data/emacs-module/mod-test")
+ "File name of the module test file."))
+
+(require 'mod-test mod-test-file)
;;
;; Basic tests.
@@ -174,4 +182,29 @@ multiply-string
(should (equal (help-function-arglist #'mod-test-sum)
'(arg1 arg2))))
+(ert-deftest module--test-assertions ()
+ "Check that -module-assertions work."
+ (skip-unless (file-executable-p mod-test-emacs))
+ ;; This doesn’t yet cause undefined behavior.
+ (should (eq (mod-test-invalid-store) 123))
+ (with-temp-buffer
+ (should (equal (call-process mod-test-emacs nil t nil
+ "-batch" "-Q" "-module-assertions" "-eval"
+ (prin1-to-string
+ `(progn
+ (require 'mod-test ,mod-test-file)
+ ;; Storing and reloading a local
+ ;; value causes undefined
+ ;; behavior, which should be
+ ;; detected by the module
+ ;; assertions.
+ (mod-test-invalid-store)
+ (mod-test-invalid-load))))
+ ;; FIXME: This string is probably different on
+ ;; Windows and Linux.
+ "Abort trap: 6"))
+ (re-search-backward (rx bol "emacs-module.c" ?: (+ digit) ": "
+ "Emacs fatal error: assertion failed: "
+ "Emacs value is not live" (? ?\r) eol))))
+
;;; emacs-module-tests.el ends here
--
2.13.1
^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-11 13:50 ` Philipp Stephani
@ 2017-06-11 17:45 ` Paul Eggert
2017-06-11 20:34 ` Philipp Stephani
0 siblings, 1 reply; 7+ messages in thread
From: Paul Eggert @ 2017-06-11 17:45 UTC (permalink / raw)
To: Philipp Stephani, Eli Zaretskii; +Cc: phst, emacs-devel
Philipp Stephani wrote:
> Here's a new patch. It makes this change, and also changes the allocation
> slightly so that objects have unique addresses (useful for checking).
Thanks for working on this. Some comments.
Have you looked into the runtime overhead of this approach, assuming
-module-assertions is not specified? Currently lisp_to_value and value_to_lisp
typically are optimized away (i.e., zero machine instructions), and that
wouldn't be true under the proposed patch even when -module-assertions is not
used. Granted, module calls need not be super-fast, but it might be nice to
avoid the overhead in the typical case if that is easy.
What happens if -module-assertions is enabled for Emacs, Emacs dumps itself, and
-module-assertions is not enabled when the dumped Emacs is run? Or vice versa.
Are the FOR_EACH_TAIL_SAFE macro calls needed? This macro is needed only for
lists that might be circular (e.g., the lists are available to Lisp code, which
can call setcdr on their components). If the calls are not needed I suggest just
an ordinary for loop.
A small point: the FOR_EACH... loops should be indented like ordinary for-loops.
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-11 17:45 ` Paul Eggert
@ 2017-06-11 20:34 ` Philipp Stephani
2017-06-12 14:34 ` Philipp Stephani
0 siblings, 1 reply; 7+ messages in thread
From: Philipp Stephani @ 2017-06-11 20:34 UTC (permalink / raw)
To: Paul Eggert, Eli Zaretskii; +Cc: phst, emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 1705 bytes --]
Paul Eggert <eggert@cs.ucla.edu> schrieb am So., 11. Juni 2017 um 19:45 Uhr:
> Philipp Stephani wrote:
> > Here's a new patch. It makes this change, and also changes the allocation
> > slightly so that objects have unique addresses (useful for checking).
>
> Thanks for working on this. Some comments.
>
> Have you looked into the runtime overhead of this approach, assuming
> -module-assertions is not specified? Currently lisp_to_value and
> value_to_lisp
> typically are optimized away (i.e., zero machine instructions), and that
> wouldn't be true under the proposed patch even when -module-assertions is
> not
> used. Granted, module calls need not be super-fast, but it might be nice to
> avoid the overhead in the typical case if that is easy.
>
I've run a simple benchmark (5000000 iterations of mod-test-sum). Result
for the base case (module assertions not compiled) is 4.602 seconds, with
the new code it's 4.605 seconds. That's probably good enough.
>
> What happens if -module-assertions is enabled for Emacs, Emacs dumps
> itself, and
> -module-assertions is not enabled when the dumped Emacs is run?
Good question. I've now just made -module-assertions during dumping an
error.
> Or vice versa.
>
That's the normal case, which should work just fine.
>
> Are the FOR_EACH_TAIL_SAFE macro calls needed? This macro is needed only
> for
> lists that might be circular (e.g., the lists are available to Lisp code,
> which
> can call setcdr on their components). If the calls are not needed I
> suggest just
> an ordinary for loop.
>
Done.
>
> A small point: the FOR_EACH... loops should be indented like ordinary
> for-loops.
>
Done. (Would be great if CC-Mode knew about this.)
[-- Attachment #1.2: Type: text/html, Size: 2661 bytes --]
[-- Attachment #2: 0001-Implement-module-assertions-for-users.txt --]
[-- Type: text/plain, Size: 31884 bytes --]
From 3f2f8befae731e50c38fb7c10ffddb37042db488 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Mon, 5 Jun 2017 13:29:14 +0200
Subject: [PATCH] Implement module assertions for users
Add a new command-line option '-module-assertions' that users can
enable developing or debugging a module. If this option is present,
Emacs performs additional checks to verify that modules fulfill their
requirements. These checks are expensive and crash Emacs if modules
are invalid, so disable them by default.
This is a command-line option instead of an ordinary variable because
changing it while Emacs is running would cause data structure
imbalances.
* src/emacs.c (main): New command line option '-module-assertions'.
* src/emacs-module.c (module_assert_main_thread)
(module_assert_runtime, module_assert_env, module_assert_value):
New functions to assert module requirements.
(syms_of_module): New uninterned variable 'module-runtimes'.
(init_module_assertions, in_main_thread, module_abort): New helper
functions.
(initialize_environment): Initialize value list. If assertions are
enabled, use a heap-allocated environment object.
(finalize_environment): Add assertion that environment list is never
empty.
(finalize_runtime_unwind): Pop module runtime object stack.
(value_to_lisp): Assert that the value is valid.
(lisp_to_value): Record new value if assertions are enabled.
(mark_modules): Mark allocated object list.
(MODULE_FUNCTION_BEGIN_NO_CATCH)
(module_non_local_exit_check, module_non_local_exit_clear)
(module_non_local_exit_get, module_non_local_exit_signal)
(module_non_local_exit_throw): Assert thread and environment.
(module_get_environment): Assert thread and runtime.
(module_make_function, module_funcall, module_intern)
(module_funcall, module_make_integer, module_make_float)
(module_make_string, module_make_user_ptr, module_vec_get)
(funcall_module, Fmodule_load): Adapt callers.
(module_make_global_ref): If assertions are enabled, use the global
environment to store global values.
(module_free_global_ref): Remove value from global value list.
* test/Makefile.in (EMACSOPT): Enable module assertions when testing
modules.
* test/data/emacs-module/mod-test.c (Fmod_test_invalid_store)
(Fmod_test_invalid_load): New functions to test module assertions.
(emacs_module_init): Bind the new functions.
* test/src/emacs-module-tests.el (mod-test-emacs): New constant for
the Emacs binary file.
(mod-test-file): New constant for the test module file name.
(module--test-assertions): New unit test.
---
etc/NEWS | 6 +
src/emacs-module.c | 331 ++++++++++++++++++++++++++++++--------
src/emacs.c | 14 ++
src/lisp.h | 1 +
test/Makefile.in | 2 +-
test/data/emacs-module/mod-test.c | 24 +++
test/src/emacs-module-tests.el | 40 ++++-
7 files changed, 351 insertions(+), 67 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7972511f7a..feed62c1ca 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -85,6 +85,12 @@ modern init systems such as systemd, which manage many of the traditional
aspects of daemon behavior themselves. '--bg-daemon' is now an alias
for '--daemon'.
+** New option '--module-assertions'. If the user supplies this
+option, Emacs will perform expensive correctness checks when dealing
+with dynamic modules. This is intended for module authors that wish
+to verify that their module conforms to the module requirements. The
+option makes Emacs abort if a module-related assertion triggers.
+
+++
** Emacs now supports 24-bit colors on capable text terminals
Terminal is automatically initialized to use 24-bit colors if the
diff --git a/src/emacs-module.c b/src/emacs-module.c
index afb75e351d..2d425ded15 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -21,9 +21,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "emacs-module.h"
+#include <stdarg.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
+#include <stdnoreturn.h>
#include "lisp.h"
#include "dynlib.h"
@@ -35,6 +37,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <intprops.h>
#include <verify.h>
+/* We use different strategies for allocating the user-visible objects
+ (struct emacs_runtime, emacs_env, emacs_value), depending on
+ whether the user supplied the -module-assertions flag. If
+ assertions are disabled, all objects are allocated from the stack.
+ If assertions are enabled, all objects are allocated from the free
+ store, and objects are never freed; this guarantees that they all
+ have different addresses. We use that for checking which objects
+ are live. Without unique addresses, we might consider some dead
+ objects live because their addresses would have been reused in the
+ meantime. */
+
\f
/* Feature tests. */
@@ -78,25 +91,31 @@ struct emacs_env_private
storage is always available for them, even in an out-of-memory
situation. */
Lisp_Object non_local_exit_symbol, non_local_exit_data;
+
+ /* List of values allocated from this environment. The code uses
+ this only if the user gave the -module-assertions command-line
+ option. */
+ Lisp_Object values;
};
/* The private parts of an `emacs_runtime' object contain the initial
environment. */
struct emacs_runtime_private
{
- emacs_env pub;
+ emacs_env *env;
};
\f
/* Forward declarations. */
-struct module_fun_env;
-
static Lisp_Object value_to_lisp (emacs_value);
-static emacs_value lisp_to_value (Lisp_Object);
+static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
-static void check_thread (void);
-static void initialize_environment (emacs_env *, struct emacs_env_private *);
+static void module_assert_thread (void);
+static void module_assert_runtime (struct emacs_runtime *);
+static void module_assert_env (emacs_env *);
+static noreturn void module_abort (const char *format, ...) ATTRIBUTE_FORMAT_PRINTF(1, 2);
+static emacs_env *initialize_environment (emacs_env *, struct emacs_env_private *);
static void finalize_environment (emacs_env *);
static void finalize_environment_unwind (void *);
static void finalize_runtime_unwind (void *);
@@ -113,6 +132,10 @@ static void module_reset_handlerlist (struct handler *const *);
code should not assume this. */
verify (NIL_IS_ZERO);
static emacs_value const module_nil = 0;
+
+static bool module_assertions = false;
+static emacs_env *global_env;
+static struct emacs_env_private global_env_private;
\f
/* Convenience macros for non-local exit handling. */
@@ -216,7 +239,8 @@ static emacs_value const module_nil = 0;
#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
do { \
- check_thread (); \
+ module_assert_thread (); \
+ module_assert_env (env); \
if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
return error_retval; \
} while (false)
@@ -242,9 +266,9 @@ CHECK_USER_PTR (Lisp_Object obj)
static emacs_env *
module_get_environment (struct emacs_runtime *ert)
{
- emacs_env *env = &ert->private_members->pub;
- check_thread ();
- return env;
+ module_assert_thread ();
+ module_assert_runtime (ert);
+ return ert->private_members->env;
}
/* To make global refs (GC-protected global values) keep a hash that
@@ -273,7 +297,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
hash_put (h, new_obj, make_natnum (1), hashcode);
}
- return lisp_to_value (new_obj);
+ return lisp_to_value (module_assertions ? global_env : env, new_obj);
}
static void
@@ -300,32 +324,59 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
else
hash_remove_from_table (h, value);
}
+
+ if (module_assertions)
+ {
+ Lisp_Object globals = global_env_private.values;
+ Lisp_Object prev = Qnil;
+ ptrdiff_t count = 0;
+ for (Lisp_Object tail = global_env_private.values; CONSP (tail);
+ tail = XCDR (tail))
+ {
+ emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
+ if (global == ref)
+ {
+ if (NILP (prev))
+ global_env_private.values = XCDR (globals);
+ else
+ XSETCDR (prev, XCDR (globals));
+ return;
+ }
+ ++count;
+ prev = globals;
+ }
+ module_abort ("Global value was not found in list of %td globals",
+ count);
+ }
}
static enum emacs_funcall_exit
module_non_local_exit_check (emacs_env *env)
{
- check_thread ();
+ module_assert_thread ();
+ module_assert_env (env);
return env->private_members->pending_non_local_exit;
}
static void
module_non_local_exit_clear (emacs_env *env)
{
- check_thread ();
+ module_assert_thread ();
+ module_assert_env (env);
env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
}
static enum emacs_funcall_exit
module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
{
- check_thread ();
+ module_assert_thread ();
+ module_assert_env (env);
struct emacs_env_private *p = env->private_members;
if (p->pending_non_local_exit != emacs_funcall_exit_return)
{
/* FIXME: lisp_to_value can exit non-locally. */
- *sym = lisp_to_value (p->non_local_exit_symbol);
- *data = lisp_to_value (p->non_local_exit_data);
+ *sym = lisp_to_value (env, p->non_local_exit_symbol);
+ *data = lisp_to_value (env, p->non_local_exit_data);
}
return p->pending_non_local_exit;
}
@@ -334,7 +385,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
static void
module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
{
- check_thread ();
+ module_assert_thread ();
+ module_assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_signal_1 (env, value_to_lisp (sym),
value_to_lisp (data));
@@ -343,7 +395,8 @@ module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
static void
module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
{
- check_thread ();
+ module_assert_thread ();
+ module_assert_env (env);
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_throw_1 (env, value_to_lisp (tag),
value_to_lisp (value));
@@ -383,7 +436,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
XSET_MODULE_FUNCTION (result, function);
eassert (MODULE_FUNCTIONP (result));
- return lisp_to_value (result);
+ return lisp_to_value (env, result);
}
static emacs_value
@@ -403,7 +456,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
newargs[0] = value_to_lisp (fun);
for (ptrdiff_t i = 0; i < nargs; i++)
newargs[1 + i] = value_to_lisp (args[i]);
- emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs));
+ emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
SAFE_FREE ();
return result;
}
@@ -412,14 +465,14 @@ static emacs_value
module_intern (emacs_env *env, const char *name)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (intern (name));
+ return lisp_to_value (env, intern (name));
}
static emacs_value
module_type_of (emacs_env *env, emacs_value value)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (Ftype_of (value_to_lisp (value)));
+ return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
}
static bool
@@ -451,7 +504,7 @@ module_make_integer (emacs_env *env, intmax_t n)
MODULE_FUNCTION_BEGIN (module_nil);
if (FIXNUM_OVERFLOW_P (n))
xsignal0 (Qoverflow_error);
- return lisp_to_value (make_number (n));
+ return lisp_to_value (env, make_number (n));
}
static double
@@ -467,7 +520,7 @@ static emacs_value
module_make_float (emacs_env *env, double d)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_float (d));
+ return lisp_to_value (env, make_float (d));
}
static bool
@@ -509,14 +562,15 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
if (! (0 <= length && length <= STRING_BYTES_BOUND))
xsignal0 (Qoverflow_error);
AUTO_STRING_WITH_LEN (lstr, str, length);
- return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
+ return lisp_to_value (env,
+ code_convert_string_norecord (lstr, Qutf_8, false));
}
static emacs_value
module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
{
MODULE_FUNCTION_BEGIN (module_nil);
- return lisp_to_value (make_user_ptr (fin, ptr));
+ return lisp_to_value (env, make_user_ptr (fin, ptr));
}
static void *
@@ -583,7 +637,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
MODULE_FUNCTION_BEGIN (module_nil);
Lisp_Object lvec = value_to_lisp (vec);
check_vec_index (lvec, i);
- return lisp_to_value (AREF (lvec, i));
+ return lisp_to_value (env, AREF (lvec, i));
}
static ptrdiff_t
@@ -645,19 +699,27 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
if (!module_init)
xsignal1 (Qmissing_module_init_function, file);
- struct emacs_runtime_private rt; /* Includes the public emacs_env. */
- struct emacs_env_private priv;
- initialize_environment (&rt.pub, &priv);
- struct emacs_runtime pub =
- {
- .size = sizeof pub,
- .private_members = &rt,
- .get_environment = module_get_environment
- };
+ struct emacs_runtime rt_pub;
+ struct emacs_runtime_private rt_priv;
+ emacs_env env_pub;
+ struct emacs_env_private env_priv;
+ rt_priv.env = initialize_environment (&env_pub, &env_priv);
+
+ /* If we should use module assertions, reallocate the runtime object
+ from the free store, but never free it. That way the addresses
+ for two different runtime objects are guaranteed to be distinct,
+ which we can use for checking the liveness of runtime
+ pointers. */
+ struct emacs_runtime *rt = module_assertions ? xmalloc (sizeof *rt) : &rt_pub;
+ rt->size = sizeof *rt;
+ rt->private_members = &rt_priv;
+ rt->get_environment = module_get_environment;
+
+ Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_runtime_unwind, &pub);
+ record_unwind_protect_ptr (finalize_runtime_unwind, rt);
- int r = module_init (&pub);
+ int r = module_init (rt);
/* Process the quit flag first, so that quitting doesn't get
overridden by other non-local exits. */
@@ -670,7 +732,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
xsignal2 (Qmodule_init_failed, file, make_number (r));
}
- module_signal_or_throw (&priv);
+ module_signal_or_throw (&env_priv);
return unbind_to (count, Qt);
}
@@ -685,25 +747,25 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
emacs_env pub;
struct emacs_env_private priv;
- initialize_environment (&pub, &priv);
+ emacs_env *env = initialize_environment (&pub, &priv);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_environment_unwind, &pub);
+ record_unwind_protect_ptr (finalize_environment_unwind, env);
USE_SAFE_ALLOCA;
ATTRIBUTE_MAY_ALIAS emacs_value *args;
- if (plain_values)
+ if (plain_values && ! module_assertions)
args = (emacs_value *) arglist;
else
{
args = SAFE_ALLOCA (nargs * sizeof *args);
for (ptrdiff_t i = 0; i < nargs; i++)
- args[i] = lisp_to_value (arglist[i]);
+ args[i] = lisp_to_value (env, arglist[i]);
}
- emacs_value ret = func->subr (&pub, nargs, args, func->data);
+ emacs_value ret = func->subr (env, nargs, args, func->data);
SAFE_FREE ();
- eassert (&priv == pub.private_members);
+ eassert (&priv == env->private_members);
/* Process the quit flag first, so that quitting doesn't get
overridden by other non-local exits. */
@@ -725,18 +787,59 @@ module_function_arity (const struct Lisp_Module_Function *const function)
\f
/* Helper functions. */
-static void
-check_thread (void)
+static bool
+in_current_thread (void)
{
- eassert (current_thread != NULL);
+ if (current_thread == NULL)
+ return false;
#ifdef HAVE_PTHREAD
- eassert (pthread_equal (pthread_self (), current_thread->thread_id));
+ return pthread_equal (pthread_self (), current_thread->thread_id);
#elif defined WINDOWSNT
- eassert (GetCurrentThreadId () == current_thread->thread_id);
+ return GetCurrentThreadId () == current_thread->thread_id;
#endif
}
static void
+module_assert_thread (void)
+{
+ if (! module_assertions || in_current_thread ())
+ return;
+ module_abort ("Module function called from outside the current Lisp thread");
+}
+
+static void
+module_assert_runtime (struct emacs_runtime *ert)
+{
+ if (! module_assertions)
+ return;
+ ptrdiff_t count = 0;
+ for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
+ {
+ if (XSAVE_POINTER (XCAR (tail), 0) == ert)
+ return;
+ ++count;
+ }
+ module_abort ("Runtime pointer not found in list of %td runtimes", count);
+}
+
+static void
+module_assert_env (emacs_env *env)
+{
+ if (! module_assertions)
+ return;
+ ptrdiff_t count = 0;
+ for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
+ tail = XCDR (tail))
+ {
+ if (XSAVE_POINTER (XCAR (tail), 0) == env)
+ return;
+ ++count;
+ }
+ module_abort ("Environment pointer not found in list of %td environments",
+ count);
+}
+
+static void
module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
Lisp_Object data)
{
@@ -775,6 +878,14 @@ module_out_of_memory (emacs_env *env)
\f
/* Value conversion. */
+/* We represent Lisp objects differently depending on whether the user
+ gave -module-assertions. If assertions are disabled, emacs_value
+ objects are Lisp_Objects cast to emacs_value. If assertions are
+ enabled, emacs_value objects are pointers to Lisp_Object objects
+ allocated from the free store; they are never freed, which ensures
+ that their addresses are unique and can be used for liveness
+ checking. */
+
/* Unique Lisp_Object used to mark those emacs_values which are really
just containers holding a Lisp_Object that does not fit as an emacs_value,
either because it is an integer out of range, or is not properly aligned.
@@ -821,6 +932,32 @@ value_to_lisp_bits (emacs_value v)
static Lisp_Object
value_to_lisp (emacs_value v)
{
+ if (module_assertions)
+ {
+ /* Check the liveness of the value by iterating over all live
+ environments. */
+ void *vptr = v;
+ ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr;
+ ptrdiff_t num_environments = 0;
+ ptrdiff_t num_values = 0;
+ for (Lisp_Object environments = Vmodule_environments;
+ CONSP (environments); environments = XCDR (environments))
+ {
+ emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
+ for (Lisp_Object values = env->private_members->values;
+ CONSP (values); values = XCDR (values))
+ {
+ Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0);
+ if (p == optr)
+ return *p;
+ ++num_values;
+ }
+ ++num_environments;
+ }
+ module_abort ("Emacs value not found in %td values of %td environments",
+ num_values, num_environments);
+ }
+
Lisp_Object o = value_to_lisp_bits (v);
if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
o = XCAR (o);
@@ -849,8 +986,23 @@ enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
/* Convert O to an emacs_value. Allocate storage if needed; this can
signal if memory is exhausted. Must be an injective function. */
static emacs_value
-lisp_to_value (Lisp_Object o)
+lisp_to_value (emacs_env *env, Lisp_Object o)
{
+ if (module_assertions)
+ {
+ /* Add the new value to the list of values allocated from this
+ environment. The value is actually a pointer to the
+ Lisp_Object cast to emacs_value. We make a copy of the
+ object on the free store to guarantee unique addresses. */
+ ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o);
+ *optr = o;
+ void *vptr = optr;
+ ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
+ struct emacs_env_private *priv = env->private_members;
+ priv->values = Fcons (make_save_ptr (ret), priv->values);
+ return ret;
+ }
+
emacs_value v = lisp_to_value_bits (o);
if (! EQ (o, value_to_lisp_bits (v)))
@@ -881,12 +1033,20 @@ lisp_to_value (Lisp_Object o)
\f
/* Environment lifetime management. */
-/* Must be called before the environment can be used. */
-static void
+/* Must be called before the environment can be used. Returns another
+ pointer that callers should use instead of the ENV argument. If
+ module assertions are disabled, the return value is ENV. If module
+ assertions are enabled, the return value points to a heap-allocated
+ object. That object is never freed to guarantee unique
+ addresses. */
+static emacs_env *
initialize_environment (emacs_env *env, struct emacs_env_private *priv)
{
+ if (module_assertions)
+ env = xmalloc (sizeof *env);
+
priv->pending_non_local_exit = emacs_funcall_exit_return;
- priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
+ priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
env->size = sizeof *env;
env->private_members = priv;
env->make_global_ref = module_make_global_ref;
@@ -918,6 +1078,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->vec_size = module_vec_size;
env->should_quit = module_should_quit;
Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
+ return env;
}
/* Must be called before the lifetime of the environment object
@@ -927,6 +1088,9 @@ finalize_environment (emacs_env *env)
{
eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
Vmodule_environments = XCDR (Vmodule_environments);
+ if (module_assertions)
+ /* There is always at least the global environment. */
+ eassert (CONSP (Vmodule_environments));
}
static void
@@ -939,20 +1103,23 @@ static void
finalize_runtime_unwind (void* raw_ert)
{
struct emacs_runtime *ert = raw_ert;
- finalize_environment (&ert->private_members->pub);
+ eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
+ Vmodule_runtimes = XCDR (Vmodule_runtimes);
+ finalize_environment (ert->private_members->env);
}
void
mark_modules (void)
{
- Lisp_Object tail = Vmodule_environments;
- FOR_EACH_TAIL_SAFE (tail)
- {
- emacs_env *env = XSAVE_POINTER (XCAR (tail), 0);
- struct emacs_env_private *priv = env->private_members;
- mark_object (priv->non_local_exit_symbol);
- mark_object (priv->non_local_exit_data);
- }
+ for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
+ tail = XCDR (tail))
+ {
+ emacs_env *env = XSAVE_POINTER (XCAR (tail), 0);
+ struct emacs_env_private *priv = env->private_members;
+ mark_object (priv->non_local_exit_symbol);
+ mark_object (priv->non_local_exit_data);
+ mark_object (priv->values);
+ }
}
\f
@@ -987,6 +1154,36 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
}
\f
+/* Support for assertions. */
+void
+init_module_assertions (bool enable)
+{
+ module_assertions = enable;
+ if (enable)
+ {
+ /* We use a hidden environment for storing the globals. This
+ environment is never freed. */
+ emacs_env env;
+ global_env = initialize_environment (&env, &global_env_private);
+ eassert (global_env != &env);
+ }
+}
+
+static noreturn void
+ATTRIBUTE_FORMAT_PRINTF(1, 2)
+module_abort (const char *format, ...)
+{
+ fputs ("Emacs module assertion: ", stderr);
+ va_list args;
+ va_start (args, format);
+ vfprintf (stderr, format, args);
+ va_end (args);
+ putc ('\n', stderr);
+ fflush (stderr);
+ emacs_abort ();
+}
+
+\f
/* Segment initializer. */
void
@@ -1006,6 +1203,14 @@ syms_of_module (void)
Qnil, false);
Funintern (Qmodule_refs_hash, Qnil);
+ DEFSYM (Qmodule_runtimes, "module-runtimes");
+ DEFVAR_LISP ("module-runtimes", Vmodule_runtimes,
+ doc: /* List of active module runtimes. */);
+ Vmodule_runtimes = Qnil;
+ /* Unintern `module-runtimes' because it is only used
+ internally. */
+ Funintern (Qmodule_runtimes, Qnil);
+
DEFSYM (Qmodule_environments, "module-environments");
DEFVAR_LISP ("module-environments", Vmodule_environments,
doc: /* List of active module environments. */);
diff --git a/src/emacs.c b/src/emacs.c
index 49ebb81767..b0892c7ebb 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -223,6 +223,7 @@ Initialization options:\n\
--fg-daemon[=NAME] start a (named) server in the foreground\n\
--debug-init enable Emacs Lisp debugger for init file\n\
--display, -d DISPLAY use X server DISPLAY\n\
+--module-assertions assert behavior of dynamic modules\n\
",
"\
--no-build-details do not add build details such as time stamps\n\
@@ -1263,6 +1264,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
build_details = ! argmatch (argv, argc, "-no-build-details",
"--no-build-details", 7, NULL, &skip_args);
+#ifdef HAVE_MODULES
+ bool module_assertions
+ = argmatch (argv, argc, "-module-assertions", "--module-assertions", 15,
+ NULL, &skip_args);
+ if (dumping && module_assertions)
+ {
+ fputs ("Module assertions are not supported during dumping\n", stderr);
+ exit (1);
+ }
+ init_module_assertions (module_assertions);
+#endif
+
#ifdef HAVE_NS
ns_pool = ns_alloc_autorelease_pool ();
#ifdef NS_IMPL_GNUSTEP
@@ -1720,6 +1733,7 @@ static const struct standard_args standard_args[] =
{ "-nl", "--no-loadup", 70, 0 },
{ "-nsl", "--no-site-lisp", 65, 0 },
{ "-no-build-details", "--no-build-details", 63, 0 },
+ { "-module-assertions", "--module-assertions", 62, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
diff --git a/src/lisp.h b/src/lisp.h
index ee703893e2..e7e98fb66c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3959,6 +3959,7 @@ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
extern void mark_modules (void);
+extern void init_module_assertions (bool);
extern void syms_of_module (void);
#endif
diff --git a/test/Makefile.in b/test/Makefile.in
index 7b8c967128..0c24c48e60 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -68,7 +68,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = -batch --no-site-file --no-site-lisp -module-assertions -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 309179d150..fc29a0d6b9 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -213,6 +213,28 @@ Fmod_test_vector_eq (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
return env->intern (env, "t");
}
+static emacs_value invalid_stored_value;
+
+/* The next two functions perform a possibly-invalid operation: they
+ store a value in a static variable and load it. This causes
+ undefined behavior if the environment that the value was created
+ from is no longer live. The module assertions check for this
+ error. */
+
+static emacs_value
+Fmod_test_invalid_store (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ return invalid_stored_value = env->make_integer (env, 123);
+}
+
+static emacs_value
+Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ return invalid_stored_value;
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
@@ -260,6 +282,8 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
+ DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
#undef DEFUN
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 622bbadb3e..99a853b17e 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -19,9 +19,17 @@
(require 'ert)
-(require 'mod-test
- (expand-file-name "data/emacs-module/mod-test"
- (getenv "EMACS_TEST_DIRECTORY")))
+(defconst mod-test-emacs
+ (expand-file-name invocation-name invocation-directory)
+ "File name of the Emacs binary currently running.")
+
+(eval-and-compile
+ (defconst mod-test-file
+ (substitute-in-file-name
+ "$EMACS_TEST_DIRECTORY/data/emacs-module/mod-test")
+ "File name of the module test file."))
+
+(require 'mod-test mod-test-file)
;;
;; Basic tests.
@@ -174,4 +182,30 @@ multiply-string
(should (equal (help-function-arglist #'mod-test-sum)
'(arg1 arg2))))
+(ert-deftest module--test-assertions ()
+ "Check that -module-assertions work."
+ (skip-unless (file-executable-p mod-test-emacs))
+ ;; This doesn’t yet cause undefined behavior.
+ (should (eq (mod-test-invalid-store) 123))
+ (with-temp-buffer
+ (should (equal (call-process mod-test-emacs nil t nil
+ "-batch" "-Q" "-module-assertions" "-eval"
+ (prin1-to-string
+ `(progn
+ (require 'mod-test ,mod-test-file)
+ ;; Storing and reloading a local
+ ;; value causes undefined
+ ;; behavior, which should be
+ ;; detected by the module
+ ;; assertions.
+ (mod-test-invalid-store)
+ (mod-test-invalid-load))))
+ ;; FIXME: This string is probably different on
+ ;; Windows and Linux.
+ "Abort trap: 6"))
+ (re-search-backward (rx bos "Emacs module assertion: "
+ "Emacs value not found in "
+ (+ digit) " values of "
+ (+ digit) " environments" ?\n eos))))
+
;;; emacs-module-tests.el ends here
--
2.13.1
^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: emacs-module.c, eassert, and nonnull args
2017-06-11 20:34 ` Philipp Stephani
@ 2017-06-12 14:34 ` Philipp Stephani
0 siblings, 0 replies; 7+ messages in thread
From: Philipp Stephani @ 2017-06-12 14:34 UTC (permalink / raw)
To: Paul Eggert, Eli Zaretskii; +Cc: phst, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1961 bytes --]
Philipp Stephani <p.stephani2@gmail.com> schrieb am So., 11. Juni 2017 um
22:34 Uhr:
> Paul Eggert <eggert@cs.ucla.edu> schrieb am So., 11. Juni 2017 um
> 19:45 Uhr:
>
>> Philipp Stephani wrote:
>> > Here's a new patch. It makes this change, and also changes the
>> allocation
>> > slightly so that objects have unique addresses (useful for checking).
>>
>> Thanks for working on this. Some comments.
>>
>> Have you looked into the runtime overhead of this approach, assuming
>> -module-assertions is not specified? Currently lisp_to_value and
>> value_to_lisp
>> typically are optimized away (i.e., zero machine instructions), and that
>> wouldn't be true under the proposed patch even when -module-assertions is
>> not
>> used. Granted, module calls need not be super-fast, but it might be nice
>> to
>> avoid the overhead in the typical case if that is easy.
>>
>
> I've run a simple benchmark (5000000 iterations of mod-test-sum). Result
> for the base case (module assertions not compiled) is 4.602 seconds, with
> the new code it's 4.605 seconds. That's probably good enough.
>
>
>>
>> What happens if -module-assertions is enabled for Emacs, Emacs dumps
>> itself, and
>> -module-assertions is not enabled when the dumped Emacs is run?
>
>
> Good question. I've now just made -module-assertions during dumping an
> error.
>
>
>> Or vice versa.
>>
>
> That's the normal case, which should work just fine.
>
>
>>
>> Are the FOR_EACH_TAIL_SAFE macro calls needed? This macro is needed only
>> for
>> lists that might be circular (e.g., the lists are available to Lisp code,
>> which
>> can call setcdr on their components). If the calls are not needed I
>> suggest just
>> an ordinary for loop.
>>
>
> Done.
>
>
>>
>> A small point: the FOR_EACH... loops should be indented like ordinary
>> for-loops.
>>
>
> Done. (Would be great if CC-Mode knew about this.)
>
I've now pushed this commit and also a commit that uses
__attribute__((nonnull)) to master.
[-- Attachment #2: Type: text/html, Size: 3488 bytes --]
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2017-06-12 14:34 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-06-05 2:48 emacs-module.c, eassert, and nonnull args Paul Eggert
2017-06-05 13:56 ` Philipp Stephani
2017-06-05 15:33 ` Eli Zaretskii
2017-06-11 13:50 ` Philipp Stephani
2017-06-11 17:45 ` Paul Eggert
2017-06-11 20:34 ` Philipp Stephani
2017-06-12 14:34 ` Philipp Stephani
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).