Re: emacs-module.c, eassert, and nonnull args

[Philipp Stephani <p.stephani2@gmail.com>]

[-- 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