aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorEli Zaretskii2019-03-22 11:02:46 +0300
committerEli Zaretskii2019-03-22 11:02:46 +0300
commit09d746dad36e4780d379f975a84b1b076da78c50 (patch)
tree372dc98e0774d029b23ad170c7a3bbe191b403e0 /src
parent89fa7c4555f1c44c93ecdca23047bbfe3840cc33 (diff)
downloademacs-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.c373
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. */
72enum
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. */
81typedef int (*emacs_init_function) (struct emacs_runtime *); 70typedef int (*emacs_init_function) (struct emacs_runtime *);
82 71
@@ -87,6 +76,43 @@ typedef int (*emacs_init_function) (struct emacs_runtime *);
87typedef void (*emacs_finalizer_function) (void *); 76typedef 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. */
83struct 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
91enum { value_frame_size = 512 };
92
93/* A block from which `emacs_value' object can be allocated. */
94struct 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. */
109static 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
120static Lisp_Object value_to_lisp (emacs_value); 143static Lisp_Object value_to_lisp (emacs_value);
144static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object);
121static emacs_value lisp_to_value (emacs_env *, Lisp_Object); 145static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
122static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); 146static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
123static void module_assert_thread (void); 147static void module_assert_thread (void);
@@ -139,16 +163,7 @@ static void module_non_local_exit_throw_1 (emacs_env *,
139static void module_out_of_memory (emacs_env *); 163static void module_out_of_memory (emacs_env *);
140static void module_reset_handlerlist (struct handler **); 164static 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. */
146verify (NIL_IS_ZERO);
147static emacs_value const module_nil = 0;
148
149static bool module_assertions = false; 166static bool module_assertions = false;
150static emacs_env *global_env;
151static 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)
293static emacs_value 308static emacs_value
294module_make_global_ref (emacs_env *env, emacs_value ref) 309module_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
319static void 334static 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
467module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, 474module_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,
488static emacs_value 495static emacs_value
489module_intern (emacs_env *env, const char *name) 496module_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
495static emacs_value 502static emacs_value
496module_type_of (emacs_env *env, emacs_value value) 503module_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)
528static emacs_value 535static emacs_value
529module_make_integer (emacs_env *env, intmax_t n) 536module_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)
544static emacs_value 551static emacs_value
545module_make_float (emacs_env *env, double d) 552module_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,
581static emacs_value 588static emacs_value
582module_make_string (emacs_env *env, const char *str, ptrdiff_t length) 589module_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)
594static emacs_value 601static emacs_value
595module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) 602module_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)
656static emacs_value 663static emacs_value
657module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) 664module_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. */
913static 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. */
917static Lisp_Object
918value_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. */
991static emacs_value 964static emacs_value
992lisp_to_value_bits (Lisp_Object o) 965lisp_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); 974static void
999 if (FIXNUMP (o)) 975initialize_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. */
983static void
984initialize_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. */
992static void
993finalize_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. */
1014static emacs_value 1006static emacs_value
1015lisp_to_value (emacs_env *env, Lisp_Object o) 1007allocate_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))) 1032void
1033mark_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)
1100static void 1101static void
1101finalize_environment (emacs_env *env) 1102finalize_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
1110static void 1109static 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
1125void
1126mark_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
1182static _Noreturn void 1166static _Noreturn void
@@ -1199,13 +1183,6 @@ module_abort (const char *format, ...)
1199void 1183void
1200syms_of_module (void) 1184syms_of_module (void)
1201{ 1185{
1202 if (!plain_values)
1203 {
1204 ltv_mark = Fcons (Qnil, Qnil);
1205 staticpro (&ltv_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. */);