aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPhilipp Stephani2017-06-05 13:29:14 +0200
committerPhilipp Stephani2017-06-12 15:22:27 +0200
commitcf97132764572928adc77fd555d04a9f41cd3cfc (patch)
tree65f707de87b811caec7b08f96938059859cf001c
parentb49dd3b047bf07994d9577e08daba55f143a8bb1 (diff)
downloademacs-cf97132764572928adc77fd555d04a9f41cd3cfc.tar.gz
emacs-cf97132764572928adc77fd555d04a9f41cd3cfc.zip
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.
-rw-r--r--etc/NEWS6
-rw-r--r--src/emacs-module.c331
-rw-r--r--src/emacs.c14
-rw-r--r--src/lisp.h1
-rw-r--r--test/Makefile.in2
-rw-r--r--test/data/emacs-module/mod-test.c24
-rw-r--r--test/src/emacs-module-tests.el40
7 files changed, 351 insertions, 67 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 7972511f7a1..feed62c1cad 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -85,6 +85,12 @@ modern init systems such as systemd, which manage many of the traditional
85aspects of daemon behavior themselves. '--bg-daemon' is now an alias 85aspects of daemon behavior themselves. '--bg-daemon' is now an alias
86for '--daemon'. 86for '--daemon'.
87 87
88** New option '--module-assertions'. If the user supplies this
89option, Emacs will perform expensive correctness checks when dealing
90with dynamic modules. This is intended for module authors that wish
91to verify that their module conforms to the module requirements. The
92option makes Emacs abort if a module-related assertion triggers.
93
88+++ 94+++
89** Emacs now supports 24-bit colors on capable text terminals 95** Emacs now supports 24-bit colors on capable text terminals
90Terminal is automatically initialized to use 24-bit colors if the 96Terminal is automatically initialized to use 24-bit colors if the
diff --git a/src/emacs-module.c b/src/emacs-module.c
index adb09c0c506..2602398d814 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/>. */
21 21
22#include "emacs-module.h" 22#include "emacs-module.h"
23 23
24#include <stdarg.h>
24#include <stddef.h> 25#include <stddef.h>
25#include <stdint.h> 26#include <stdint.h>
26#include <stdio.h> 27#include <stdio.h>
28#include <stdnoreturn.h>
27 29
28#include "lisp.h" 30#include "lisp.h"
29#include "dynlib.h" 31#include "dynlib.h"
@@ -35,6 +37,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
35#include <intprops.h> 37#include <intprops.h>
36#include <verify.h> 38#include <verify.h>
37 39
40/* We use different strategies for allocating the user-visible objects
41 (struct emacs_runtime, emacs_env, emacs_value), depending on
42 whether the user supplied the -module-assertions flag. If
43 assertions are disabled, all objects are allocated from the stack.
44 If assertions are enabled, all objects are allocated from the free
45 store, and objects are never freed; this guarantees that they all
46 have different addresses. We use that for checking which objects
47 are live. Without unique addresses, we might consider some dead
48 objects live because their addresses would have been reused in the
49 meantime. */
50
38 51
39/* Feature tests. */ 52/* Feature tests. */
40 53
@@ -78,25 +91,31 @@ struct emacs_env_private
78 storage is always available for them, even in an out-of-memory 91 storage is always available for them, even in an out-of-memory
79 situation. */ 92 situation. */
80 Lisp_Object non_local_exit_symbol, non_local_exit_data; 93 Lisp_Object non_local_exit_symbol, non_local_exit_data;
94
95 /* List of values allocated from this environment. The code uses
96 this only if the user gave the -module-assertions command-line
97 option. */
98 Lisp_Object values;
81}; 99};
82 100
83/* The private parts of an `emacs_runtime' object contain the initial 101/* The private parts of an `emacs_runtime' object contain the initial
84 environment. */ 102 environment. */
85struct emacs_runtime_private 103struct emacs_runtime_private
86{ 104{
87 emacs_env pub; 105 emacs_env *env;
88}; 106};
89 107
90 108
91/* Forward declarations. */ 109/* Forward declarations. */
92 110
93struct module_fun_env;
94
95static Lisp_Object value_to_lisp (emacs_value); 111static Lisp_Object value_to_lisp (emacs_value);
96static emacs_value lisp_to_value (Lisp_Object); 112static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
97static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); 113static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
98static void check_thread (void); 114static void module_assert_thread (void);
99static void initialize_environment (emacs_env *, struct emacs_env_private *); 115static void module_assert_runtime (struct emacs_runtime *);
116static void module_assert_env (emacs_env *);
117static noreturn void module_abort (const char *format, ...) ATTRIBUTE_FORMAT_PRINTF(1, 2);
118static emacs_env *initialize_environment (emacs_env *, struct emacs_env_private *);
100static void finalize_environment (emacs_env *); 119static void finalize_environment (emacs_env *);
101static void finalize_environment_unwind (void *); 120static void finalize_environment_unwind (void *);
102static void finalize_runtime_unwind (void *); 121static void finalize_runtime_unwind (void *);
@@ -113,6 +132,10 @@ static void module_reset_handlerlist (struct handler *const *);
113 code should not assume this. */ 132 code should not assume this. */
114verify (NIL_IS_ZERO); 133verify (NIL_IS_ZERO);
115static emacs_value const module_nil = 0; 134static emacs_value const module_nil = 0;
135
136static bool module_assertions = false;
137static emacs_env *global_env;
138static struct emacs_env_private global_env_private;
116 139
117/* Convenience macros for non-local exit handling. */ 140/* Convenience macros for non-local exit handling. */
118 141
@@ -216,7 +239,8 @@ static emacs_value const module_nil = 0;
216 239
217#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \ 240#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
218 do { \ 241 do { \
219 check_thread (); \ 242 module_assert_thread (); \
243 module_assert_env (env); \
220 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \ 244 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
221 return error_retval; \ 245 return error_retval; \
222 } while (false) 246 } while (false)
@@ -242,9 +266,9 @@ CHECK_USER_PTR (Lisp_Object obj)
242static emacs_env * 266static emacs_env *
243module_get_environment (struct emacs_runtime *ert) 267module_get_environment (struct emacs_runtime *ert)
244{ 268{
245 emacs_env *env = &ert->private_members->pub; 269 module_assert_thread ();
246 check_thread (); 270 module_assert_runtime (ert);
247 return env; 271 return ert->private_members->env;
248} 272}
249 273
250/* To make global refs (GC-protected global values) keep a hash that 274/* 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)
273 hash_put (h, new_obj, make_natnum (1), hashcode); 297 hash_put (h, new_obj, make_natnum (1), hashcode);
274 } 298 }
275 299
276 return lisp_to_value (new_obj); 300 return lisp_to_value (module_assertions ? global_env : env, new_obj);
277} 301}
278 302
279static void 303static void
@@ -300,32 +324,59 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
300 else 324 else
301 hash_remove_from_table (h, value); 325 hash_remove_from_table (h, value);
302 } 326 }
327
328 if (module_assertions)
329 {
330 Lisp_Object globals = global_env_private.values;
331 Lisp_Object prev = Qnil;
332 ptrdiff_t count = 0;
333 for (Lisp_Object tail = global_env_private.values; CONSP (tail);
334 tail = XCDR (tail))
335 {
336 emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
337 if (global == ref)
338 {
339 if (NILP (prev))
340 global_env_private.values = XCDR (globals);
341 else
342 XSETCDR (prev, XCDR (globals));
343 return;
344 }
345 ++count;
346 prev = globals;
347 }
348 module_abort ("Global value was not found in list of %td globals",
349 count);
350 }
303} 351}
304 352
305static enum emacs_funcall_exit 353static enum emacs_funcall_exit
306module_non_local_exit_check (emacs_env *env) 354module_non_local_exit_check (emacs_env *env)
307{ 355{
308 check_thread (); 356 module_assert_thread ();
357 module_assert_env (env);
309 return env->private_members->pending_non_local_exit; 358 return env->private_members->pending_non_local_exit;
310} 359}
311 360
312static void 361static void
313module_non_local_exit_clear (emacs_env *env) 362module_non_local_exit_clear (emacs_env *env)
314{ 363{
315 check_thread (); 364 module_assert_thread ();
365 module_assert_env (env);
316 env->private_members->pending_non_local_exit = emacs_funcall_exit_return; 366 env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
317} 367}
318 368
319static enum emacs_funcall_exit 369static enum emacs_funcall_exit
320module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) 370module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
321{ 371{
322 check_thread (); 372 module_assert_thread ();
373 module_assert_env (env);
323 struct emacs_env_private *p = env->private_members; 374 struct emacs_env_private *p = env->private_members;
324 if (p->pending_non_local_exit != emacs_funcall_exit_return) 375 if (p->pending_non_local_exit != emacs_funcall_exit_return)
325 { 376 {
326 /* FIXME: lisp_to_value can exit non-locally. */ 377 /* FIXME: lisp_to_value can exit non-locally. */
327 *sym = lisp_to_value (p->non_local_exit_symbol); 378 *sym = lisp_to_value (env, p->non_local_exit_symbol);
328 *data = lisp_to_value (p->non_local_exit_data); 379 *data = lisp_to_value (env, p->non_local_exit_data);
329 } 380 }
330 return p->pending_non_local_exit; 381 return p->pending_non_local_exit;
331} 382}
@@ -334,7 +385,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
334static void 385static void
335module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data) 386module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
336{ 387{
337 check_thread (); 388 module_assert_thread ();
389 module_assert_env (env);
338 if (module_non_local_exit_check (env) == emacs_funcall_exit_return) 390 if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
339 module_non_local_exit_signal_1 (env, value_to_lisp (sym), 391 module_non_local_exit_signal_1 (env, value_to_lisp (sym),
340 value_to_lisp (data)); 392 value_to_lisp (data));
@@ -343,7 +395,8 @@ module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
343static void 395static void
344module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) 396module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
345{ 397{
346 check_thread (); 398 module_assert_thread ();
399 module_assert_env (env);
347 if (module_non_local_exit_check (env) == emacs_funcall_exit_return) 400 if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
348 module_non_local_exit_throw_1 (env, value_to_lisp (tag), 401 module_non_local_exit_throw_1 (env, value_to_lisp (tag),
349 value_to_lisp (value)); 402 value_to_lisp (value));
@@ -393,7 +446,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
393 XSET_MODULE_FUNCTION (result, function); 446 XSET_MODULE_FUNCTION (result, function);
394 eassert (MODULE_FUNCTIONP (result)); 447 eassert (MODULE_FUNCTIONP (result));
395 448
396 return lisp_to_value (result); 449 return lisp_to_value (env, result);
397} 450}
398 451
399static emacs_value 452static emacs_value
@@ -413,7 +466,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
413 newargs[0] = value_to_lisp (fun); 466 newargs[0] = value_to_lisp (fun);
414 for (ptrdiff_t i = 0; i < nargs; i++) 467 for (ptrdiff_t i = 0; i < nargs; i++)
415 newargs[1 + i] = value_to_lisp (args[i]); 468 newargs[1 + i] = value_to_lisp (args[i]);
416 emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs)); 469 emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
417 SAFE_FREE (); 470 SAFE_FREE ();
418 return result; 471 return result;
419} 472}
@@ -422,14 +475,14 @@ static emacs_value
422module_intern (emacs_env *env, const char *name) 475module_intern (emacs_env *env, const char *name)
423{ 476{
424 MODULE_FUNCTION_BEGIN (module_nil); 477 MODULE_FUNCTION_BEGIN (module_nil);
425 return lisp_to_value (intern (name)); 478 return lisp_to_value (env, intern (name));
426} 479}
427 480
428static emacs_value 481static emacs_value
429module_type_of (emacs_env *env, emacs_value value) 482module_type_of (emacs_env *env, emacs_value value)
430{ 483{
431 MODULE_FUNCTION_BEGIN (module_nil); 484 MODULE_FUNCTION_BEGIN (module_nil);
432 return lisp_to_value (Ftype_of (value_to_lisp (value))); 485 return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
433} 486}
434 487
435static bool 488static bool
@@ -461,7 +514,7 @@ module_make_integer (emacs_env *env, intmax_t n)
461 MODULE_FUNCTION_BEGIN (module_nil); 514 MODULE_FUNCTION_BEGIN (module_nil);
462 if (FIXNUM_OVERFLOW_P (n)) 515 if (FIXNUM_OVERFLOW_P (n))
463 xsignal0 (Qoverflow_error); 516 xsignal0 (Qoverflow_error);
464 return lisp_to_value (make_number (n)); 517 return lisp_to_value (env, make_number (n));
465} 518}
466 519
467static double 520static double
@@ -477,7 +530,7 @@ static emacs_value
477module_make_float (emacs_env *env, double d) 530module_make_float (emacs_env *env, double d)
478{ 531{
479 MODULE_FUNCTION_BEGIN (module_nil); 532 MODULE_FUNCTION_BEGIN (module_nil);
480 return lisp_to_value (make_float (d)); 533 return lisp_to_value (env, make_float (d));
481} 534}
482 535
483static bool 536static bool
@@ -519,14 +572,15 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
519 if (! (0 <= length && length <= STRING_BYTES_BOUND)) 572 if (! (0 <= length && length <= STRING_BYTES_BOUND))
520 xsignal0 (Qoverflow_error); 573 xsignal0 (Qoverflow_error);
521 AUTO_STRING_WITH_LEN (lstr, str, length); 574 AUTO_STRING_WITH_LEN (lstr, str, length);
522 return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false)); 575 return lisp_to_value (env,
576 code_convert_string_norecord (lstr, Qutf_8, false));
523} 577}
524 578
525static emacs_value 579static emacs_value
526module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) 580module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
527{ 581{
528 MODULE_FUNCTION_BEGIN (module_nil); 582 MODULE_FUNCTION_BEGIN (module_nil);
529 return lisp_to_value (make_user_ptr (fin, ptr)); 583 return lisp_to_value (env, make_user_ptr (fin, ptr));
530} 584}
531 585
532static void * 586static void *
@@ -593,7 +647,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
593 MODULE_FUNCTION_BEGIN (module_nil); 647 MODULE_FUNCTION_BEGIN (module_nil);
594 Lisp_Object lvec = value_to_lisp (vec); 648 Lisp_Object lvec = value_to_lisp (vec);
595 check_vec_index (lvec, i); 649 check_vec_index (lvec, i);
596 return lisp_to_value (AREF (lvec, i)); 650 return lisp_to_value (env, AREF (lvec, i));
597} 651}
598 652
599static ptrdiff_t 653static ptrdiff_t
@@ -655,19 +709,27 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
655 if (!module_init) 709 if (!module_init)
656 xsignal1 (Qmissing_module_init_function, file); 710 xsignal1 (Qmissing_module_init_function, file);
657 711
658 struct emacs_runtime_private rt; /* Includes the public emacs_env. */ 712 struct emacs_runtime rt_pub;
659 struct emacs_env_private priv; 713 struct emacs_runtime_private rt_priv;
660 initialize_environment (&rt.pub, &priv); 714 emacs_env env_pub;
661 struct emacs_runtime pub = 715 struct emacs_env_private env_priv;
662 { 716 rt_priv.env = initialize_environment (&env_pub, &env_priv);
663 .size = sizeof pub, 717
664 .private_members = &rt, 718 /* If we should use module assertions, reallocate the runtime object
665 .get_environment = module_get_environment 719 from the free store, but never free it. That way the addresses
666 }; 720 for two different runtime objects are guaranteed to be distinct,
721 which we can use for checking the liveness of runtime
722 pointers. */
723 struct emacs_runtime *rt = module_assertions ? xmalloc (sizeof *rt) : &rt_pub;
724 rt->size = sizeof *rt;
725 rt->private_members = &rt_priv;
726 rt->get_environment = module_get_environment;
727
728 Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes);
667 ptrdiff_t count = SPECPDL_INDEX (); 729 ptrdiff_t count = SPECPDL_INDEX ();
668 record_unwind_protect_ptr (finalize_runtime_unwind, &pub); 730 record_unwind_protect_ptr (finalize_runtime_unwind, rt);
669 731
670 int r = module_init (&pub); 732 int r = module_init (rt);
671 733
672 /* Process the quit flag first, so that quitting doesn't get 734 /* Process the quit flag first, so that quitting doesn't get
673 overridden by other non-local exits. */ 735 overridden by other non-local exits. */
@@ -680,7 +742,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
680 xsignal2 (Qmodule_init_failed, file, make_number (r)); 742 xsignal2 (Qmodule_init_failed, file, make_number (r));
681 } 743 }
682 744
683 module_signal_or_throw (&priv); 745 module_signal_or_throw (&env_priv);
684 return unbind_to (count, Qt); 746 return unbind_to (count, Qt);
685} 747}
686 748
@@ -695,25 +757,25 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
695 757
696 emacs_env pub; 758 emacs_env pub;
697 struct emacs_env_private priv; 759 struct emacs_env_private priv;
698 initialize_environment (&pub, &priv); 760 emacs_env *env = initialize_environment (&pub, &priv);
699 ptrdiff_t count = SPECPDL_INDEX (); 761 ptrdiff_t count = SPECPDL_INDEX ();
700 record_unwind_protect_ptr (finalize_environment_unwind, &pub); 762 record_unwind_protect_ptr (finalize_environment_unwind, env);
701 763
702 USE_SAFE_ALLOCA; 764 USE_SAFE_ALLOCA;
703 ATTRIBUTE_MAY_ALIAS emacs_value *args; 765 ATTRIBUTE_MAY_ALIAS emacs_value *args;
704 if (plain_values) 766 if (plain_values && ! module_assertions)
705 args = (emacs_value *) arglist; 767 args = (emacs_value *) arglist;
706 else 768 else
707 { 769 {
708 args = SAFE_ALLOCA (nargs * sizeof *args); 770 args = SAFE_ALLOCA (nargs * sizeof *args);
709 for (ptrdiff_t i = 0; i < nargs; i++) 771 for (ptrdiff_t i = 0; i < nargs; i++)
710 args[i] = lisp_to_value (arglist[i]); 772 args[i] = lisp_to_value (env, arglist[i]);
711 } 773 }
712 774
713 emacs_value ret = func->subr (&pub, nargs, args, func->data); 775 emacs_value ret = func->subr (env, nargs, args, func->data);
714 SAFE_FREE (); 776 SAFE_FREE ();
715 777
716 eassert (&priv == pub.private_members); 778 eassert (&priv == env->private_members);
717 779
718 /* Process the quit flag first, so that quitting doesn't get 780 /* Process the quit flag first, so that quitting doesn't get
719 overridden by other non-local exits. */ 781 overridden by other non-local exits. */
@@ -735,18 +797,59 @@ module_function_arity (const struct Lisp_Module_Function *const function)
735 797
736/* Helper functions. */ 798/* Helper functions. */
737 799
738static void 800static bool
739check_thread (void) 801in_current_thread (void)
740{ 802{
741 eassert (current_thread != NULL); 803 if (current_thread == NULL)
804 return false;
742#ifdef HAVE_PTHREAD 805#ifdef HAVE_PTHREAD
743 eassert (pthread_equal (pthread_self (), current_thread->thread_id)); 806 return pthread_equal (pthread_self (), current_thread->thread_id);
744#elif defined WINDOWSNT 807#elif defined WINDOWSNT
745 eassert (GetCurrentThreadId () == current_thread->thread_id); 808 return GetCurrentThreadId () == current_thread->thread_id;
746#endif 809#endif
747} 810}
748 811
749static void 812static void
813module_assert_thread (void)
814{
815 if (! module_assertions || in_current_thread ())
816 return;
817 module_abort ("Module function called from outside the current Lisp thread");
818}
819
820static void
821module_assert_runtime (struct emacs_runtime *ert)
822{
823 if (! module_assertions)
824 return;
825 ptrdiff_t count = 0;
826 for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
827 {
828 if (XSAVE_POINTER (XCAR (tail), 0) == ert)
829 return;
830 ++count;
831 }
832 module_abort ("Runtime pointer not found in list of %td runtimes", count);
833}
834
835static void
836module_assert_env (emacs_env *env)
837{
838 if (! module_assertions)
839 return;
840 ptrdiff_t count = 0;
841 for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
842 tail = XCDR (tail))
843 {
844 if (XSAVE_POINTER (XCAR (tail), 0) == env)
845 return;
846 ++count;
847 }
848 module_abort ("Environment pointer not found in list of %td environments",
849 count);
850}
851
852static void
750module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, 853module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
751 Lisp_Object data) 854 Lisp_Object data)
752{ 855{
@@ -785,6 +888,14 @@ module_out_of_memory (emacs_env *env)
785 888
786/* Value conversion. */ 889/* Value conversion. */
787 890
891/* We represent Lisp objects differently depending on whether the user
892 gave -module-assertions. If assertions are disabled, emacs_value
893 objects are Lisp_Objects cast to emacs_value. If assertions are
894 enabled, emacs_value objects are pointers to Lisp_Object objects
895 allocated from the free store; they are never freed, which ensures
896 that their addresses are unique and can be used for liveness
897 checking. */
898
788/* Unique Lisp_Object used to mark those emacs_values which are really 899/* Unique Lisp_Object used to mark those emacs_values which are really
789 just containers holding a Lisp_Object that does not fit as an emacs_value, 900 just containers holding a Lisp_Object that does not fit as an emacs_value,
790 either because it is an integer out of range, or is not properly aligned. 901 either because it is an integer out of range, or is not properly aligned.
@@ -831,6 +942,32 @@ value_to_lisp_bits (emacs_value v)
831static Lisp_Object 942static Lisp_Object
832value_to_lisp (emacs_value v) 943value_to_lisp (emacs_value v)
833{ 944{
945 if (module_assertions)
946 {
947 /* Check the liveness of the value by iterating over all live
948 environments. */
949 void *vptr = v;
950 ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr;
951 ptrdiff_t num_environments = 0;
952 ptrdiff_t num_values = 0;
953 for (Lisp_Object environments = Vmodule_environments;
954 CONSP (environments); environments = XCDR (environments))
955 {
956 emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
957 for (Lisp_Object values = env->private_members->values;
958 CONSP (values); values = XCDR (values))
959 {
960 Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0);
961 if (p == optr)
962 return *p;
963 ++num_values;
964 }
965 ++num_environments;
966 }
967 module_abort ("Emacs value not found in %td values of %td environments",
968 num_values, num_environments);
969 }
970
834 Lisp_Object o = value_to_lisp_bits (v); 971 Lisp_Object o = value_to_lisp_bits (v);
835 if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark)) 972 if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
836 o = XCAR (o); 973 o = XCAR (o);
@@ -859,8 +996,23 @@ enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
859/* Convert O to an emacs_value. Allocate storage if needed; this can 996/* Convert O to an emacs_value. Allocate storage if needed; this can
860 signal if memory is exhausted. Must be an injective function. */ 997 signal if memory is exhausted. Must be an injective function. */
861static emacs_value 998static emacs_value
862lisp_to_value (Lisp_Object o) 999lisp_to_value (emacs_env *env, Lisp_Object o)
863{ 1000{
1001 if (module_assertions)
1002 {
1003 /* Add the new value to the list of values allocated from this
1004 environment. The value is actually a pointer to the
1005 Lisp_Object cast to emacs_value. We make a copy of the
1006 object on the free store to guarantee unique addresses. */
1007 ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o);
1008 *optr = o;
1009 void *vptr = optr;
1010 ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
1011 struct emacs_env_private *priv = env->private_members;
1012 priv->values = Fcons (make_save_ptr (ret), priv->values);
1013 return ret;
1014 }
1015
864 emacs_value v = lisp_to_value_bits (o); 1016 emacs_value v = lisp_to_value_bits (o);
865 1017
866 if (! EQ (o, value_to_lisp_bits (v))) 1018 if (! EQ (o, value_to_lisp_bits (v)))
@@ -891,12 +1043,20 @@ lisp_to_value (Lisp_Object o)
891 1043
892/* Environment lifetime management. */ 1044/* Environment lifetime management. */
893 1045
894/* Must be called before the environment can be used. */ 1046/* Must be called before the environment can be used. Returns another
895static void 1047 pointer that callers should use instead of the ENV argument. If
1048 module assertions are disabled, the return value is ENV. If module
1049 assertions are enabled, the return value points to a heap-allocated
1050 object. That object is never freed to guarantee unique
1051 addresses. */
1052static emacs_env *
896initialize_environment (emacs_env *env, struct emacs_env_private *priv) 1053initialize_environment (emacs_env *env, struct emacs_env_private *priv)
897{ 1054{
1055 if (module_assertions)
1056 env = xmalloc (sizeof *env);
1057
898 priv->pending_non_local_exit = emacs_funcall_exit_return; 1058 priv->pending_non_local_exit = emacs_funcall_exit_return;
899 priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil; 1059 priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
900 env->size = sizeof *env; 1060 env->size = sizeof *env;
901 env->private_members = priv; 1061 env->private_members = priv;
902 env->make_global_ref = module_make_global_ref; 1062 env->make_global_ref = module_make_global_ref;
@@ -928,6 +1088,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
928 env->vec_size = module_vec_size; 1088 env->vec_size = module_vec_size;
929 env->should_quit = module_should_quit; 1089 env->should_quit = module_should_quit;
930 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments); 1090 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
1091 return env;
931} 1092}
932 1093
933/* Must be called before the lifetime of the environment object 1094/* Must be called before the lifetime of the environment object
@@ -937,6 +1098,9 @@ finalize_environment (emacs_env *env)
937{ 1098{
938 eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env); 1099 eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
939 Vmodule_environments = XCDR (Vmodule_environments); 1100 Vmodule_environments = XCDR (Vmodule_environments);
1101 if (module_assertions)
1102 /* There is always at least the global environment. */
1103 eassert (CONSP (Vmodule_environments));
940} 1104}
941 1105
942static void 1106static void
@@ -949,20 +1113,23 @@ static void
949finalize_runtime_unwind (void* raw_ert) 1113finalize_runtime_unwind (void* raw_ert)
950{ 1114{
951 struct emacs_runtime *ert = raw_ert; 1115 struct emacs_runtime *ert = raw_ert;
952 finalize_environment (&ert->private_members->pub); 1116 eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
1117 Vmodule_runtimes = XCDR (Vmodule_runtimes);
1118 finalize_environment (ert->private_members->env);
953} 1119}
954 1120
955void 1121void
956mark_modules (void) 1122mark_modules (void)
957{ 1123{
958 Lisp_Object tail = Vmodule_environments; 1124 for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
959 FOR_EACH_TAIL_SAFE (tail) 1125 tail = XCDR (tail))
960 { 1126 {
961 emacs_env *env = XSAVE_POINTER (XCAR (tail), 0); 1127 emacs_env *env = XSAVE_POINTER (XCAR (tail), 0);
962 struct emacs_env_private *priv = env->private_members; 1128 struct emacs_env_private *priv = env->private_members;
963 mark_object (priv->non_local_exit_symbol); 1129 mark_object (priv->non_local_exit_symbol);
964 mark_object (priv->non_local_exit_data); 1130 mark_object (priv->non_local_exit_data);
965 } 1131 mark_object (priv->values);
1132 }
966} 1133}
967 1134
968 1135
@@ -997,6 +1164,36 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
997} 1164}
998 1165
999 1166
1167/* Support for assertions. */
1168void
1169init_module_assertions (bool enable)
1170{
1171 module_assertions = enable;
1172 if (enable)
1173 {
1174 /* We use a hidden environment for storing the globals. This
1175 environment is never freed. */
1176 emacs_env env;
1177 global_env = initialize_environment (&env, &global_env_private);
1178 eassert (global_env != &env);
1179 }
1180}
1181
1182static noreturn void
1183ATTRIBUTE_FORMAT_PRINTF(1, 2)
1184module_abort (const char *format, ...)
1185{
1186 fputs ("Emacs module assertion: ", stderr);
1187 va_list args;
1188 va_start (args, format);
1189 vfprintf (stderr, format, args);
1190 va_end (args);
1191 putc ('\n', stderr);
1192 fflush (stderr);
1193 emacs_abort ();
1194}
1195
1196
1000/* Segment initializer. */ 1197/* Segment initializer. */
1001 1198
1002void 1199void
@@ -1016,6 +1213,14 @@ syms_of_module (void)
1016 Qnil, false); 1213 Qnil, false);
1017 Funintern (Qmodule_refs_hash, Qnil); 1214 Funintern (Qmodule_refs_hash, Qnil);
1018 1215
1216 DEFSYM (Qmodule_runtimes, "module-runtimes");
1217 DEFVAR_LISP ("module-runtimes", Vmodule_runtimes,
1218 doc: /* List of active module runtimes. */);
1219 Vmodule_runtimes = Qnil;
1220 /* Unintern `module-runtimes' because it is only used
1221 internally. */
1222 Funintern (Qmodule_runtimes, Qnil);
1223
1019 DEFSYM (Qmodule_environments, "module-environments"); 1224 DEFSYM (Qmodule_environments, "module-environments");
1020 DEFVAR_LISP ("module-environments", Vmodule_environments, 1225 DEFVAR_LISP ("module-environments", Vmodule_environments,
1021 doc: /* List of active module environments. */); 1226 doc: /* List of active module environments. */);
diff --git a/src/emacs.c b/src/emacs.c
index 49ebb817678..b0892c7ebb8 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -223,6 +223,7 @@ Initialization options:\n\
223--fg-daemon[=NAME] start a (named) server in the foreground\n\ 223--fg-daemon[=NAME] start a (named) server in the foreground\n\
224--debug-init enable Emacs Lisp debugger for init file\n\ 224--debug-init enable Emacs Lisp debugger for init file\n\
225--display, -d DISPLAY use X server DISPLAY\n\ 225--display, -d DISPLAY use X server DISPLAY\n\
226--module-assertions assert behavior of dynamic modules\n\
226", 227",
227 "\ 228 "\
228--no-build-details do not add build details such as time stamps\n\ 229--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
1263 build_details = ! argmatch (argv, argc, "-no-build-details", 1264 build_details = ! argmatch (argv, argc, "-no-build-details",
1264 "--no-build-details", 7, NULL, &skip_args); 1265 "--no-build-details", 7, NULL, &skip_args);
1265 1266
1267#ifdef HAVE_MODULES
1268 bool module_assertions
1269 = argmatch (argv, argc, "-module-assertions", "--module-assertions", 15,
1270 NULL, &skip_args);
1271 if (dumping && module_assertions)
1272 {
1273 fputs ("Module assertions are not supported during dumping\n", stderr);
1274 exit (1);
1275 }
1276 init_module_assertions (module_assertions);
1277#endif
1278
1266#ifdef HAVE_NS 1279#ifdef HAVE_NS
1267 ns_pool = ns_alloc_autorelease_pool (); 1280 ns_pool = ns_alloc_autorelease_pool ();
1268#ifdef NS_IMPL_GNUSTEP 1281#ifdef NS_IMPL_GNUSTEP
@@ -1720,6 +1733,7 @@ static const struct standard_args standard_args[] =
1720 { "-nl", "--no-loadup", 70, 0 }, 1733 { "-nl", "--no-loadup", 70, 0 },
1721 { "-nsl", "--no-site-lisp", 65, 0 }, 1734 { "-nsl", "--no-site-lisp", 65, 0 },
1722 { "-no-build-details", "--no-build-details", 63, 0 }, 1735 { "-no-build-details", "--no-build-details", 63, 0 },
1736 { "-module-assertions", "--module-assertions", 62, 0 },
1723 /* -d must come last before the options handled in startup.el. */ 1737 /* -d must come last before the options handled in startup.el. */
1724 { "-d", "--display", 60, 1 }, 1738 { "-d", "--display", 60, 1 },
1725 { "-display", 0, 60, 1 }, 1739 { "-display", 0, 60, 1 },
diff --git a/src/lisp.h b/src/lisp.h
index ade188fd209..ff8dde2b825 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3943,6 +3943,7 @@ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
3943extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *); 3943extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
3944extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); 3944extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
3945extern void mark_modules (void); 3945extern void mark_modules (void);
3946extern void init_module_assertions (bool);
3946extern void syms_of_module (void); 3947extern void syms_of_module (void);
3947#endif 3948#endif
3948 3949
diff --git a/test/Makefile.in b/test/Makefile.in
index 7b8c967128f..0c24c48e60e 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -68,7 +68,7 @@ EMACS_EXTRAOPT=
68# Command line flags for Emacs. 68# Command line flags for Emacs.
69# Apparently MSYS bash would convert "-L :" to "-L ;" anyway, 69# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
70# but we might as well be explicit. 70# but we might as well be explicit.
71EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) 71EMACSOPT = -batch --no-site-file --no-site-lisp -module-assertions -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
72 72
73# Prevent any settings in the user environment causing problems. 73# Prevent any settings in the user environment causing problems.
74unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS 74unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 309179d1501..fc29a0d6b9a 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[],
213 return env->intern (env, "t"); 213 return env->intern (env, "t");
214} 214}
215 215
216static emacs_value invalid_stored_value;
217
218/* The next two functions perform a possibly-invalid operation: they
219 store a value in a static variable and load it. This causes
220 undefined behavior if the environment that the value was created
221 from is no longer live. The module assertions check for this
222 error. */
223
224static emacs_value
225Fmod_test_invalid_store (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
226 void *data)
227{
228 return invalid_stored_value = env->make_integer (env, 123);
229}
230
231static emacs_value
232Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
233 void *data)
234{
235 return invalid_stored_value;
236}
237
216 238
217/* Lisp utilities for easier readability (simple wrappers). */ 239/* Lisp utilities for easier readability (simple wrappers). */
218 240
@@ -260,6 +282,8 @@ emacs_module_init (struct emacs_runtime *ert)
260 DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL); 282 DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
261 DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL); 283 DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
262 DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL); 284 DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
285 DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
286 DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
263 287
264#undef DEFUN 288#undef DEFUN
265 289
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 622bbadb3ef..99a853b17e0 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -19,9 +19,17 @@
19 19
20(require 'ert) 20(require 'ert)
21 21
22(require 'mod-test 22(defconst mod-test-emacs
23 (expand-file-name "data/emacs-module/mod-test" 23 (expand-file-name invocation-name invocation-directory)
24 (getenv "EMACS_TEST_DIRECTORY"))) 24 "File name of the Emacs binary currently running.")
25
26(eval-and-compile
27 (defconst mod-test-file
28 (substitute-in-file-name
29 "$EMACS_TEST_DIRECTORY/data/emacs-module/mod-test")
30 "File name of the module test file."))
31
32(require 'mod-test mod-test-file)
25 33
26;; 34;;
27;; Basic tests. 35;; Basic tests.
@@ -174,4 +182,30 @@ changes."
174 (should (equal (help-function-arglist #'mod-test-sum) 182 (should (equal (help-function-arglist #'mod-test-sum)
175 '(arg1 arg2)))) 183 '(arg1 arg2))))
176 184
185(ert-deftest module--test-assertions ()
186 "Check that -module-assertions work."
187 (skip-unless (file-executable-p mod-test-emacs))
188 ;; This doesn’t yet cause undefined behavior.
189 (should (eq (mod-test-invalid-store) 123))
190 (with-temp-buffer
191 (should (equal (call-process mod-test-emacs nil t nil
192 "-batch" "-Q" "-module-assertions" "-eval"
193 (prin1-to-string
194 `(progn
195 (require 'mod-test ,mod-test-file)
196 ;; Storing and reloading a local
197 ;; value causes undefined
198 ;; behavior, which should be
199 ;; detected by the module
200 ;; assertions.
201 (mod-test-invalid-store)
202 (mod-test-invalid-load))))
203 ;; FIXME: This string is probably different on
204 ;; Windows and Linux.
205 "Abort trap: 6"))
206 (re-search-backward (rx bos "Emacs module assertion: "
207 "Emacs value not found in "
208 (+ digit) " values of "
209 (+ digit) " environments" ?\n eos))))
210
177;;; emacs-module-tests.el ends here 211;;; emacs-module-tests.el ends here