diff options
| author | Stefan Monnier | 2015-11-30 14:34:42 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-11-30 14:34:42 -0500 |
| commit | 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a (patch) | |
| tree | 3ac52925ea81e1f3119f0582d7aa011310140afe /src | |
| parent | 17fa6ba8245010f2e2eaa7918a1343b9b07f3c56 (diff) | |
| download | emacs-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.c | 318 | ||||
| -rw-r--r-- | src/emacs-module.h | 3 |
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. */ | ||
| 64 | struct 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 | |||
| 72 | enum { value_frame_size = 512 }; | ||
| 73 | |||
| 74 | /* A block from which `emacs_value' object can be allocated. */ | ||
| 75 | struct 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. */ | ||
| 90 | static 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 | ||
| 128 | static Lisp_Object module_format_fun_env (const struct module_fun_env *); | 89 | static Lisp_Object module_format_fun_env (const struct module_fun_env *); |
| 129 | static Lisp_Object value_to_lisp (emacs_value); | 90 | static Lisp_Object value_to_lisp (emacs_value); |
| 130 | static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); | 91 | static emacs_value lisp_to_value (Lisp_Object); |
| 131 | static emacs_value lisp_to_value (emacs_env *, Lisp_Object); | ||
| 132 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); | 92 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); |
| 133 | static void check_main_thread (void); | 93 | static void check_main_thread (void); |
| 134 | static void finalize_environment (struct emacs_env_private *); | 94 | static void finalize_environment (struct emacs_env_private *); |
| @@ -142,6 +102,9 @@ static void module_out_of_memory (emacs_env *); | |||
| 142 | static void module_reset_handlerlist (const int *); | 102 | static void module_reset_handlerlist (const int *); |
| 143 | static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object); | 103 | static 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. */ | ||
| 107 | static 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) | |||
| 277 | static emacs_value | 240 | static emacs_value |
| 278 | module_make_global_ref (emacs_env *env, emacs_value ref) | 241 | module_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 | ||
| 306 | static void | 269 | static 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 | ||
| 421 | static emacs_value | 386 | static emacs_value |
| 422 | module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, | 387 | module_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, | |||
| 440 | static emacs_value | 405 | static emacs_value |
| 441 | module_intern (emacs_env *env, const char *name) | 406 | module_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 | ||
| 447 | static emacs_value | 412 | static emacs_value |
| 448 | module_type_of (emacs_env *env, emacs_value value) | 413 | module_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 | ||
| 454 | static bool | 419 | static bool |
| @@ -485,13 +450,13 @@ module_extract_integer (emacs_env *env, emacs_value n) | |||
| 485 | static emacs_value | 450 | static emacs_value |
| 486 | module_make_integer (emacs_env *env, intmax_t n) | 451 | module_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 | ||
| 497 | static double | 462 | static double |
| @@ -510,8 +475,8 @@ module_extract_float (emacs_env *env, emacs_value f) | |||
| 510 | static emacs_value | 475 | static emacs_value |
| 511 | module_make_float (emacs_env *env, double d) | 476 | module_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 | ||
| 517 | static bool | 482 | static bool |
| @@ -561,22 +526,21 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, | |||
| 561 | static emacs_value | 526 | static emacs_value |
| 562 | module_make_string (emacs_env *env, const char *str, ptrdiff_t length) | 527 | module_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 | ||
| 575 | static emacs_value | 539 | static emacs_value |
| 576 | module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) | 540 | module_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 | ||
| 582 | static void * | 546 | static void * |
| @@ -656,12 +620,12 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) | |||
| 656 | static emacs_value | 620 | static emacs_value |
| 657 | module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) | 621 | module_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 | ||
| 677 | static ptrdiff_t | 641 | static 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 | ||
| 737 | DEFUN ("internal--module-call", Finternal_module_call, Sinternal_module_call, 2, 2, 0, | 701 | DEFUN ("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. |
| 739 | ENVOBJ is a save pointer to a module_fun_env structure. | 703 | ENVOBJ is a save pointer to a module_fun_env structure. |
| 740 | ARGLIST is a list of arguments passed to SUBRPTR, or nil. */) | 704 | ARGLIST is a list of arguments passed to SUBRPTR. |
| 741 | (Lisp_Object envobj, Lisp_Object arglist) | 705 | usage: (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. */ | ||
| 844 | static 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. */ |
| 872 | static Lisp_Object | 849 | static Lisp_Object |
| 873 | value_to_lisp (emacs_value v) | 850 | value_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. */ |
| 880 | static emacs_value | 880 | static emacs_value |
| 881 | lisp_to_value (emacs_env *env, Lisp_Object o) | 881 | lisp_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. */ | ||
| 893 | static void | ||
| 894 | initialize_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. */ | ||
| 902 | static void | ||
| 903 | initialize_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. */ |
| 911 | static void | 889 | int tag = XTYPE (o); |
| 912 | finalize_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. */ |
| 925 | static emacs_value | ||
| 926 | allocate_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. */ |
| 951 | void | 933 | void |
| 952 | mark_modules (void) | 934 | mark_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 | |||
| 970 | initialize_environment (emacs_env *env, struct emacs_env_private *priv) | 943 | initialize_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) | |||
| 1008 | static void | 980 | static void |
| 1009 | finalize_environment (struct emacs_env_private *env) | 981 | finalize_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) | |||
| 1072 | void | 1043 | void |
| 1073 | syms_of_module (void) | 1044 | syms_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. */ |
| 38 | typedef struct emacs_env_25 emacs_env; | 38 | typedef 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! */ | ||
| 41 | typedef struct emacs_value_tag *emacs_value; | 42 | typedef struct emacs_value_tag *emacs_value; |
| 42 | 43 | ||
| 43 | enum emacs_arity { emacs_variadic_function = -2 }; | 44 | enum emacs_arity { emacs_variadic_function = -2 }; |