aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorEli Zaretskii2019-03-21 21:29:52 +0200
committerEli Zaretskii2019-03-21 21:29:52 +0200
commit093d3e78d21d3d6c718997368ef4b31f9884401c (patch)
treec0abe35a3b3cfee61fe793feb7684a0cdf3bce00 /src
parentee7ad83f20903208404a84b58b7a478b62924570 (diff)
downloademacs-093d3e78d21d3d6c718997368ef4b31f9884401c.tar.gz
emacs-093d3e78d21d3d6c718997368ef4b31f9884401c.zip
Revert "Revert "Rely on conservative stack scanning to find "emacs_value"s""
This reverts commit ee7ad83f20903208404a84b58b7a478b62924570. There was no consensus on reverting 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a, so doing that will have to wait until the discussion ends.
Diffstat (limited to 'src')
-rw-r--r--src/emacs-module.c373
1 files changed, 198 insertions, 175 deletions
diff --git a/src/emacs-module.c b/src/emacs-module.c
index df9a491a864..4e2411cb295 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -25,7 +25,6 @@ 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>
29 28
30#include "lisp.h" 29#include "lisp.h"
31#include "dynlib.h" 30#include "dynlib.h"
@@ -66,6 +65,18 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
66#include "w32term.h" 65#include "w32term.h"
67#endif 66#endif
68 67
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
69/* Function prototype for the module init function. */ 80/* Function prototype for the module init function. */
70typedef int (*emacs_init_function) (struct emacs_runtime *); 81typedef int (*emacs_init_function) (struct emacs_runtime *);
71 82
@@ -76,43 +87,6 @@ typedef int (*emacs_init_function) (struct emacs_runtime *);
76typedef void (*emacs_finalizer_function) (void *); 87typedef void (*emacs_finalizer_function) (void *);
77 88
78 89
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
116/* Private runtime and environment members. */ 90/* Private runtime and environment members. */
117 91
118/* The private part of an environment stores the current non local exit state 92/* The private part of an environment stores the current non local exit state
@@ -125,9 +99,12 @@ struct emacs_env_private
125 /* Dedicated storage for non-local exit symbol and data so that 99 /* Dedicated storage for non-local exit symbol and data so that
126 storage is always available for them, even in an out-of-memory 100 storage is always available for them, even in an out-of-memory
127 situation. */ 101 situation. */
128 struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; 102 Lisp_Object non_local_exit_symbol, non_local_exit_data;
129 103
130 struct emacs_value_storage storage; 104 /* List of values allocated from this environment. The code uses
105 this only if the user gave the -module-assertions command-line
106 option. */
107 Lisp_Object values;
131}; 108};
132 109
133/* The private parts of an `emacs_runtime' object contain the initial 110/* The private parts of an `emacs_runtime' object contain the initial
@@ -141,7 +118,6 @@ struct emacs_runtime_private
141/* Forward declarations. */ 118/* Forward declarations. */
142 119
143static Lisp_Object value_to_lisp (emacs_value); 120static Lisp_Object value_to_lisp (emacs_value);
144static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object);
145static emacs_value lisp_to_value (emacs_env *, Lisp_Object); 121static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
146static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); 122static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
147static void module_assert_thread (void); 123static void module_assert_thread (void);
@@ -163,7 +139,16 @@ static void module_non_local_exit_throw_1 (emacs_env *,
163static void module_out_of_memory (emacs_env *); 139static void module_out_of_memory (emacs_env *);
164static void module_reset_handlerlist (struct handler **); 140static void module_reset_handlerlist (struct handler **);
165 141
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
166static bool module_assertions = false; 149static bool module_assertions = false;
150static emacs_env *global_env;
151static struct emacs_env_private global_env_private;
167 152
168/* Convenience macros for non-local exit handling. */ 153/* Convenience macros for non-local exit handling. */
169 154
@@ -308,7 +293,7 @@ module_get_environment (struct emacs_runtime *ert)
308static emacs_value 293static emacs_value
309module_make_global_ref (emacs_env *env, emacs_value ref) 294module_make_global_ref (emacs_env *env, emacs_value ref)
310{ 295{
311 MODULE_FUNCTION_BEGIN (NULL); 296 MODULE_FUNCTION_BEGIN (module_nil);
312 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); 297 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
313 Lisp_Object new_obj = value_to_lisp (ref); 298 Lisp_Object new_obj = value_to_lisp (ref);
314 EMACS_UINT hashcode; 299 EMACS_UINT hashcode;
@@ -328,7 +313,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
328 hash_put (h, new_obj, make_fixed_natnum (1), hashcode); 313 hash_put (h, new_obj, make_fixed_natnum (1), hashcode);
329 } 314 }
330 315
331 return allocate_emacs_value (env, &global_storage, new_obj); 316 return lisp_to_value (module_assertions ? global_env : env, new_obj);
332} 317}
333 318
334static void 319static void
@@ -356,16 +341,23 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
356 341
357 if (module_assertions) 342 if (module_assertions)
358 { 343 {
344 Lisp_Object globals = global_env_private.values;
345 Lisp_Object prev = Qnil;
359 ptrdiff_t count = 0; 346 ptrdiff_t count = 0;
360 for (struct emacs_value_frame *frame = &global_storage.initial; 347 for (Lisp_Object tail = globals; CONSP (tail);
361 frame != NULL; frame = frame->next) 348 tail = XCDR (tail))
362 { 349 {
363 for (int i = 0; i < frame->offset; ++i) 350 emacs_value global = xmint_pointer (XCAR (tail));
351 if (global == ref)
364 { 352 {
365 if (&frame->objects[i] == ref) 353 if (NILP (prev))
366 return; 354 global_env_private.values = XCDR (globals);
367 ++count; 355 else
356 XSETCDR (prev, XCDR (tail));
357 return;
368 } 358 }
359 ++count;
360 prev = tail;
369 } 361 }
370 module_abort ("Global value was not found in list of %"pD"d globals", 362 module_abort ("Global value was not found in list of %"pD"d globals",
371 count); 363 count);
@@ -396,8 +388,9 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
396 struct emacs_env_private *p = env->private_members; 388 struct emacs_env_private *p = env->private_members;
397 if (p->pending_non_local_exit != emacs_funcall_exit_return) 389 if (p->pending_non_local_exit != emacs_funcall_exit_return)
398 { 390 {
399 *sym = &p->non_local_exit_symbol; 391 /* FIXME: lisp_to_value can exit non-locally. */
400 *data = &p->non_local_exit_data; 392 *sym = lisp_to_value (env, p->non_local_exit_symbol);
393 *data = lisp_to_value (env, p->non_local_exit_data);
401 } 394 }
402 return p->pending_non_local_exit; 395 return p->pending_non_local_exit;
403} 396}
@@ -441,7 +434,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
441 emacs_subr subr, const char *documentation, 434 emacs_subr subr, const char *documentation,
442 void *data) 435 void *data)
443{ 436{
444 MODULE_FUNCTION_BEGIN (NULL); 437 MODULE_FUNCTION_BEGIN (module_nil);
445 438
446 if (! (0 <= min_arity 439 if (! (0 <= min_arity
447 && (max_arity < 0 440 && (max_arity < 0
@@ -474,7 +467,7 @@ static emacs_value
474module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, 467module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
475 emacs_value args[]) 468 emacs_value args[])
476{ 469{
477 MODULE_FUNCTION_BEGIN (NULL); 470 MODULE_FUNCTION_BEGIN (module_nil);
478 471
479 /* Make a new Lisp_Object array starting with the function as the 472 /* Make a new Lisp_Object array starting with the function as the
480 first arg, because that's what Ffuncall takes. */ 473 first arg, because that's what Ffuncall takes. */
@@ -495,14 +488,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
495static emacs_value 488static emacs_value
496module_intern (emacs_env *env, const char *name) 489module_intern (emacs_env *env, const char *name)
497{ 490{
498 MODULE_FUNCTION_BEGIN (NULL); 491 MODULE_FUNCTION_BEGIN (module_nil);
499 return lisp_to_value (env, intern (name)); 492 return lisp_to_value (env, intern (name));
500} 493}
501 494
502static emacs_value 495static emacs_value
503module_type_of (emacs_env *env, emacs_value value) 496module_type_of (emacs_env *env, emacs_value value)
504{ 497{
505 MODULE_FUNCTION_BEGIN (NULL); 498 MODULE_FUNCTION_BEGIN (module_nil);
506 return lisp_to_value (env, Ftype_of (value_to_lisp (value))); 499 return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
507} 500}
508 501
@@ -535,7 +528,7 @@ module_extract_integer (emacs_env *env, emacs_value n)
535static emacs_value 528static emacs_value
536module_make_integer (emacs_env *env, intmax_t n) 529module_make_integer (emacs_env *env, intmax_t n)
537{ 530{
538 MODULE_FUNCTION_BEGIN (NULL); 531 MODULE_FUNCTION_BEGIN (module_nil);
539 return lisp_to_value (env, make_int (n)); 532 return lisp_to_value (env, make_int (n));
540} 533}
541 534
@@ -551,7 +544,7 @@ module_extract_float (emacs_env *env, emacs_value f)
551static emacs_value 544static emacs_value
552module_make_float (emacs_env *env, double d) 545module_make_float (emacs_env *env, double d)
553{ 546{
554 MODULE_FUNCTION_BEGIN (NULL); 547 MODULE_FUNCTION_BEGIN (module_nil);
555 return lisp_to_value (env, make_float (d)); 548 return lisp_to_value (env, make_float (d));
556} 549}
557 550
@@ -588,7 +581,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
588static emacs_value 581static emacs_value
589module_make_string (emacs_env *env, const char *str, ptrdiff_t length) 582module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
590{ 583{
591 MODULE_FUNCTION_BEGIN (NULL); 584 MODULE_FUNCTION_BEGIN (module_nil);
592 if (! (0 <= length && length <= STRING_BYTES_BOUND)) 585 if (! (0 <= length && length <= STRING_BYTES_BOUND))
593 overflow_error (); 586 overflow_error ();
594 /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, 587 /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated,
@@ -601,7 +594,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
601static emacs_value 594static emacs_value
602module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) 595module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
603{ 596{
604 MODULE_FUNCTION_BEGIN (NULL); 597 MODULE_FUNCTION_BEGIN (module_nil);
605 return lisp_to_value (env, make_user_ptr (fin, ptr)); 598 return lisp_to_value (env, make_user_ptr (fin, ptr));
606} 599}
607 600
@@ -663,7 +656,7 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
663static emacs_value 656static emacs_value
664module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) 657module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
665{ 658{
666 MODULE_FUNCTION_BEGIN (NULL); 659 MODULE_FUNCTION_BEGIN (module_nil);
667 Lisp_Object lvec = value_to_lisp (vec); 660 Lisp_Object lvec = value_to_lisp (vec);
668 check_vec_index (lvec, i); 661 check_vec_index (lvec, i);
669 return lisp_to_value (env, AREF (lvec, i)); 662 return lisp_to_value (env, AREF (lvec, i));
@@ -706,11 +699,9 @@ module_signal_or_throw (struct emacs_env_private *env)
706 case emacs_funcall_exit_return: 699 case emacs_funcall_exit_return:
707 return; 700 return;
708 case emacs_funcall_exit_signal: 701 case emacs_funcall_exit_signal:
709 xsignal (value_to_lisp (&env->non_local_exit_symbol), 702 xsignal (env->non_local_exit_symbol, env->non_local_exit_data);
710 value_to_lisp (&env->non_local_exit_data));
711 case emacs_funcall_exit_throw: 703 case emacs_funcall_exit_throw:
712 Fthrow (value_to_lisp (&env->non_local_exit_symbol), 704 Fthrow (env->non_local_exit_symbol, env->non_local_exit_data);
713 value_to_lisp (&env->non_local_exit_data));
714 default: 705 default:
715 eassume (false); 706 eassume (false);
716 } 707 }
@@ -786,12 +777,17 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
786 record_unwind_protect_ptr (finalize_environment_unwind, env); 777 record_unwind_protect_ptr (finalize_environment_unwind, env);
787 778
788 USE_SAFE_ALLOCA; 779 USE_SAFE_ALLOCA;
789 emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; 780 ATTRIBUTE_MAY_ALIAS emacs_value *args;
790 for (ptrdiff_t i = 0; i < nargs; ++i) 781 if (plain_values && ! module_assertions)
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
791 { 787 {
792 args[i] = lisp_to_value (env, arglist[i]); 788 args = SAFE_ALLOCA (nargs * sizeof *args);
793 if (! args[i]) 789 for (ptrdiff_t i = 0; i < nargs; i++)
794 memory_full (sizeof *args[i]); 790 args[i] = lisp_to_value (env, arglist[i]);
795 } 791 }
796 792
797 emacs_value ret = func->subr (env, nargs, args, func->data); 793 emacs_value ret = func->subr (env, nargs, args, func->data);
@@ -871,8 +867,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
871 if (p->pending_non_local_exit == emacs_funcall_exit_return) 867 if (p->pending_non_local_exit == emacs_funcall_exit_return)
872 { 868 {
873 p->pending_non_local_exit = emacs_funcall_exit_signal; 869 p->pending_non_local_exit = emacs_funcall_exit_signal;
874 p->non_local_exit_symbol.v = sym; 870 p->non_local_exit_symbol = sym;
875 p->non_local_exit_data.v = data; 871 p->non_local_exit_data = data;
876 } 872 }
877} 873}
878 874
@@ -884,8 +880,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
884 if (p->pending_non_local_exit == emacs_funcall_exit_return) 880 if (p->pending_non_local_exit == emacs_funcall_exit_return)
885 { 881 {
886 p->pending_non_local_exit = emacs_funcall_exit_throw; 882 p->pending_non_local_exit = emacs_funcall_exit_throw;
887 p->non_local_exit_symbol.v = tag; 883 p->non_local_exit_symbol = tag;
888 p->non_local_exit_data.v = value; 884 p->non_local_exit_data = value;
889 } 885 }
890} 886}
891 887
@@ -902,8 +898,54 @@ module_out_of_memory (emacs_env *env)
902 898
903/* Value conversion. */ 899/* Value conversion. */
904 900
905/* Convert an `emacs_value' to the corresponding internal object. 901/* We represent Lisp objects differently depending on whether the user
906 Never fails. */ 902 gave -module-assertions. If assertions are disabled, emacs_value
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}
907 949
908/* If V was computed from lisp_to_value (O), then return O. 950/* If V was computed from lisp_to_value (O), then return O.
909 Exits non-locally only if the stack overflows. */ 951 Exits non-locally only if the stack overflows. */
@@ -914,134 +956,91 @@ value_to_lisp (emacs_value v)
914 { 956 {
915 /* Check the liveness of the value by iterating over all live 957 /* Check the liveness of the value by iterating over all live
916 environments. */ 958 environments. */
959 void *vptr = v;
960 ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr;
917 ptrdiff_t num_environments = 0; 961 ptrdiff_t num_environments = 0;
918 ptrdiff_t num_values = 0; 962 ptrdiff_t num_values = 0;
919 for (Lisp_Object environments = Vmodule_environments; 963 for (Lisp_Object environments = Vmodule_environments;
920 CONSP (environments); environments = XCDR (environments)) 964 CONSP (environments); environments = XCDR (environments))
921 { 965 {
922 emacs_env *env = xmint_pointer (XCAR (environments)); 966 emacs_env *env = xmint_pointer (XCAR (environments));
923 struct emacs_env_private *priv = env->private_members; 967 for (Lisp_Object values = env->private_members->values;
924 /* The value might be one of the nonlocal exit values. Note 968 CONSP (values); values = XCDR (values))
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)
933 { 969 {
934 for (int i = 0; i < frame->offset; ++i) 970 Lisp_Object *p = xmint_pointer (XCAR (values));
935 { 971 if (p == optr)
936 if (&frame->objects[i] == v) 972 return *p;
937 goto ok;
938 ++num_values;
939 }
940 }
941 ++num_environments;
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; 973 ++num_values;
952 } 974 }
975 ++num_environments;
953 } 976 }
954 module_abort (("Emacs value not found in %"pD"d values " 977 module_abort (("Emacs value not found in %"pD"d values "
955 "of %"pD"d environments"), 978 "of %"pD"d environments"),
956 num_values, num_environments); 979 num_values, num_environments);
957 } 980 }
958 981
959 ok: return v->v; 982 Lisp_Object o = value_to_lisp_bits (v);
983 if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
984 o = XCAR (o);
985 return o;
960} 986}
961 987
962/* Convert an internal object to an `emacs_value'. Allocate storage 988/* Attempt to convert O to an emacs_value. Do not do any checking
963 from the environment; return NULL if allocation fails. */ 989 or allocate any storage; the caller should prevent or detect
990 any resulting bit pattern that is not a valid emacs_value. */
964static emacs_value 991static emacs_value
965lisp_to_value (emacs_env *env, Lisp_Object o) 992lisp_to_value_bits (Lisp_Object o)
966{ 993{
967 struct emacs_env_private *p = env->private_members; 994 if (plain_values || USE_LSB_TAG)
968 if (p->pending_non_local_exit != emacs_funcall_exit_return) 995 return XLP (o);
969 return NULL;
970 return allocate_emacs_value (env, &p->storage, o);
971}
972 996
973/* Must be called for each frame before it can be used for allocation. */ 997 /* Compress O into the space of a pointer, possibly losing information. */
974static void 998 EMACS_UINT u = XLI (o);
975initialize_frame (struct emacs_value_frame *frame) 999 if (FIXNUMP (o))
976{
977 frame->offset = 0;
978 frame->next = NULL;
979}
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)
997 { 1000 {
998 struct emacs_value_frame *current = next; 1001 uintptr_t i = (u << VALBITS) + XTYPE (o);
999 next = current->next; 1002 return (emacs_value) i;
1000 free (current); 1003 }
1004 else
1005 {
1006 char *p = XLP (o);
1007 void *v = p - (u & ~VALMASK) + XTYPE (o);
1008 return v;
1001 } 1009 }
1002} 1010}
1003 1011
1004/* Allocate a new value from STORAGE and stores OBJ in it. Return 1012/* Convert O to an emacs_value. Allocate storage if needed; this can
1005 NULL if allocation fails and use ENV for non local exit reporting. */ 1013 signal if memory is exhausted. Must be an injective function. */
1006static emacs_value 1014static emacs_value
1007allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, 1015lisp_to_value (emacs_env *env, Lisp_Object o)
1008 Lisp_Object obj)
1009{ 1016{
1010 eassert (storage->current); 1017 if (module_assertions)
1011 eassert (storage->current->offset < value_frame_size);
1012 eassert (! storage->current->next);
1013 if (storage->current->offset == value_frame_size - 1)
1014 { 1018 {
1015 storage->current->next = malloc (sizeof *storage->current->next); 1019 /* Add the new value to the list of values allocated from this
1016 if (! storage->current->next) 1020 environment. The value is actually a pointer to the
1017 { 1021 Lisp_Object cast to emacs_value. We make a copy of the
1018 module_out_of_memory (env); 1022 object on the free store to guarantee unique addresses. */
1019 return NULL; 1023 ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o);
1020 } 1024 *optr = o;
1021 initialize_frame (storage->current->next); 1025 void *vptr = optr;
1022 storage->current = storage->current->next; 1026 ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
1027 struct emacs_env_private *priv = env->private_members;
1028 priv->values = Fcons (make_mint_ptr (ret), priv->values);
1029 return ret;
1023 } 1030 }
1024 emacs_value value = storage->current->objects + storage->current->offset;
1025 value->v = obj;
1026 ++storage->current->offset;
1027 return value;
1028}
1029 1031
1030/* Mark all objects allocated from local environments so that they 1032 emacs_value v = lisp_to_value_bits (o);
1031 don't get garbage-collected. */ 1033
1032void 1034 if (! EQ (o, value_to_lisp_bits (v)))
1033mark_modules (void)
1034{
1035 for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem))
1036 { 1035 {
1037 emacs_env *env = xmint_pointer (XCAR (tem)); 1036 /* Package the incompressible object pointer inside a pair
1038 struct emacs_env_private *priv = env->private_members; 1037 that is compressible. */
1039 for (struct emacs_value_frame *frame = &priv->storage.initial; 1038 Lisp_Object pair = Fcons (o, ltv_mark);
1040 frame != NULL; 1039 v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons);
1041 frame = frame->next)
1042 for (int i = 0; i < frame->offset; ++i)
1043 mark_object (frame->objects[i].v);
1044 } 1040 }
1041
1042 eassert (EQ (o, value_to_lisp (v)));
1043 return v;
1045} 1044}
1046 1045
1047 1046
@@ -1060,7 +1059,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1060 env = xmalloc (sizeof *env); 1059 env = xmalloc (sizeof *env);
1061 1060
1062 priv->pending_non_local_exit = emacs_funcall_exit_return; 1061 priv->pending_non_local_exit = emacs_funcall_exit_return;
1063 initialize_storage (&priv->storage); 1062 priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil;
1064 env->size = sizeof *env; 1063 env->size = sizeof *env;
1065 env->private_members = priv; 1064 env->private_members = priv;
1066 env->make_global_ref = module_make_global_ref; 1065 env->make_global_ref = module_make_global_ref;
@@ -1101,9 +1100,11 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1101static void 1100static void
1102finalize_environment (emacs_env *env) 1101finalize_environment (emacs_env *env)
1103{ 1102{
1104 finalize_storage (&env->private_members->storage);
1105 eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); 1103 eassert (xmint_pointer (XCAR (Vmodule_environments)) == env);
1106 Vmodule_environments = XCDR (Vmodule_environments); 1104 Vmodule_environments = XCDR (Vmodule_environments);
1105 if (module_assertions)
1106 /* There is always at least the global environment. */
1107 eassert (CONSP (Vmodule_environments));
1107} 1108}
1108 1109
1109static void 1110static void
@@ -1121,6 +1122,20 @@ finalize_runtime_unwind (void *raw_ert)
1121 finalize_environment (ert->private_members->env); 1122 finalize_environment (ert->private_members->env);
1122} 1123}
1123 1124
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
1124 1139
1125/* Non-local exit handling. */ 1140/* Non-local exit handling. */
1126 1141
@@ -1160,7 +1175,8 @@ init_module_assertions (bool enable)
1160 /* If enabling module assertions, use a hidden environment for 1175 /* If enabling module assertions, use a hidden environment for
1161 storing the globals. This environment is never freed. */ 1176 storing the globals. This environment is never freed. */
1162 module_assertions = enable; 1177 module_assertions = enable;
1163 initialize_storage (&global_storage); 1178 if (enable)
1179 global_env = initialize_environment (NULL, &global_env_private);
1164} 1180}
1165 1181
1166static _Noreturn void 1182static _Noreturn void
@@ -1183,6 +1199,13 @@ module_abort (const char *format, ...)
1183void 1199void
1184syms_of_module (void) 1200syms_of_module (void)
1185{ 1201{
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
1186 DEFSYM (Qmodule_refs_hash, "module-refs-hash"); 1209 DEFSYM (Qmodule_refs_hash, "module-refs-hash");
1187 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, 1210 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash,
1188 doc: /* Module global reference table. */); 1211 doc: /* Module global reference table. */);