diff options
| author | Eli Zaretskii | 2019-03-22 11:02:46 +0300 |
|---|---|---|
| committer | Eli Zaretskii | 2019-03-22 11:02:46 +0300 |
| commit | 09d746dad36e4780d379f975a84b1b076da78c50 (patch) | |
| tree | 372dc98e0774d029b23ad170c7a3bbe191b403e0 /src | |
| parent | 89fa7c4555f1c44c93ecdca23047bbfe3840cc33 (diff) | |
| download | emacs-09d746dad36e4780d379f975a84b1b076da78c50.tar.gz emacs-09d746dad36e4780d379f975a84b1b076da78c50.zip | |
Revert "Revert "Revert "Rely on conservative stack scanning to find "emacs_value"s"""
This reverts commit 093d3e78d21d3d6c718997368ef4b31f9884401c,
which reverted ee7ad83f20903208404a84b58b7a478b62924570,
which reverted 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a.
Diffstat (limited to 'src')
| -rw-r--r-- | src/emacs-module.c | 373 |
1 files changed, 175 insertions, 198 deletions
diff --git a/src/emacs-module.c b/src/emacs-module.c index 530a8ebefef..2bb1062574e 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c | |||
| @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 25 | #include <stddef.h> | 25 | #include <stddef.h> |
| 26 | #include <stdint.h> | 26 | #include <stdint.h> |
| 27 | #include <stdio.h> | 27 | #include <stdio.h> |
| 28 | #include <stdlib.h> | ||
| 28 | 29 | ||
| 29 | #include "lisp.h" | 30 | #include "lisp.h" |
| 30 | #include "dynlib.h" | 31 | #include "dynlib.h" |
| @@ -65,18 +66,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 65 | #include "w32term.h" | 66 | #include "w32term.h" |
| 66 | #endif | 67 | #endif |
| 67 | 68 | ||
| 68 | /* True if Lisp_Object and emacs_value have the same representation. | ||
| 69 | This is typically true unless WIDE_EMACS_INT. In practice, having | ||
| 70 | the same sizes and alignments and maximums should be a good enough | ||
| 71 | proxy for equality of representation. */ | ||
| 72 | enum | ||
| 73 | { | ||
| 74 | plain_values | ||
| 75 | = (sizeof (Lisp_Object) == sizeof (emacs_value) | ||
| 76 | && alignof (Lisp_Object) == alignof (emacs_value) | ||
| 77 | && INTPTR_MAX == EMACS_INT_MAX) | ||
| 78 | }; | ||
| 79 | |||
| 80 | /* Function prototype for the module init function. */ | 69 | /* Function prototype for the module init function. */ |
| 81 | typedef int (*emacs_init_function) (struct emacs_runtime *); | 70 | typedef int (*emacs_init_function) (struct emacs_runtime *); |
| 82 | 71 | ||
| @@ -87,6 +76,43 @@ typedef int (*emacs_init_function) (struct emacs_runtime *); | |||
| 87 | typedef void (*emacs_finalizer_function) (void *); | 76 | typedef void (*emacs_finalizer_function) (void *); |
| 88 | 77 | ||
| 89 | 78 | ||
| 79 | /* Memory management. */ | ||
| 80 | |||
| 81 | /* An `emacs_value' is just a pointer to a structure holding an | ||
| 82 | internal Lisp object. */ | ||
| 83 | struct emacs_value_tag { Lisp_Object v; }; | ||
| 84 | |||
| 85 | /* Local value objects use a simple fixed-sized block allocation | ||
| 86 | scheme without explicit deallocation. All local values are | ||
| 87 | deallocated when the lifetime of their environment ends. Keep | ||
| 88 | track of a current frame from which new values are allocated, | ||
| 89 | appending further dynamically-allocated frames if necessary. */ | ||
| 90 | |||
| 91 | enum { value_frame_size = 512 }; | ||
| 92 | |||
| 93 | /* A block from which `emacs_value' object can be allocated. */ | ||
| 94 | struct emacs_value_frame | ||
| 95 | { | ||
| 96 | /* Storage for values. */ | ||
| 97 | struct emacs_value_tag objects[value_frame_size]; | ||
| 98 | |||
| 99 | /* Index of the next free value in `objects'. */ | ||
| 100 | int offset; | ||
| 101 | |||
| 102 | /* Pointer to next frame, if any. */ | ||
| 103 | struct emacs_value_frame *next; | ||
| 104 | }; | ||
| 105 | |||
| 106 | /* A structure that holds an initial frame (so that the first local | ||
| 107 | values require no dynamic allocation) and keeps track of the | ||
| 108 | current frame. */ | ||
| 109 | static struct emacs_value_storage | ||
| 110 | { | ||
| 111 | struct emacs_value_frame initial; | ||
| 112 | struct emacs_value_frame *current; | ||
| 113 | } global_storage; | ||
| 114 | |||
| 115 | |||
| 90 | /* Private runtime and environment members. */ | 116 | /* Private runtime and environment members. */ |
| 91 | 117 | ||
| 92 | /* The private part of an environment stores the current non local exit state | 118 | /* The private part of an environment stores the current non local exit state |
| @@ -99,12 +125,9 @@ struct emacs_env_private | |||
| 99 | /* Dedicated storage for non-local exit symbol and data so that | 125 | /* Dedicated storage for non-local exit symbol and data so that |
| 100 | storage is always available for them, even in an out-of-memory | 126 | storage is always available for them, even in an out-of-memory |
| 101 | situation. */ | 127 | situation. */ |
| 102 | Lisp_Object non_local_exit_symbol, non_local_exit_data; | 128 | struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; |
| 103 | 129 | ||
| 104 | /* List of values allocated from this environment. The code uses | 130 | struct emacs_value_storage storage; |
| 105 | this only if the user gave the -module-assertions command-line | ||
| 106 | option. */ | ||
| 107 | Lisp_Object values; | ||
| 108 | }; | 131 | }; |
| 109 | 132 | ||
| 110 | /* The private parts of an `emacs_runtime' object contain the initial | 133 | /* The private parts of an `emacs_runtime' object contain the initial |
| @@ -118,6 +141,7 @@ struct emacs_runtime_private | |||
| 118 | /* Forward declarations. */ | 141 | /* Forward declarations. */ |
| 119 | 142 | ||
| 120 | static Lisp_Object value_to_lisp (emacs_value); | 143 | static Lisp_Object value_to_lisp (emacs_value); |
| 144 | static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); | ||
| 121 | static emacs_value lisp_to_value (emacs_env *, Lisp_Object); | 145 | static emacs_value lisp_to_value (emacs_env *, Lisp_Object); |
| 122 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); | 146 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); |
| 123 | static void module_assert_thread (void); | 147 | static void module_assert_thread (void); |
| @@ -139,16 +163,7 @@ static void module_non_local_exit_throw_1 (emacs_env *, | |||
| 139 | static void module_out_of_memory (emacs_env *); | 163 | static void module_out_of_memory (emacs_env *); |
| 140 | static void module_reset_handlerlist (struct handler **); | 164 | static void module_reset_handlerlist (struct handler **); |
| 141 | 165 | ||
| 142 | /* We used to return NULL when emacs_value was a different type from | ||
| 143 | Lisp_Object, but nowadays we just use Qnil instead. Although they | ||
| 144 | happen to be the same thing in the current implementation, module | ||
| 145 | code should not assume this. */ | ||
| 146 | verify (NIL_IS_ZERO); | ||
| 147 | static emacs_value const module_nil = 0; | ||
| 148 | |||
| 149 | static bool module_assertions = false; | 166 | static bool module_assertions = false; |
| 150 | static emacs_env *global_env; | ||
| 151 | static struct emacs_env_private global_env_private; | ||
| 152 | 167 | ||
| 153 | /* Convenience macros for non-local exit handling. */ | 168 | /* Convenience macros for non-local exit handling. */ |
| 154 | 169 | ||
| @@ -293,7 +308,7 @@ module_get_environment (struct emacs_runtime *ert) | |||
| 293 | static emacs_value | 308 | static emacs_value |
| 294 | module_make_global_ref (emacs_env *env, emacs_value ref) | 309 | module_make_global_ref (emacs_env *env, emacs_value ref) |
| 295 | { | 310 | { |
| 296 | MODULE_FUNCTION_BEGIN (module_nil); | 311 | MODULE_FUNCTION_BEGIN (NULL); |
| 297 | struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); | 312 | struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); |
| 298 | Lisp_Object new_obj = value_to_lisp (ref); | 313 | Lisp_Object new_obj = value_to_lisp (ref); |
| 299 | EMACS_UINT hashcode; | 314 | EMACS_UINT hashcode; |
| @@ -313,7 +328,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) | |||
| 313 | hash_put (h, new_obj, make_fixed_natnum (1), hashcode); | 328 | hash_put (h, new_obj, make_fixed_natnum (1), hashcode); |
| 314 | } | 329 | } |
| 315 | 330 | ||
| 316 | return lisp_to_value (module_assertions ? global_env : env, new_obj); | 331 | return allocate_emacs_value (env, &global_storage, new_obj); |
| 317 | } | 332 | } |
| 318 | 333 | ||
| 319 | static void | 334 | static void |
| @@ -341,23 +356,16 @@ module_free_global_ref (emacs_env *env, emacs_value ref) | |||
| 341 | 356 | ||
| 342 | if (module_assertions) | 357 | if (module_assertions) |
| 343 | { | 358 | { |
| 344 | Lisp_Object globals = global_env_private.values; | ||
| 345 | Lisp_Object prev = Qnil; | ||
| 346 | ptrdiff_t count = 0; | 359 | ptrdiff_t count = 0; |
| 347 | for (Lisp_Object tail = globals; CONSP (tail); | 360 | for (struct emacs_value_frame *frame = &global_storage.initial; |
| 348 | tail = XCDR (tail)) | 361 | frame != NULL; frame = frame->next) |
| 349 | { | 362 | { |
| 350 | emacs_value global = xmint_pointer (XCAR (tail)); | 363 | for (int i = 0; i < frame->offset; ++i) |
| 351 | if (global == ref) | ||
| 352 | { | 364 | { |
| 353 | if (NILP (prev)) | 365 | if (&frame->objects[i] == ref) |
| 354 | global_env_private.values = XCDR (globals); | 366 | return; |
| 355 | else | 367 | ++count; |
| 356 | XSETCDR (prev, XCDR (tail)); | ||
| 357 | return; | ||
| 358 | } | 368 | } |
| 359 | ++count; | ||
| 360 | prev = tail; | ||
| 361 | } | 369 | } |
| 362 | module_abort ("Global value was not found in list of %"pD"d globals", | 370 | module_abort ("Global value was not found in list of %"pD"d globals", |
| 363 | count); | 371 | count); |
| @@ -388,9 +396,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) | |||
| 388 | struct emacs_env_private *p = env->private_members; | 396 | struct emacs_env_private *p = env->private_members; |
| 389 | if (p->pending_non_local_exit != emacs_funcall_exit_return) | 397 | if (p->pending_non_local_exit != emacs_funcall_exit_return) |
| 390 | { | 398 | { |
| 391 | /* FIXME: lisp_to_value can exit non-locally. */ | 399 | *sym = &p->non_local_exit_symbol; |
| 392 | *sym = lisp_to_value (env, p->non_local_exit_symbol); | 400 | *data = &p->non_local_exit_data; |
| 393 | *data = lisp_to_value (env, p->non_local_exit_data); | ||
| 394 | } | 401 | } |
| 395 | return p->pending_non_local_exit; | 402 | return p->pending_non_local_exit; |
| 396 | } | 403 | } |
| @@ -434,7 +441,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, | |||
| 434 | emacs_subr subr, const char *documentation, | 441 | emacs_subr subr, const char *documentation, |
| 435 | void *data) | 442 | void *data) |
| 436 | { | 443 | { |
| 437 | MODULE_FUNCTION_BEGIN (module_nil); | 444 | MODULE_FUNCTION_BEGIN (NULL); |
| 438 | 445 | ||
| 439 | if (! (0 <= min_arity | 446 | if (! (0 <= min_arity |
| 440 | && (max_arity < 0 | 447 | && (max_arity < 0 |
| @@ -467,7 +474,7 @@ static emacs_value | |||
| 467 | module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, | 474 | module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, |
| 468 | emacs_value args[]) | 475 | emacs_value args[]) |
| 469 | { | 476 | { |
| 470 | MODULE_FUNCTION_BEGIN (module_nil); | 477 | MODULE_FUNCTION_BEGIN (NULL); |
| 471 | 478 | ||
| 472 | /* Make a new Lisp_Object array starting with the function as the | 479 | /* Make a new Lisp_Object array starting with the function as the |
| 473 | first arg, because that's what Ffuncall takes. */ | 480 | first arg, because that's what Ffuncall takes. */ |
| @@ -488,14 +495,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, | |||
| 488 | static emacs_value | 495 | static emacs_value |
| 489 | module_intern (emacs_env *env, const char *name) | 496 | module_intern (emacs_env *env, const char *name) |
| 490 | { | 497 | { |
| 491 | MODULE_FUNCTION_BEGIN (module_nil); | 498 | MODULE_FUNCTION_BEGIN (NULL); |
| 492 | return lisp_to_value (env, intern (name)); | 499 | return lisp_to_value (env, intern (name)); |
| 493 | } | 500 | } |
| 494 | 501 | ||
| 495 | static emacs_value | 502 | static emacs_value |
| 496 | module_type_of (emacs_env *env, emacs_value value) | 503 | module_type_of (emacs_env *env, emacs_value value) |
| 497 | { | 504 | { |
| 498 | MODULE_FUNCTION_BEGIN (module_nil); | 505 | MODULE_FUNCTION_BEGIN (NULL); |
| 499 | return lisp_to_value (env, Ftype_of (value_to_lisp (value))); | 506 | return lisp_to_value (env, Ftype_of (value_to_lisp (value))); |
| 500 | } | 507 | } |
| 501 | 508 | ||
| @@ -528,7 +535,7 @@ module_extract_integer (emacs_env *env, emacs_value n) | |||
| 528 | static emacs_value | 535 | static emacs_value |
| 529 | module_make_integer (emacs_env *env, intmax_t n) | 536 | module_make_integer (emacs_env *env, intmax_t n) |
| 530 | { | 537 | { |
| 531 | MODULE_FUNCTION_BEGIN (module_nil); | 538 | MODULE_FUNCTION_BEGIN (NULL); |
| 532 | return lisp_to_value (env, make_int (n)); | 539 | return lisp_to_value (env, make_int (n)); |
| 533 | } | 540 | } |
| 534 | 541 | ||
| @@ -544,7 +551,7 @@ module_extract_float (emacs_env *env, emacs_value f) | |||
| 544 | static emacs_value | 551 | static emacs_value |
| 545 | module_make_float (emacs_env *env, double d) | 552 | module_make_float (emacs_env *env, double d) |
| 546 | { | 553 | { |
| 547 | MODULE_FUNCTION_BEGIN (module_nil); | 554 | MODULE_FUNCTION_BEGIN (NULL); |
| 548 | return lisp_to_value (env, make_float (d)); | 555 | return lisp_to_value (env, make_float (d)); |
| 549 | } | 556 | } |
| 550 | 557 | ||
| @@ -581,7 +588,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, | |||
| 581 | static emacs_value | 588 | static emacs_value |
| 582 | module_make_string (emacs_env *env, const char *str, ptrdiff_t length) | 589 | module_make_string (emacs_env *env, const char *str, ptrdiff_t length) |
| 583 | { | 590 | { |
| 584 | MODULE_FUNCTION_BEGIN (module_nil); | 591 | MODULE_FUNCTION_BEGIN (NULL); |
| 585 | if (! (0 <= length && length <= STRING_BYTES_BOUND)) | 592 | if (! (0 <= length && length <= STRING_BYTES_BOUND)) |
| 586 | overflow_error (); | 593 | overflow_error (); |
| 587 | /* FIXME: AUTO_STRING_WITH_LEN requires STR to be NUL-terminated, | 594 | /* FIXME: AUTO_STRING_WITH_LEN requires STR to be NUL-terminated, |
| @@ -594,7 +601,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) | |||
| 594 | static emacs_value | 601 | static emacs_value |
| 595 | module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) | 602 | module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) |
| 596 | { | 603 | { |
| 597 | MODULE_FUNCTION_BEGIN (module_nil); | 604 | MODULE_FUNCTION_BEGIN (NULL); |
| 598 | return lisp_to_value (env, make_user_ptr (fin, ptr)); | 605 | return lisp_to_value (env, make_user_ptr (fin, ptr)); |
| 599 | } | 606 | } |
| 600 | 607 | ||
| @@ -656,7 +663,7 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) | |||
| 656 | static emacs_value | 663 | static emacs_value |
| 657 | module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) | 664 | module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) |
| 658 | { | 665 | { |
| 659 | MODULE_FUNCTION_BEGIN (module_nil); | 666 | MODULE_FUNCTION_BEGIN (NULL); |
| 660 | Lisp_Object lvec = value_to_lisp (vec); | 667 | Lisp_Object lvec = value_to_lisp (vec); |
| 661 | check_vec_index (lvec, i); | 668 | check_vec_index (lvec, i); |
| 662 | return lisp_to_value (env, AREF (lvec, i)); | 669 | return lisp_to_value (env, AREF (lvec, i)); |
| @@ -699,9 +706,11 @@ module_signal_or_throw (struct emacs_env_private *env) | |||
| 699 | case emacs_funcall_exit_return: | 706 | case emacs_funcall_exit_return: |
| 700 | return; | 707 | return; |
| 701 | case emacs_funcall_exit_signal: | 708 | case emacs_funcall_exit_signal: |
| 702 | xsignal (env->non_local_exit_symbol, env->non_local_exit_data); | 709 | xsignal (value_to_lisp (&env->non_local_exit_symbol), |
| 710 | value_to_lisp (&env->non_local_exit_data)); | ||
| 703 | case emacs_funcall_exit_throw: | 711 | case emacs_funcall_exit_throw: |
| 704 | Fthrow (env->non_local_exit_symbol, env->non_local_exit_data); | 712 | Fthrow (value_to_lisp (&env->non_local_exit_symbol), |
| 713 | value_to_lisp (&env->non_local_exit_data)); | ||
| 705 | default: | 714 | default: |
| 706 | eassume (false); | 715 | eassume (false); |
| 707 | } | 716 | } |
| @@ -777,17 +786,12 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) | |||
| 777 | record_unwind_protect_ptr (finalize_environment_unwind, env); | 786 | record_unwind_protect_ptr (finalize_environment_unwind, env); |
| 778 | 787 | ||
| 779 | USE_SAFE_ALLOCA; | 788 | USE_SAFE_ALLOCA; |
| 780 | ATTRIBUTE_MAY_ALIAS emacs_value *args; | 789 | emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; |
| 781 | if (plain_values && ! module_assertions) | 790 | for (ptrdiff_t i = 0; i < nargs; ++i) |
| 782 | /* FIXME: The cast below is incorrect because the argument array | ||
| 783 | is not declared as const, so module functions can modify it. | ||
| 784 | Either declare it as const, or remove this branch. */ | ||
| 785 | args = (emacs_value *) arglist; | ||
| 786 | else | ||
| 787 | { | 791 | { |
| 788 | args = SAFE_ALLOCA (nargs * sizeof *args); | 792 | args[i] = lisp_to_value (env, arglist[i]); |
| 789 | for (ptrdiff_t i = 0; i < nargs; i++) | 793 | if (! args[i]) |
| 790 | args[i] = lisp_to_value (env, arglist[i]); | 794 | memory_full (sizeof *args[i]); |
| 791 | } | 795 | } |
| 792 | 796 | ||
| 793 | emacs_value ret = func->subr (env, nargs, args, func->data); | 797 | emacs_value ret = func->subr (env, nargs, args, func->data); |
| @@ -867,8 +871,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, | |||
| 867 | if (p->pending_non_local_exit == emacs_funcall_exit_return) | 871 | if (p->pending_non_local_exit == emacs_funcall_exit_return) |
| 868 | { | 872 | { |
| 869 | p->pending_non_local_exit = emacs_funcall_exit_signal; | 873 | p->pending_non_local_exit = emacs_funcall_exit_signal; |
| 870 | p->non_local_exit_symbol = sym; | 874 | p->non_local_exit_symbol.v = sym; |
| 871 | p->non_local_exit_data = data; | 875 | p->non_local_exit_data.v = data; |
| 872 | } | 876 | } |
| 873 | } | 877 | } |
| 874 | 878 | ||
| @@ -880,8 +884,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, | |||
| 880 | if (p->pending_non_local_exit == emacs_funcall_exit_return) | 884 | if (p->pending_non_local_exit == emacs_funcall_exit_return) |
| 881 | { | 885 | { |
| 882 | p->pending_non_local_exit = emacs_funcall_exit_throw; | 886 | p->pending_non_local_exit = emacs_funcall_exit_throw; |
| 883 | p->non_local_exit_symbol = tag; | 887 | p->non_local_exit_symbol.v = tag; |
| 884 | p->non_local_exit_data = value; | 888 | p->non_local_exit_data.v = value; |
| 885 | } | 889 | } |
| 886 | } | 890 | } |
| 887 | 891 | ||
| @@ -898,54 +902,8 @@ module_out_of_memory (emacs_env *env) | |||
| 898 | 902 | ||
| 899 | /* Value conversion. */ | 903 | /* Value conversion. */ |
| 900 | 904 | ||
| 901 | /* We represent Lisp objects differently depending on whether the user | 905 | /* Convert an `emacs_value' to the corresponding internal object. |
| 902 | gave -module-assertions. If assertions are disabled, emacs_value | 906 | Never fails. */ |
| 903 | objects are Lisp_Objects cast to emacs_value. If assertions are | ||
| 904 | enabled, emacs_value objects are pointers to Lisp_Object objects | ||
| 905 | allocated from the free store; they are never freed, which ensures | ||
| 906 | that their addresses are unique and can be used for liveness | ||
| 907 | checking. */ | ||
| 908 | |||
| 909 | /* Unique Lisp_Object used to mark those emacs_values which are really | ||
| 910 | just containers holding a Lisp_Object that does not fit as an emacs_value, | ||
| 911 | either because it is an integer out of range, or is not properly aligned. | ||
| 912 | Used only if !plain_values. */ | ||
| 913 | static Lisp_Object ltv_mark; | ||
| 914 | |||
| 915 | /* Convert V to the corresponding internal object O, such that | ||
| 916 | V == lisp_to_value_bits (O). Never fails. */ | ||
| 917 | static Lisp_Object | ||
| 918 | value_to_lisp_bits (emacs_value v) | ||
| 919 | { | ||
| 920 | if (plain_values || USE_LSB_TAG) | ||
| 921 | return XPL (v); | ||
| 922 | |||
| 923 | /* With wide EMACS_INT and when tag bits are the most significant, | ||
| 924 | reassembling integers differs from reassembling pointers in two | ||
| 925 | ways. First, save and restore the least-significant bits of the | ||
| 926 | integer, not the most-significant bits. Second, sign-extend the | ||
| 927 | integer when restoring, but zero-extend pointers because that | ||
| 928 | makes TAG_PTR faster. */ | ||
| 929 | |||
| 930 | intptr_t i = (intptr_t) v; | ||
| 931 | EMACS_UINT tag = i & ((1 << GCTYPEBITS) - 1); | ||
| 932 | EMACS_UINT untagged = i - tag; | ||
| 933 | switch (tag) | ||
| 934 | { | ||
| 935 | case_Lisp_Int: | ||
| 936 | { | ||
| 937 | bool negative = tag & 1; | ||
| 938 | EMACS_UINT sign_extension | ||
| 939 | = negative ? VALMASK & ~(INTPTR_MAX >> INTTYPEBITS): 0; | ||
| 940 | uintptr_t u = i; | ||
| 941 | intptr_t all_but_sign = u >> GCTYPEBITS; | ||
| 942 | untagged = sign_extension + all_but_sign; | ||
| 943 | break; | ||
| 944 | } | ||
| 945 | } | ||
| 946 | |||
| 947 | return XIL ((tag << VALBITS) + untagged); | ||
| 948 | } | ||
| 949 | 907 | ||
| 950 | /* If V was computed from lisp_to_value (O), then return O. | 908 | /* If V was computed from lisp_to_value (O), then return O. |
| 951 | Exits non-locally only if the stack overflows. */ | 909 | Exits non-locally only if the stack overflows. */ |
| @@ -956,91 +914,134 @@ value_to_lisp (emacs_value v) | |||
| 956 | { | 914 | { |
| 957 | /* Check the liveness of the value by iterating over all live | 915 | /* Check the liveness of the value by iterating over all live |
| 958 | environments. */ | 916 | environments. */ |
| 959 | void *vptr = v; | ||
| 960 | ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr; | ||
| 961 | ptrdiff_t num_environments = 0; | 917 | ptrdiff_t num_environments = 0; |
| 962 | ptrdiff_t num_values = 0; | 918 | ptrdiff_t num_values = 0; |
| 963 | for (Lisp_Object environments = Vmodule_environments; | 919 | for (Lisp_Object environments = Vmodule_environments; |
| 964 | CONSP (environments); environments = XCDR (environments)) | 920 | CONSP (environments); environments = XCDR (environments)) |
| 965 | { | 921 | { |
| 966 | emacs_env *env = xmint_pointer (XCAR (environments)); | 922 | emacs_env *env = xmint_pointer (XCAR (environments)); |
| 967 | for (Lisp_Object values = env->private_members->values; | 923 | struct emacs_env_private *priv = env->private_members; |
| 968 | CONSP (values); values = XCDR (values)) | 924 | /* The value might be one of the nonlocal exit values. Note |
| 925 | that we don't check whether a nonlocal exit is currently | ||
| 926 | pending, because the module might have cleared the flag | ||
| 927 | in the meantime. */ | ||
| 928 | if (&priv->non_local_exit_symbol == v | ||
| 929 | || &priv->non_local_exit_data == v) | ||
| 930 | goto ok; | ||
| 931 | for (struct emacs_value_frame *frame = &priv->storage.initial; | ||
| 932 | frame != NULL; frame = frame->next) | ||
| 969 | { | 933 | { |
| 970 | Lisp_Object *p = xmint_pointer (XCAR (values)); | 934 | for (int i = 0; i < frame->offset; ++i) |
| 971 | if (p == optr) | 935 | { |
| 972 | return *p; | 936 | if (&frame->objects[i] == v) |
| 973 | ++num_values; | 937 | goto ok; |
| 938 | ++num_values; | ||
| 939 | } | ||
| 974 | } | 940 | } |
| 975 | ++num_environments; | 941 | ++num_environments; |
| 976 | } | 942 | } |
| 943 | /* Also check global values. */ | ||
| 944 | for (struct emacs_value_frame *frame = &global_storage.initial; | ||
| 945 | frame != NULL; frame = frame->next) | ||
| 946 | { | ||
| 947 | for (int i = 0; i < frame->offset; ++i) | ||
| 948 | { | ||
| 949 | if (&frame->objects[i] == v) | ||
| 950 | goto ok; | ||
| 951 | ++num_values; | ||
| 952 | } | ||
| 953 | } | ||
| 977 | module_abort (("Emacs value not found in %"pD"d values " | 954 | module_abort (("Emacs value not found in %"pD"d values " |
| 978 | "of %"pD"d environments"), | 955 | "of %"pD"d environments"), |
| 979 | num_values, num_environments); | 956 | num_values, num_environments); |
| 980 | } | 957 | } |
| 981 | 958 | ||
| 982 | Lisp_Object o = value_to_lisp_bits (v); | 959 | ok: return v->v; |
| 983 | if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark)) | ||
| 984 | o = XCAR (o); | ||
| 985 | return o; | ||
| 986 | } | 960 | } |
| 987 | 961 | ||
| 988 | /* Attempt to convert O to an emacs_value. Do not do any checking | 962 | /* Convert an internal object to an `emacs_value'. Allocate storage |
| 989 | or allocate any storage; the caller should prevent or detect | 963 | from the environment; return NULL if allocation fails. */ |
| 990 | any resulting bit pattern that is not a valid emacs_value. */ | ||
| 991 | static emacs_value | 964 | static emacs_value |
| 992 | lisp_to_value_bits (Lisp_Object o) | 965 | lisp_to_value (emacs_env *env, Lisp_Object o) |
| 993 | { | 966 | { |
| 994 | if (plain_values || USE_LSB_TAG) | 967 | struct emacs_env_private *p = env->private_members; |
| 995 | return XLP (o); | 968 | if (p->pending_non_local_exit != emacs_funcall_exit_return) |
| 969 | return NULL; | ||
| 970 | return allocate_emacs_value (env, &p->storage, o); | ||
| 971 | } | ||
| 996 | 972 | ||
| 997 | /* Compress O into the space of a pointer, possibly losing information. */ | 973 | /* Must be called for each frame before it can be used for allocation. */ |
| 998 | EMACS_UINT u = XLI (o); | 974 | static void |
| 999 | if (FIXNUMP (o)) | 975 | initialize_frame (struct emacs_value_frame *frame) |
| 1000 | { | 976 | { |
| 1001 | uintptr_t i = (u << VALBITS) + XTYPE (o); | 977 | frame->offset = 0; |
| 1002 | return (emacs_value) i; | 978 | frame->next = NULL; |
| 1003 | } | 979 | } |
| 1004 | else | 980 | |
| 981 | /* Must be called for any storage object before it can be used for | ||
| 982 | allocation. */ | ||
| 983 | static void | ||
| 984 | initialize_storage (struct emacs_value_storage *storage) | ||
| 985 | { | ||
| 986 | initialize_frame (&storage->initial); | ||
| 987 | storage->current = &storage->initial; | ||
| 988 | } | ||
| 989 | |||
| 990 | /* Must be called for any initialized storage object before its | ||
| 991 | lifetime ends. Free all dynamically-allocated frames. */ | ||
| 992 | static void | ||
| 993 | finalize_storage (struct emacs_value_storage *storage) | ||
| 994 | { | ||
| 995 | struct emacs_value_frame *next = storage->initial.next; | ||
| 996 | while (next != NULL) | ||
| 1005 | { | 997 | { |
| 1006 | char *p = XLP (o); | 998 | struct emacs_value_frame *current = next; |
| 1007 | void *v = p - (u & ~VALMASK) + XTYPE (o); | 999 | next = current->next; |
| 1008 | return v; | 1000 | free (current); |
| 1009 | } | 1001 | } |
| 1010 | } | 1002 | } |
| 1011 | 1003 | ||
| 1012 | /* Convert O to an emacs_value. Allocate storage if needed; this can | 1004 | /* Allocate a new value from STORAGE and stores OBJ in it. Return |
| 1013 | signal if memory is exhausted. Must be an injective function. */ | 1005 | NULL if allocation fails and use ENV for non local exit reporting. */ |
| 1014 | static emacs_value | 1006 | static emacs_value |
| 1015 | lisp_to_value (emacs_env *env, Lisp_Object o) | 1007 | allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, |
| 1008 | Lisp_Object obj) | ||
| 1016 | { | 1009 | { |
| 1017 | if (module_assertions) | 1010 | eassert (storage->current); |
| 1011 | eassert (storage->current->offset < value_frame_size); | ||
| 1012 | eassert (! storage->current->next); | ||
| 1013 | if (storage->current->offset == value_frame_size - 1) | ||
| 1018 | { | 1014 | { |
| 1019 | /* Add the new value to the list of values allocated from this | 1015 | storage->current->next = malloc (sizeof *storage->current->next); |
| 1020 | environment. The value is actually a pointer to the | 1016 | if (! storage->current->next) |
| 1021 | Lisp_Object cast to emacs_value. We make a copy of the | 1017 | { |
| 1022 | object on the free store to guarantee unique addresses. */ | 1018 | module_out_of_memory (env); |
| 1023 | ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o); | 1019 | return NULL; |
| 1024 | *optr = o; | 1020 | } |
| 1025 | void *vptr = optr; | 1021 | initialize_frame (storage->current->next); |
| 1026 | ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr; | 1022 | storage->current = storage->current->next; |
| 1027 | struct emacs_env_private *priv = env->private_members; | ||
| 1028 | priv->values = Fcons (make_mint_ptr (ret), priv->values); | ||
| 1029 | return ret; | ||
| 1030 | } | 1023 | } |
| 1024 | emacs_value value = storage->current->objects + storage->current->offset; | ||
| 1025 | value->v = obj; | ||
| 1026 | ++storage->current->offset; | ||
| 1027 | return value; | ||
| 1028 | } | ||
| 1031 | 1029 | ||
| 1032 | emacs_value v = lisp_to_value_bits (o); | 1030 | /* Mark all objects allocated from local environments so that they |
| 1033 | 1031 | don't get garbage-collected. */ | |
| 1034 | if (! EQ (o, value_to_lisp_bits (v))) | 1032 | void |
| 1033 | mark_modules (void) | ||
| 1034 | { | ||
| 1035 | for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) | ||
| 1035 | { | 1036 | { |
| 1036 | /* Package the incompressible object pointer inside a pair | 1037 | emacs_env *env = xmint_pointer (XCAR (tem)); |
| 1037 | that is compressible. */ | 1038 | struct emacs_env_private *priv = env->private_members; |
| 1038 | Lisp_Object pair = Fcons (o, ltv_mark); | 1039 | for (struct emacs_value_frame *frame = &priv->storage.initial; |
| 1039 | v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons); | 1040 | frame != NULL; |
| 1041 | frame = frame->next) | ||
| 1042 | for (int i = 0; i < frame->offset; ++i) | ||
| 1043 | mark_object (frame->objects[i].v); | ||
| 1040 | } | 1044 | } |
| 1041 | |||
| 1042 | eassert (EQ (o, value_to_lisp (v))); | ||
| 1043 | return v; | ||
| 1044 | } | 1045 | } |
| 1045 | 1046 | ||
| 1046 | 1047 | ||
| @@ -1059,7 +1060,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) | |||
| 1059 | env = xmalloc (sizeof *env); | 1060 | env = xmalloc (sizeof *env); |
| 1060 | 1061 | ||
| 1061 | priv->pending_non_local_exit = emacs_funcall_exit_return; | 1062 | priv->pending_non_local_exit = emacs_funcall_exit_return; |
| 1062 | priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil; | 1063 | initialize_storage (&priv->storage); |
| 1063 | env->size = sizeof *env; | 1064 | env->size = sizeof *env; |
| 1064 | env->private_members = priv; | 1065 | env->private_members = priv; |
| 1065 | env->make_global_ref = module_make_global_ref; | 1066 | env->make_global_ref = module_make_global_ref; |
| @@ -1100,11 +1101,9 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) | |||
| 1100 | static void | 1101 | static void |
| 1101 | finalize_environment (emacs_env *env) | 1102 | finalize_environment (emacs_env *env) |
| 1102 | { | 1103 | { |
| 1104 | finalize_storage (&env->private_members->storage); | ||
| 1103 | eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); | 1105 | eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); |
| 1104 | Vmodule_environments = XCDR (Vmodule_environments); | 1106 | Vmodule_environments = XCDR (Vmodule_environments); |
| 1105 | if (module_assertions) | ||
| 1106 | /* There is always at least the global environment. */ | ||
| 1107 | eassert (CONSP (Vmodule_environments)); | ||
| 1108 | } | 1107 | } |
| 1109 | 1108 | ||
| 1110 | static void | 1109 | static void |
| @@ -1122,20 +1121,6 @@ finalize_runtime_unwind (void *raw_ert) | |||
| 1122 | finalize_environment (ert->private_members->env); | 1121 | finalize_environment (ert->private_members->env); |
| 1123 | } | 1122 | } |
| 1124 | 1123 | ||
| 1125 | void | ||
| 1126 | mark_modules (void) | ||
| 1127 | { | ||
| 1128 | for (Lisp_Object tail = Vmodule_environments; CONSP (tail); | ||
| 1129 | tail = XCDR (tail)) | ||
| 1130 | { | ||
| 1131 | emacs_env *env = xmint_pointer (XCAR (tail)); | ||
| 1132 | struct emacs_env_private *priv = env->private_members; | ||
| 1133 | mark_object (priv->non_local_exit_symbol); | ||
| 1134 | mark_object (priv->non_local_exit_data); | ||
| 1135 | mark_object (priv->values); | ||
| 1136 | } | ||
| 1137 | } | ||
| 1138 | |||
| 1139 | 1124 | ||
| 1140 | /* Non-local exit handling. */ | 1125 | /* Non-local exit handling. */ |
| 1141 | 1126 | ||
| @@ -1175,8 +1160,7 @@ init_module_assertions (bool enable) | |||
| 1175 | /* If enabling module assertions, use a hidden environment for | 1160 | /* If enabling module assertions, use a hidden environment for |
| 1176 | storing the globals. This environment is never freed. */ | 1161 | storing the globals. This environment is never freed. */ |
| 1177 | module_assertions = enable; | 1162 | module_assertions = enable; |
| 1178 | if (enable) | 1163 | initialize_storage (&global_storage); |
| 1179 | global_env = initialize_environment (NULL, &global_env_private); | ||
| 1180 | } | 1164 | } |
| 1181 | 1165 | ||
| 1182 | static _Noreturn void | 1166 | static _Noreturn void |
| @@ -1199,13 +1183,6 @@ module_abort (const char *format, ...) | |||
| 1199 | void | 1183 | void |
| 1200 | syms_of_module (void) | 1184 | syms_of_module (void) |
| 1201 | { | 1185 | { |
| 1202 | if (!plain_values) | ||
| 1203 | { | ||
| 1204 | ltv_mark = Fcons (Qnil, Qnil); | ||
| 1205 | staticpro (<v_mark); | ||
| 1206 | } | ||
| 1207 | eassert (NILP (value_to_lisp (module_nil))); | ||
| 1208 | |||
| 1209 | DEFSYM (Qmodule_refs_hash, "module-refs-hash"); | 1186 | DEFSYM (Qmodule_refs_hash, "module-refs-hash"); |
| 1210 | DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, | 1187 | DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, |
| 1211 | doc: /* Module global reference table. */); | 1188 | doc: /* Module global reference table. */); |