aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorStefan Monnier2015-11-30 14:34:42 -0500
committerStefan Monnier2015-11-30 14:34:42 -0500
commit3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a (patch)
tree3ac52925ea81e1f3119f0582d7aa011310140afe /src
parent17fa6ba8245010f2e2eaa7918a1343b9b07f3c56 (diff)
downloademacs-3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a.tar.gz
emacs-3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a.zip
Rely on conservative stack scanning to find "emacs_value"s
* src/emacs-module.c (struct emacs_value_tag) (struct emacs_value_frame, struct emacs_value_storage): Remove. (value_frame_size): Remove constant. (struct emacs_env_private): Use Lisp_Object for non_local_exit info. (lisp_to_value): Remove first arg. (module_nil): New constant. Use it instead of NULL when returning an emacs_value. (module_make_function): Adjust to new calling convention of Qinternal_module_call. (DEFUN): Receive args in an array rather than a list. Use SAFE_ALLOCA rather than xnmalloc. Skip the lisp_to_value loop when we don't have WIDE_EMACS_INT. Adjust to new type of non_local_exit info. (module_non_local_exit_signal_1, module_non_local_exit_throw_1): Adjust to new type of non_local_exit info. (ltv_mark) [WIDE_EMACS_INT]: New constant. (value_to_lisp, lisp_to_value): Rewrite. (initialize_frame, initialize_storage, finalize_storage): Remove functions. (allocate_emacs_value): Remove function. (mark_modules): Gut it. (initialize_environment): Don't initialize storage any more. Keep the actual env object on Vmodule_environments. (finalize_environment): Don't finalize storage any more. (syms_of_module): Initialize ltv_mark and module_nil. * src/emacs-module.h (emacs_value): Make it more clear that this type is really opaque, including the fact that NULL may not be valid. * modules/mod-test/mod-test.c (Fmod_test_signal, Fmod_test_throw): Don't assume that NULL is a valid emacs_value.
Diffstat (limited to 'src')
-rw-r--r--src/emacs-module.c318
-rw-r--r--src/emacs-module.h3
2 files changed, 148 insertions, 173 deletions
diff --git a/src/emacs-module.c b/src/emacs-module.c
index ac12f8789a4..69649b236a1 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -57,43 +57,6 @@ static DWORD main_thread;
57#endif 57#endif
58 58
59 59
60/* Memory management. */
61
62/* An `emacs_value' is just a pointer to a structure holding an
63 internal Lisp object. */
64struct emacs_value_tag { Lisp_Object v; };
65
66/* Local value objects use a simple fixed-sized block allocation
67 scheme without explicit deallocation. All local values are
68 deallocated when the lifetime of their environment ends. Keep
69 track of a current frame from which new values are allocated,
70 appending further dynamically-allocated frames if necessary. */
71
72enum { value_frame_size = 512 };
73
74/* A block from which `emacs_value' object can be allocated. */
75struct emacs_value_frame
76{
77 /* Storage for values. */
78 struct emacs_value_tag objects[value_frame_size];
79
80 /* Index of the next free value in `objects'. */
81 int offset;
82
83 /* Pointer to next frame, if any. */
84 struct emacs_value_frame *next;
85};
86
87/* A structure that holds an initial frame (so that the first local
88 values require no dynamic allocation) and keeps track of the
89 current frame. */
90static struct emacs_value_storage
91{
92 struct emacs_value_frame initial;
93 struct emacs_value_frame *current;
94} global_storage;
95
96
97/* Private runtime and environment members. */ 60/* Private runtime and environment members. */
98 61
99/* The private part of an environment stores the current non local exit state 62/* The private part of an environment stores the current non local exit state
@@ -106,9 +69,7 @@ struct emacs_env_private
106 /* Dedicated storage for non-local exit symbol and data so that 69 /* Dedicated storage for non-local exit symbol and data so that
107 storage is always available for them, even in an out-of-memory 70 storage is always available for them, even in an out-of-memory
108 situation. */ 71 situation. */
109 struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; 72 Lisp_Object non_local_exit_symbol, non_local_exit_data;
110
111 struct emacs_value_storage storage;
112}; 73};
113 74
114/* The private parts of an `emacs_runtime' object contain the initial 75/* The private parts of an `emacs_runtime' object contain the initial
@@ -127,8 +88,7 @@ struct module_fun_env;
127 88
128static Lisp_Object module_format_fun_env (const struct module_fun_env *); 89static Lisp_Object module_format_fun_env (const struct module_fun_env *);
129static Lisp_Object value_to_lisp (emacs_value); 90static Lisp_Object value_to_lisp (emacs_value);
130static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); 91static emacs_value lisp_to_value (Lisp_Object);
131static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
132static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); 92static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
133static void check_main_thread (void); 93static void check_main_thread (void);
134static void finalize_environment (struct emacs_env_private *); 94static void finalize_environment (struct emacs_env_private *);
@@ -142,6 +102,9 @@ static void module_out_of_memory (emacs_env *);
142static void module_reset_handlerlist (const int *); 102static void module_reset_handlerlist (const int *);
143static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object); 103static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
144 104
105/* We used to return NULL when emacs_value was a different type from
106 Lisp_Object, but nowadays we just use Qnil instead. */
107static emacs_value module_nil;
145 108
146/* Convenience macros for non-local exit handling. */ 109/* Convenience macros for non-local exit handling. */
147 110
@@ -277,7 +240,7 @@ module_get_environment (struct emacs_runtime *ert)
277static emacs_value 240static emacs_value
278module_make_global_ref (emacs_env *env, emacs_value ref) 241module_make_global_ref (emacs_env *env, emacs_value ref)
279{ 242{
280 MODULE_FUNCTION_BEGIN (NULL); 243 MODULE_FUNCTION_BEGIN (module_nil);
281 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); 244 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
282 Lisp_Object new_obj = value_to_lisp (ref); 245 Lisp_Object new_obj = value_to_lisp (ref);
283 EMACS_UINT hashcode; 246 EMACS_UINT hashcode;
@@ -290,7 +253,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
290 if (refcount > MOST_POSITIVE_FIXNUM) 253 if (refcount > MOST_POSITIVE_FIXNUM)
291 { 254 {
292 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); 255 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
293 return NULL; 256 return module_nil;
294 } 257 }
295 value = make_natnum (refcount); 258 value = make_natnum (refcount);
296 set_hash_value_slot (h, i, value); 259 set_hash_value_slot (h, i, value);
@@ -300,7 +263,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
300 hash_put (h, new_obj, make_natnum (1), hashcode); 263 hash_put (h, new_obj, make_natnum (1), hashcode);
301 } 264 }
302 265
303 return allocate_emacs_value (env, &global_storage, new_obj); 266 return lisp_to_value (new_obj);
304} 267}
305 268
306static void 269static void
@@ -350,8 +313,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
350 struct emacs_env_private *p = env->private_members; 313 struct emacs_env_private *p = env->private_members;
351 if (p->pending_non_local_exit != emacs_funcall_exit_return) 314 if (p->pending_non_local_exit != emacs_funcall_exit_return)
352 { 315 {
353 *sym = &p->non_local_exit_symbol; 316 *sym = lisp_to_value (p->non_local_exit_symbol);
354 *data = &p->non_local_exit_data; 317 *data = lisp_to_value (p->non_local_exit_data);
355 } 318 }
356 return p->pending_non_local_exit; 319 return p->pending_non_local_exit;
357} 320}
@@ -387,7 +350,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
387 emacs_subr subr, const char *documentation, 350 emacs_subr subr, const char *documentation,
388 void *data) 351 void *data)
389{ 352{
390 MODULE_FUNCTION_BEGIN (NULL); 353 MODULE_FUNCTION_BEGIN (module_nil);
391 354
392 if (! (0 <= min_arity 355 if (! (0 <= min_arity
393 && (max_arity < 0 356 && (max_arity < 0
@@ -408,21 +371,23 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
408 ? code_convert_string_norecord (build_unibyte_string (documentation), 371 ? code_convert_string_norecord (build_unibyte_string (documentation),
409 Qutf_8, false) 372 Qutf_8, false)
410 : Qnil); 373 : Qnil);
374 /* FIXME: Use a bytecompiled object, or even better a subr. */
411 Lisp_Object ret = list4 (Qlambda, 375 Lisp_Object ret = list4 (Qlambda,
412 list2 (Qand_rest, Qargs), 376 list2 (Qand_rest, Qargs),
413 doc, 377 doc,
414 list3 (Qinternal_module_call, 378 list4 (Qapply,
379 list2 (Qfunction, Qinternal_module_call),
415 envobj, 380 envobj,
416 Qargs)); 381 Qargs));
417 382
418 return lisp_to_value (env, ret); 383 return lisp_to_value (ret);
419} 384}
420 385
421static emacs_value 386static emacs_value
422module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, 387module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
423 emacs_value args[]) 388 emacs_value args[])
424{ 389{
425 MODULE_FUNCTION_BEGIN (NULL); 390 MODULE_FUNCTION_BEGIN (module_nil);
426 391
427 /* Make a new Lisp_Object array starting with the function as the 392 /* Make a new Lisp_Object array starting with the function as the
428 first arg, because that's what Ffuncall takes. */ 393 first arg, because that's what Ffuncall takes. */
@@ -432,7 +397,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
432 newargs[0] = value_to_lisp (fun); 397 newargs[0] = value_to_lisp (fun);
433 for (ptrdiff_t i = 0; i < nargs; i++) 398 for (ptrdiff_t i = 0; i < nargs; i++)
434 newargs[1 + i] = value_to_lisp (args[i]); 399 newargs[1 + i] = value_to_lisp (args[i]);
435 emacs_value result = lisp_to_value (env, Ffuncall (nargs + 1, newargs)); 400 emacs_value result = lisp_to_value (Ffuncall (nargs + 1, newargs));
436 SAFE_FREE (); 401 SAFE_FREE ();
437 return result; 402 return result;
438} 403}
@@ -440,15 +405,15 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
440static emacs_value 405static emacs_value
441module_intern (emacs_env *env, const char *name) 406module_intern (emacs_env *env, const char *name)
442{ 407{
443 MODULE_FUNCTION_BEGIN (NULL); 408 MODULE_FUNCTION_BEGIN (module_nil);
444 return lisp_to_value (env, intern (name)); 409 return lisp_to_value (intern (name));
445} 410}
446 411
447static emacs_value 412static emacs_value
448module_type_of (emacs_env *env, emacs_value value) 413module_type_of (emacs_env *env, emacs_value value)
449{ 414{
450 MODULE_FUNCTION_BEGIN (NULL); 415 MODULE_FUNCTION_BEGIN (module_nil);
451 return lisp_to_value (env, Ftype_of (value_to_lisp (value))); 416 return lisp_to_value (Ftype_of (value_to_lisp (value)));
452} 417}
453 418
454static bool 419static bool
@@ -485,13 +450,13 @@ module_extract_integer (emacs_env *env, emacs_value n)
485static emacs_value 450static emacs_value
486module_make_integer (emacs_env *env, intmax_t n) 451module_make_integer (emacs_env *env, intmax_t n)
487{ 452{
488 MODULE_FUNCTION_BEGIN (NULL); 453 MODULE_FUNCTION_BEGIN (module_nil);
489 if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM)) 454 if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM))
490 { 455 {
491 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); 456 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
492 return NULL; 457 return module_nil;
493 } 458 }
494 return lisp_to_value (env, make_number (n)); 459 return lisp_to_value (make_number (n));
495} 460}
496 461
497static double 462static double
@@ -510,8 +475,8 @@ module_extract_float (emacs_env *env, emacs_value f)
510static emacs_value 475static emacs_value
511module_make_float (emacs_env *env, double d) 476module_make_float (emacs_env *env, double d)
512{ 477{
513 MODULE_FUNCTION_BEGIN (NULL); 478 MODULE_FUNCTION_BEGIN (module_nil);
514 return lisp_to_value (env, make_float (d)); 479 return lisp_to_value (make_float (d));
515} 480}
516 481
517static bool 482static bool
@@ -561,22 +526,21 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
561static emacs_value 526static emacs_value
562module_make_string (emacs_env *env, const char *str, ptrdiff_t length) 527module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
563{ 528{
564 MODULE_FUNCTION_BEGIN (NULL); 529 MODULE_FUNCTION_BEGIN (module_nil);
565 if (length > STRING_BYTES_BOUND) 530 if (length > STRING_BYTES_BOUND)
566 { 531 {
567 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); 532 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
568 return NULL; 533 return module_nil;
569 } 534 }
570 Lisp_Object lstr = make_unibyte_string (str, length); 535 Lisp_Object lstr = make_unibyte_string (str, length);
571 return lisp_to_value (env, 536 return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
572 code_convert_string_norecord (lstr, Qutf_8, false));
573} 537}
574 538
575static emacs_value 539static emacs_value
576module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) 540module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
577{ 541{
578 MODULE_FUNCTION_BEGIN (NULL); 542 MODULE_FUNCTION_BEGIN (module_nil);
579 return lisp_to_value (env, make_user_ptr (fin, ptr)); 543 return lisp_to_value (make_user_ptr (fin, ptr));
580} 544}
581 545
582static void * 546static void *
@@ -656,12 +620,12 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
656static emacs_value 620static emacs_value
657module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) 621module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
658{ 622{
659 MODULE_FUNCTION_BEGIN (NULL); 623 MODULE_FUNCTION_BEGIN (module_nil);
660 Lisp_Object lvec = value_to_lisp (vec); 624 Lisp_Object lvec = value_to_lisp (vec);
661 if (! VECTORP (lvec)) 625 if (! VECTORP (lvec))
662 { 626 {
663 module_wrong_type (env, Qvectorp, lvec); 627 module_wrong_type (env, Qvectorp, lvec);
664 return NULL; 628 return module_nil;
665 } 629 }
666 if (! (0 <= i && i < ASIZE (lvec))) 630 if (! (0 <= i && i < ASIZE (lvec)))
667 { 631 {
@@ -669,9 +633,9 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
669 module_args_out_of_range (env, lvec, make_number (i)); 633 module_args_out_of_range (env, lvec, make_number (i));
670 else 634 else
671 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); 635 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
672 return NULL; 636 return module_nil;
673 } 637 }
674 return lisp_to_value (env, AREF (lvec, i)); 638 return lisp_to_value (AREF (lvec, i));
675} 639}
676 640
677static ptrdiff_t 641static ptrdiff_t
@@ -734,19 +698,26 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
734 return Qt; 698 return Qt;
735} 699}
736 700
737DEFUN ("internal--module-call", Finternal_module_call, Sinternal_module_call, 2, 2, 0, 701DEFUN ("internal--module-call", Finternal_module_call, Sinternal_module_call, 1, MANY, 0,
738 doc: /* Internal function to call a module function. 702 doc: /* Internal function to call a module function.
739ENVOBJ is a save pointer to a module_fun_env structure. 703ENVOBJ is a save pointer to a module_fun_env structure.
740ARGLIST is a list of arguments passed to SUBRPTR, or nil. */) 704ARGLIST is a list of arguments passed to SUBRPTR.
741 (Lisp_Object envobj, Lisp_Object arglist) 705usage: (module-call ENVOBJ &rest ARGLIST) */)
706 (ptrdiff_t nargs, Lisp_Object *arglist)
742{ 707{
708 Lisp_Object envobj = arglist[0];
709 /* FIXME: Rather than use a save_value, we should create a new object type.
710 Making save_value visible to Lisp is wrong. */
743 CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj); 711 CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
744 struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj); 712 struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
745 CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj); 713 CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj);
746 if (!NILP (arglist)) 714 /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
747 CHECK_CONS (arglist); 715 is a module_fun_env pointer. If some other part of Emacs also
716 exports save_value objects to Elisp, than we may be getting here this
717 other kind of save_value which will likely hold something completely
718 different in this field. */
748 struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0); 719 struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
749 EMACS_INT len = XFASTINT (Flength (arglist)); 720 EMACS_INT len = nargs - 1;
750 eassume (0 <= envptr->min_arity); 721 eassume (0 <= envptr->min_arity);
751 if (! (envptr->min_arity <= len 722 if (! (envptr->min_arity <= len
752 && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX : envptr->max_arity))) 723 && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX : envptr->max_arity)))
@@ -757,18 +728,20 @@ ARGLIST is a list of arguments passed to SUBRPTR, or nil. */)
757 struct emacs_env_private priv; 728 struct emacs_env_private priv;
758 initialize_environment (&pub, &priv); 729 initialize_environment (&pub, &priv);
759 730
760 emacs_value *args = xnmalloc (len, sizeof *args); 731 USE_SAFE_ALLOCA;
732#ifdef WIDE_EMACS_INT
733 emacs_value *args = SAFE_ALLOCA (len * sizeof *args);
761 734
762 for (ptrdiff_t i = 0; i < len; i++) 735 for (ptrdiff_t i = 0; i < len; i++)
763 { 736 args[i] = lisp_to_value (arglist[i + 1]);
764 args[i] = lisp_to_value (&pub, XCAR (arglist)); 737#else
765 if (! args[i]) 738 /* BEWARE! Here, we assume that Lisp_Object and
766 memory_full (sizeof *args[i]); 739 * emacs_value have the exact same representation. */
767 arglist = XCDR (arglist); 740 emacs_value *args = (emacs_value*) arglist + 1;
768 } 741#endif
769 742
770 emacs_value ret = envptr->subr (&pub, len, args, envptr->data); 743 emacs_value ret = envptr->subr (&pub, len, args, envptr->data);
771 xfree (args); 744 SAFE_FREE();
772 745
773 eassert (&priv == pub.private_members); 746 eassert (&priv == pub.private_members);
774 747
@@ -776,20 +749,18 @@ ARGLIST is a list of arguments passed to SUBRPTR, or nil. */)
776 { 749 {
777 case emacs_funcall_exit_return: 750 case emacs_funcall_exit_return:
778 finalize_environment (&priv); 751 finalize_environment (&priv);
779 if (ret == NULL)
780 xsignal1 (Qinvalid_module_call, module_format_fun_env (envptr));
781 return value_to_lisp (ret); 752 return value_to_lisp (ret);
782 case emacs_funcall_exit_signal: 753 case emacs_funcall_exit_signal:
783 { 754 {
784 Lisp_Object symbol = value_to_lisp (&priv.non_local_exit_symbol); 755 Lisp_Object symbol = priv.non_local_exit_symbol;
785 Lisp_Object data = value_to_lisp (&priv.non_local_exit_data); 756 Lisp_Object data = priv.non_local_exit_data;
786 finalize_environment (&priv); 757 finalize_environment (&priv);
787 xsignal (symbol, data); 758 xsignal (symbol, data);
788 } 759 }
789 case emacs_funcall_exit_throw: 760 case emacs_funcall_exit_throw:
790 { 761 {
791 Lisp_Object tag = value_to_lisp (&priv.non_local_exit_symbol); 762 Lisp_Object tag = priv.non_local_exit_symbol;
792 Lisp_Object value = value_to_lisp (&priv.non_local_exit_data); 763 Lisp_Object value = priv.non_local_exit_data;
793 finalize_environment (&priv); 764 finalize_environment (&priv);
794 Fthrow (tag, value); 765 Fthrow (tag, value);
795 } 766 }
@@ -821,8 +792,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
821 if (p->pending_non_local_exit == emacs_funcall_exit_return) 792 if (p->pending_non_local_exit == emacs_funcall_exit_return)
822 { 793 {
823 p->pending_non_local_exit = emacs_funcall_exit_signal; 794 p->pending_non_local_exit = emacs_funcall_exit_signal;
824 p->non_local_exit_symbol.v = sym; 795 p->non_local_exit_symbol = sym;
825 p->non_local_exit_data.v = data; 796 p->non_local_exit_data = data;
826 } 797 }
827} 798}
828 799
@@ -834,8 +805,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
834 if (p->pending_non_local_exit == emacs_funcall_exit_return) 805 if (p->pending_non_local_exit == emacs_funcall_exit_return)
835 { 806 {
836 p->pending_non_local_exit = emacs_funcall_exit_throw; 807 p->pending_non_local_exit = emacs_funcall_exit_throw;
837 p->non_local_exit_symbol.v = tag; 808 p->non_local_exit_symbol = tag;
838 p->non_local_exit_data.v = value; 809 p->non_local_exit_data = value;
839 } 810 }
840} 811}
841 812
@@ -867,99 +838,101 @@ module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
867 838
868/* Value conversion. */ 839/* Value conversion. */
869 840
841#ifdef WIDE_EMACS_INT
842/* Unique Lisp_Object used to mark those emacs_values which are really
843 just containers holding a Lisp_Object that's too large for emacs_value. */
844static Lisp_Object ltv_mark;
845#endif
846
870/* Convert an `emacs_value' to the corresponding internal object. 847/* Convert an `emacs_value' to the corresponding internal object.
871 Never fails. */ 848 Never fails. */
872static Lisp_Object 849static Lisp_Object
873value_to_lisp (emacs_value v) 850value_to_lisp (emacs_value v)
874{ 851{
875 return v->v; 852#ifdef WIDE_EMACS_INT
853 EMACS_INT tmp = (EMACS_INT)v;
854 int tag = tmp & ((1 << GCTYPEBITS) - 1);
855 Lisp_Object o;
856 switch (tag)
857 {
858 case_Lisp_Int:
859 o = make_lisp_ptr ((tmp - tag) >> GCTYPEBITS, tag); break;
860 default:
861 o = make_lisp_ptr ((void*)(tmp - tag), tag);
862 }
863 /* eassert (lisp_to_value (o) == v); */
864 if (CONSP (o) && EQ (XCDR (o), ltv_mark))
865 return XCAR (o);
866 else
867 return o;
868#else
869 Lisp_Object o = XIL ((EMACS_INT) v);
870 /* Check the assumption made elsewhere that Lisp_Object and emacs_value
871 share the same underlying bit representation. */
872 eassert (EQ (o, *(Lisp_Object*)&v));
873 /* eassert (lisp_to_value (o) == v); */
874 return o;
875#endif
876} 876}
877 877
878/* Convert an internal object to an `emacs_value'. Allocate storage 878/* Convert an internal object to an `emacs_value'. Allocate storage
879 from the environment; return NULL if allocation fails. */ 879 from the environment; return NULL if allocation fails. */
880static emacs_value 880static emacs_value
881lisp_to_value (emacs_env *env, Lisp_Object o) 881lisp_to_value (Lisp_Object o)
882{
883 struct emacs_env_private *p = env->private_members;
884 if (p->pending_non_local_exit != emacs_funcall_exit_return)
885 return NULL;
886 return allocate_emacs_value (env, &p->storage, o);
887}
888
889
890/* Memory management. */
891
892/* Must be called for each frame before it can be used for allocation. */
893static void
894initialize_frame (struct emacs_value_frame *frame)
895{
896 frame->offset = 0;
897 frame->next = NULL;
898}
899
900/* Must be called for any storage object before it can be used for
901 allocation. */
902static void
903initialize_storage (struct emacs_value_storage *storage)
904{ 882{
905 initialize_frame (&storage->initial); 883 EMACS_INT i = XLI (o);
906 storage->current = &storage->initial; 884#ifdef WIDE_EMACS_INT
907} 885 /* We need to compress the EMACS_INT into the space of a pointer.
908 886 For most objects, this is just a question of shuffling the tags around.
909/* Must be called for any initialized storage object before its 887 But in some cases (e.g. large integers) this can't be done, so we
910 lifetime ends. Free all dynamically-allocated frames. */ 888 should allocate a special object to hold the extra data. */
911static void 889 int tag = XTYPE (o);
912finalize_storage (struct emacs_value_storage *storage) 890 switch (tag)
913{
914 struct emacs_value_frame *next = storage->initial.next;
915 while (next != NULL)
916 { 891 {
917 struct emacs_value_frame *current = next; 892 case_Lisp_Int:
918 next = current->next; 893 {
919 free (current); 894 EMACS_UINT val = i & VALMASK;
895 if (val == (EMACS_UINT)(emacs_value)val)
896 {
897 emacs_value v = (emacs_value) ((val << GCTYPEBITS) | tag);
898 eassert (EQ (value_to_lisp (v), o));
899 return v;
900 }
901 else
902 o = Fcons (o, ltv_mark);
903 } /* FALLTHROUGH */
904 default:
905 {
906 void *ptr = XUNTAG (o, tag);
907 if (((EMACS_UINT)ptr) & ((1 << GCTYPEBITS) - 1))
908 { /* Pointer is not properly aligned! */
909 eassert (!CONSP (o)); /* Cons cells have to always be aligned! */
910 o = Fcons (o, ltv_mark);
911 ptr = XUNTAG (o, tag);
912 }
913 emacs_value v = (emacs_value)(((EMACS_UINT) ptr) | tag);
914 eassert (EQ (value_to_lisp (v), o));
915 return v;
916 }
920 } 917 }
918#else
919 emacs_value v = (emacs_value)i;
920 /* Check the assumption made elsewhere that Lisp_Object and emacs_value
921 share the same underlying bit representation. */
922 eassert (v == *(emacs_value*)&o);
923 eassert (EQ (value_to_lisp (v), o));
924 return v;
925#endif
921} 926}
922 927
923/* Allocate a new value from STORAGE and stores OBJ in it. Return 928
924 NULL if allocation fails and use ENV for non local exit reporting. */ 929/* Memory management. */
925static emacs_value
926allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage,
927 Lisp_Object obj)
928{
929 eassert (storage->current);
930 eassert (storage->current->offset < value_frame_size);
931 eassert (! storage->current->next);
932 if (storage->current->offset == value_frame_size - 1)
933 {
934 storage->current->next = malloc (sizeof *storage->current->next);
935 if (! storage->current->next)
936 {
937 module_out_of_memory (env);
938 return NULL;
939 }
940 initialize_frame (storage->current->next);
941 storage->current = storage->current->next;
942 }
943 emacs_value value = storage->current->objects + storage->current->offset;
944 value->v = obj;
945 ++storage->current->offset;
946 return value;
947}
948 930
949/* Mark all objects allocated from local environments so that they 931/* Mark all objects allocated from local environments so that they
950 don't get garbage-collected. */ 932 don't get garbage-collected. */
951void 933void
952mark_modules (void) 934mark_modules (void)
953{ 935{
954 for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem))
955 {
956 struct emacs_env_private *priv = XSAVE_POINTER (tem, 0);
957 for (struct emacs_value_frame *frame = &priv->storage.initial;
958 frame != NULL;
959 frame = frame->next)
960 for (int i = 0; i < frame->offset; ++i)
961 mark_object (frame->objects[i].v);
962 }
963} 936}
964 937
965 938
@@ -970,7 +943,6 @@ static void
970initialize_environment (emacs_env *env, struct emacs_env_private *priv) 943initialize_environment (emacs_env *env, struct emacs_env_private *priv)
971{ 944{
972 priv->pending_non_local_exit = emacs_funcall_exit_return; 945 priv->pending_non_local_exit = emacs_funcall_exit_return;
973 initialize_storage (&priv->storage);
974 env->size = sizeof *env; 946 env->size = sizeof *env;
975 env->private_members = priv; 947 env->private_members = priv;
976 env->make_global_ref = module_make_global_ref; 948 env->make_global_ref = module_make_global_ref;
@@ -1000,7 +972,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1000 env->vec_set = module_vec_set; 972 env->vec_set = module_vec_set;
1001 env->vec_get = module_vec_get; 973 env->vec_get = module_vec_get;
1002 env->vec_size = module_vec_size; 974 env->vec_size = module_vec_size;
1003 Vmodule_environments = Fcons (make_save_ptr (priv), Vmodule_environments); 975 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
1004} 976}
1005 977
1006/* Must be called before the lifetime of the environment object 978/* Must be called before the lifetime of the environment object
@@ -1008,7 +980,6 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1008static void 980static void
1009finalize_environment (struct emacs_env_private *env) 981finalize_environment (struct emacs_env_private *env)
1010{ 982{
1011 finalize_storage (&env->storage);
1012 Vmodule_environments = XCDR (Vmodule_environments); 983 Vmodule_environments = XCDR (Vmodule_environments);
1013} 984}
1014 985
@@ -1072,6 +1043,11 @@ module_format_fun_env (const struct module_fun_env *env)
1072void 1043void
1073syms_of_module (void) 1044syms_of_module (void)
1074{ 1045{
1046 module_nil = lisp_to_value (Qnil);
1047#ifdef WIDE_EMACS_INT
1048 ltv_mark = Fcons (Qnil, Qnil);
1049#endif
1050
1075 DEFSYM (Qmodule_refs_hash, "module-refs-hash"); 1051 DEFSYM (Qmodule_refs_hash, "module-refs-hash");
1076 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, 1052 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash,
1077 doc: /* Module global reference table. */); 1053 doc: /* Module global reference table. */);
@@ -1109,8 +1085,6 @@ syms_of_module (void)
1109 Fput (Qinvalid_arity, Qerror_message, 1085 Fput (Qinvalid_arity, Qerror_message,
1110 build_pure_c_string ("Invalid function arity")); 1086 build_pure_c_string ("Invalid function arity"));
1111 1087
1112 initialize_storage (&global_storage);
1113
1114 /* Unintern `module-refs-hash' because it is internal-only and Lisp 1088 /* Unintern `module-refs-hash' because it is internal-only and Lisp
1115 code or modules should not access it. */ 1089 code or modules should not access it. */
1116 Funintern (Qmodule_refs_hash, Qnil); 1090 Funintern (Qmodule_refs_hash, Qnil);
diff --git a/src/emacs-module.h b/src/emacs-module.h
index ea5de76e950..dce5301ab0f 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -37,7 +37,8 @@ extern "C" {
37/* Current environment. */ 37/* Current environment. */
38typedef struct emacs_env_25 emacs_env; 38typedef struct emacs_env_25 emacs_env;
39 39
40/* Opaque structure pointer representing an Emacs Lisp value. */ 40/* Opaque pointer representing an Emacs Lisp value.
41 BEWARE: Do not assume NULL is a valid value! */
41typedef struct emacs_value_tag *emacs_value; 42typedef struct emacs_value_tag *emacs_value;
42 43
43enum emacs_arity { emacs_variadic_function = -2 }; 44enum emacs_arity { emacs_variadic_function = -2 };