1 /* emacs-module.c - Module loading and runtime implementation
3 Copyright (C) 2015-2017 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include "emacs-module.h"
32 #include "syssignal.h"
40 #if __has_attribute (cleanup)
41 enum { module_has_cleanup
= true };
43 enum { module_has_cleanup
= false };
51 /* True if Lisp_Object and emacs_value have the same representation.
52 This is typically true unless WIDE_EMACS_INT. In practice, having
53 the same sizes and alignments and maximums should be a good enough
54 proxy for equality of representation. */
58 = (sizeof (Lisp_Object
) == sizeof (emacs_value
)
59 && alignof (Lisp_Object
) == alignof (emacs_value
)
60 && INTPTR_MAX
== EMACS_INT_MAX
)
63 /* Function prototype for the module init function. */
64 typedef int (*emacs_init_function
) (struct emacs_runtime
*);
66 /* Function prototype for module user-pointer finalizers. These
67 should not throw C++ exceptions, so emacs-module.h declares the
68 corresponding interfaces with EMACS_NOEXCEPT. There is only C code
69 in this module, though, so this constraint is not enforced here. */
70 typedef void (*emacs_finalizer_function
) (void *);
73 /* Private runtime and environment members. */
75 /* The private part of an environment stores the current non local exit state
76 and holds the `emacs_value' objects allocated during the lifetime
77 of the environment. */
78 struct emacs_env_private
80 enum emacs_funcall_exit pending_non_local_exit
;
82 /* Dedicated storage for non-local exit symbol and data so that
83 storage is always available for them, even in an out-of-memory
85 Lisp_Object non_local_exit_symbol
, non_local_exit_data
;
88 /* The private parts of an `emacs_runtime' object contain the initial
90 struct emacs_runtime_private
96 /* Forward declarations. */
98 struct module_fun_env
;
100 static Lisp_Object
value_to_lisp (emacs_value
);
101 static emacs_value
lisp_to_value (Lisp_Object
);
102 static enum emacs_funcall_exit
module_non_local_exit_check (emacs_env
*);
103 static void check_main_thread (void);
104 static void initialize_environment (emacs_env
*, struct emacs_env_private
*);
105 static void finalize_environment (emacs_env
*, struct emacs_env_private
*);
106 static void module_handle_signal (emacs_env
*, Lisp_Object
);
107 static void module_handle_throw (emacs_env
*, Lisp_Object
);
108 static void module_non_local_exit_signal_1 (emacs_env
*, Lisp_Object
, Lisp_Object
);
109 static void module_non_local_exit_throw_1 (emacs_env
*, Lisp_Object
, Lisp_Object
);
110 static void module_out_of_memory (emacs_env
*);
111 static void module_reset_handlerlist (struct handler
*const *);
113 /* We used to return NULL when emacs_value was a different type from
114 Lisp_Object, but nowadays we just use Qnil instead. Although they
115 happen to be the same thing in the current implementation, module
116 code should not assume this. */
117 verify (NIL_IS_ZERO
);
118 static emacs_value
const module_nil
= 0;
120 /* Convenience macros for non-local exit handling. */
122 /* FIXME: The following implementation for non-local exit handling
123 does not support recovery from stack overflow, see sysdep.c. */
125 /* Emacs uses setjmp and longjmp for non-local exits, but
126 module frames cannot be skipped because they are in general
127 not prepared for long jumps (e.g., the behavior in C++ is undefined
128 if objects with nontrivial destructors would be skipped).
129 Therefore, catch all non-local exits. There are two kinds of
130 non-local exits: `signal' and `throw'. The macros in this section
131 can be used to catch both. Use macros to avoid additional variants
132 of `internal_condition_case' etc., and to avoid worrying about
133 passing information to the handler functions. */
135 /* Place this macro at the beginning of a function returning a number
136 or a pointer to handle non-local exits. The function must have an
137 ENV parameter. The function will return the specified value if a
138 signal or throw is caught. */
139 /* TODO: Have Fsignal check for CATCHER_ALL so we only have to install
141 #define MODULE_HANDLE_NONLOCAL_EXIT(retval) \
142 MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval); \
143 MODULE_SETJMP (CATCHER_ALL, module_handle_throw, retval)
145 #define MODULE_SETJMP(handlertype, handlerfunc, retval) \
146 MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \
147 internal_handler_##handlertype, \
148 internal_cleanup_##handlertype)
150 /* It is very important that pushing the handler doesn't itself raise
151 a signal. Install the cleanup only after the handler has been
152 pushed. Use __attribute__ ((cleanup)) to avoid
153 non-local-exit-prone manual cleanup.
155 The do-while forces uses of the macro to be followed by a semicolon.
156 This macro cannot enclose its entire body inside a do-while, as the
157 code after the macro may longjmp back into the macro, which means
158 its local variable C must stay live in later code. */
160 /* TODO: Make backtraces work if this macros is used. */
162 #define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c0, c) \
163 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
165 struct handler *c0 = push_handler_nosignal (Qt, handlertype); \
168 module_out_of_memory (env); \
171 verify (module_has_cleanup); \
172 struct handler *c __attribute__ ((cleanup (module_reset_handlerlist))) \
174 if (sys_setjmp (c->jmp)) \
176 (handlerfunc) (env, c->val); \
182 /* Implementation of runtime and environment functions.
184 These should abide by the following rules:
186 1. The first argument should always be a pointer to emacs_env.
188 2. Each function should first call check_main_thread. Note that
189 this function is a no-op unless Emacs was built with
192 3. The very next thing each function should do is check that the
193 emacs_env object does not have a non-local exit indication set,
194 by calling module_non_local_exit_check. If that returns
195 anything but emacs_funcall_exit_return, the function should do
196 nothing and return immediately with an error indication, without
197 clobbering the existing error indication in emacs_env. This is
198 needed for correct reporting of Lisp errors to the Emacs Lisp
201 4. Any function that needs to call Emacs facilities, such as
202 encoding or decoding functions, or 'intern', or 'make_string',
203 should protect itself from signals and 'throw' in the called
204 Emacs functions, by placing the macro
205 MODULE_HANDLE_NONLOCAL_EXIT right after the above 2 tests.
207 5. Do NOT use 'eassert' for checking validity of user code in the
208 module. Instead, make those checks part of the code, and if the
209 check fails, call 'module_non_local_exit_signal_1' or
210 'module_non_local_exit_throw_1' to report the error. This is
211 because using 'eassert' in these situations will abort Emacs
212 instead of reporting the error back to Lisp, and also because
213 'eassert' is compiled to nothing in the release version. */
215 /* Use MODULE_FUNCTION_BEGIN_NO_CATCH to implement steps 2 and 3 for
216 environment functions that are known to never exit non-locally. On
217 error it will return its argument, which can be a sentinel
220 #define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
222 eassert (env != NULL); \
223 check_main_thread (); \
224 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
225 return error_retval; \
228 /* Use MODULE_FUNCTION_BEGIN to implement steps 2 through 4 for most
229 environment functions. On error it will return its argument, which
230 can be a sentinel value. */
232 #define MODULE_FUNCTION_BEGIN(error_retval) \
233 MODULE_FUNCTION_BEGIN_NO_CATCH (error_retval); \
234 MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
237 CHECK_USER_PTR (Lisp_Object obj
)
239 CHECK_TYPE (USER_PTRP (obj
), Quser_ptrp
, obj
);
242 /* Catch signals and throws only if the code can actually signal or
243 throw. If checking is enabled, abort if the current thread is not
244 the Emacs main thread. */
247 module_get_environment (struct emacs_runtime
*ert
)
249 check_main_thread ();
250 return &ert
->private_members
->pub
;
253 /* To make global refs (GC-protected global values) keep a hash that
254 maps global Lisp objects to reference counts. */
257 module_make_global_ref (emacs_env
*env
, emacs_value ref
)
259 MODULE_FUNCTION_BEGIN (module_nil
);
260 struct Lisp_Hash_Table
*h
= XHASH_TABLE (Vmodule_refs_hash
);
261 Lisp_Object new_obj
= value_to_lisp (ref
);
263 ptrdiff_t i
= hash_lookup (h
, new_obj
, &hashcode
);
267 Lisp_Object value
= HASH_VALUE (h
, i
);
268 EMACS_INT refcount
= XFASTINT (value
) + 1;
269 if (MOST_POSITIVE_FIXNUM
< refcount
)
270 xsignal0 (Qoverflow_error
);
271 value
= make_natnum (refcount
);
272 set_hash_value_slot (h
, i
, value
);
276 hash_put (h
, new_obj
, make_natnum (1), hashcode
);
279 return lisp_to_value (new_obj
);
283 module_free_global_ref (emacs_env
*env
, emacs_value ref
)
285 /* TODO: This probably never signals. */
286 /* FIXME: Wait a minute. Shouldn't this function report an error if
287 the hash lookup fails? */
288 MODULE_FUNCTION_BEGIN ();
289 struct Lisp_Hash_Table
*h
= XHASH_TABLE (Vmodule_refs_hash
);
290 Lisp_Object obj
= value_to_lisp (ref
);
292 ptrdiff_t i
= hash_lookup (h
, obj
, &hashcode
);
296 Lisp_Object value
= HASH_VALUE (h
, i
);
297 EMACS_INT refcount
= XFASTINT (value
) - 1;
300 value
= make_natnum (refcount
);
301 set_hash_value_slot (h
, i
, value
);
304 hash_remove_from_table (h
, value
);
308 static enum emacs_funcall_exit
309 module_non_local_exit_check (emacs_env
*env
)
311 eassert (env
!= NULL
);
312 check_main_thread ();
313 return env
->private_members
->pending_non_local_exit
;
317 module_non_local_exit_clear (emacs_env
*env
)
319 eassert (env
!= NULL
);
320 check_main_thread ();
321 env
->private_members
->pending_non_local_exit
= emacs_funcall_exit_return
;
324 static enum emacs_funcall_exit
325 module_non_local_exit_get (emacs_env
*env
, emacs_value
*sym
, emacs_value
*data
)
327 eassert (env
!= NULL
);
328 eassert (sym
!= NULL
);
329 eassert (data
!= NULL
);
330 check_main_thread ();
331 struct emacs_env_private
*p
= env
->private_members
;
332 if (p
->pending_non_local_exit
!= emacs_funcall_exit_return
)
334 /* FIXME: lisp_to_value can exit non-locally. */
335 *sym
= lisp_to_value (p
->non_local_exit_symbol
);
336 *data
= lisp_to_value (p
->non_local_exit_data
);
338 return p
->pending_non_local_exit
;
341 /* Like for `signal', DATA must be a list. */
343 module_non_local_exit_signal (emacs_env
*env
, emacs_value sym
, emacs_value data
)
345 eassert (env
!= NULL
);
346 check_main_thread ();
347 if (module_non_local_exit_check (env
) == emacs_funcall_exit_return
)
348 module_non_local_exit_signal_1 (env
, value_to_lisp (sym
),
349 value_to_lisp (data
));
353 module_non_local_exit_throw (emacs_env
*env
, emacs_value tag
, emacs_value value
)
355 eassert (env
!= NULL
);
356 check_main_thread ();
357 if (module_non_local_exit_check (env
) == emacs_funcall_exit_return
)
358 module_non_local_exit_throw_1 (env
, value_to_lisp (tag
),
359 value_to_lisp (value
));
362 /* A module function is a pseudovector of subtype
363 PVEC_MODULE_FUNCTION; see lisp.h for the definition. */
366 module_make_function (emacs_env
*env
, ptrdiff_t min_arity
, ptrdiff_t max_arity
,
367 emacs_subr subr
, const char *documentation
,
370 MODULE_FUNCTION_BEGIN (module_nil
);
372 if (! (0 <= min_arity
374 ? (min_arity
<= MOST_POSITIVE_FIXNUM
375 && max_arity
== emacs_variadic_function
)
376 : min_arity
<= max_arity
&& max_arity
<= MOST_POSITIVE_FIXNUM
)))
377 xsignal2 (Qinvalid_arity
, make_number (min_arity
), make_number (max_arity
));
379 struct Lisp_Module_Function
*function
= allocate_module_function ();
380 function
->min_arity
= min_arity
;
381 function
->max_arity
= max_arity
;
382 function
->subr
= subr
;
383 function
->data
= data
;
387 AUTO_STRING (unibyte_doc
, documentation
);
388 function
->documentation
=
389 code_convert_string_norecord (unibyte_doc
, Qutf_8
, false);
393 XSET_MODULE_FUNCTION (result
, function
);
394 eassert (MODULE_FUNCTIONP (result
));
396 return lisp_to_value (result
);
400 module_funcall (emacs_env
*env
, emacs_value fun
, ptrdiff_t nargs
,
403 MODULE_FUNCTION_BEGIN (module_nil
);
405 /* Make a new Lisp_Object array starting with the function as the
406 first arg, because that's what Ffuncall takes. */
407 Lisp_Object
*newargs
;
410 if (INT_ADD_WRAPV (nargs
, 1, &nargs1
))
411 xsignal0 (Qoverflow_error
);
412 SAFE_ALLOCA_LISP (newargs
, nargs1
);
413 newargs
[0] = value_to_lisp (fun
);
414 for (ptrdiff_t i
= 0; i
< nargs
; i
++)
415 newargs
[1 + i
] = value_to_lisp (args
[i
]);
416 emacs_value result
= lisp_to_value (Ffuncall (nargs1
, newargs
));
422 module_intern (emacs_env
*env
, const char *name
)
424 MODULE_FUNCTION_BEGIN (module_nil
);
425 return lisp_to_value (intern (name
));
429 module_type_of (emacs_env
*env
, emacs_value value
)
431 MODULE_FUNCTION_BEGIN (module_nil
);
432 return lisp_to_value (Ftype_of (value_to_lisp (value
)));
436 module_is_not_nil (emacs_env
*env
, emacs_value value
)
438 MODULE_FUNCTION_BEGIN_NO_CATCH (false);
439 return ! NILP (value_to_lisp (value
));
443 module_eq (emacs_env
*env
, emacs_value a
, emacs_value b
)
445 MODULE_FUNCTION_BEGIN_NO_CATCH (false);
446 return EQ (value_to_lisp (a
), value_to_lisp (b
));
450 module_extract_integer (emacs_env
*env
, emacs_value n
)
452 verify (MOST_NEGATIVE_FIXNUM
>= INTMAX_MIN
);
453 verify (MOST_POSITIVE_FIXNUM
<= INTMAX_MAX
);
454 MODULE_FUNCTION_BEGIN (0);
455 Lisp_Object l
= value_to_lisp (n
);
461 module_make_integer (emacs_env
*env
, intmax_t n
)
463 MODULE_FUNCTION_BEGIN (module_nil
);
464 if (FIXNUM_OVERFLOW_P (n
))
465 xsignal0 (Qoverflow_error
);
466 return lisp_to_value (make_number (n
));
470 module_extract_float (emacs_env
*env
, emacs_value f
)
472 MODULE_FUNCTION_BEGIN (0);
473 Lisp_Object lisp
= value_to_lisp (f
);
474 CHECK_TYPE (FLOATP (lisp
), Qfloatp
, lisp
);
475 return XFLOAT_DATA (lisp
);
479 module_make_float (emacs_env
*env
, double d
)
481 MODULE_FUNCTION_BEGIN (module_nil
);
482 return lisp_to_value (make_float (d
));
486 module_copy_string_contents (emacs_env
*env
, emacs_value value
, char *buffer
,
489 MODULE_FUNCTION_BEGIN (false);
490 Lisp_Object lisp_str
= value_to_lisp (value
);
491 CHECK_STRING (lisp_str
);
493 Lisp_Object lisp_str_utf8
= ENCODE_UTF_8 (lisp_str
);
494 ptrdiff_t raw_size
= SBYTES (lisp_str_utf8
);
495 ptrdiff_t required_buf_size
;
496 if (INT_ADD_WRAPV (raw_size
, 1, &required_buf_size
))
497 xsignal0 (Qoverflow_error
);
498 eassert (required_buf_size
> 0);
500 eassert (length
!= NULL
);
504 *length
= required_buf_size
;
508 if (*length
< required_buf_size
)
510 *length
= required_buf_size
;
511 xsignal0 (Qargs_out_of_range
);
514 *length
= required_buf_size
;
515 eassert (SREF (lisp_str_utf8
, raw_size
) == '\0');
516 memcpy (buffer
, SDATA (lisp_str_utf8
), raw_size
+ 1);
522 module_make_string (emacs_env
*env
, const char *str
, ptrdiff_t length
)
524 MODULE_FUNCTION_BEGIN (module_nil
);
525 eassert (str
!= NULL
);
526 if (length
< 0 || length
> MOST_POSITIVE_FIXNUM
)
527 xsignal0 (Qoverflow_error
);
528 AUTO_STRING_WITH_LEN (lstr
, str
, length
);
529 return lisp_to_value (code_convert_string_norecord (lstr
, Qutf_8
, false));
533 module_make_user_ptr (emacs_env
*env
, emacs_finalizer_function fin
, void *ptr
)
535 MODULE_FUNCTION_BEGIN (module_nil
);
536 return lisp_to_value (make_user_ptr (fin
, ptr
));
540 module_get_user_ptr (emacs_env
*env
, emacs_value uptr
)
542 MODULE_FUNCTION_BEGIN (NULL
);
543 Lisp_Object lisp
= value_to_lisp (uptr
);
544 CHECK_USER_PTR (lisp
);
545 return XUSER_PTR (lisp
)->p
;
549 module_set_user_ptr (emacs_env
*env
, emacs_value uptr
, void *ptr
)
551 /* FIXME: This function should return bool because it can fail. */
552 MODULE_FUNCTION_BEGIN ();
553 Lisp_Object lisp
= value_to_lisp (uptr
);
554 CHECK_USER_PTR (lisp
);
555 XUSER_PTR (lisp
)->p
= ptr
;
558 static emacs_finalizer_function
559 module_get_user_finalizer (emacs_env
*env
, emacs_value uptr
)
561 MODULE_FUNCTION_BEGIN (NULL
);
562 Lisp_Object lisp
= value_to_lisp (uptr
);
563 CHECK_USER_PTR (lisp
);
564 return XUSER_PTR (lisp
)->finalizer
;
568 module_set_user_finalizer (emacs_env
*env
, emacs_value uptr
,
569 emacs_finalizer_function fin
)
571 /* FIXME: This function should return bool because it can fail. */
572 MODULE_FUNCTION_BEGIN ();
573 Lisp_Object lisp
= value_to_lisp (uptr
);
574 CHECK_USER_PTR (lisp
);
575 XUSER_PTR (lisp
)->finalizer
= fin
;
579 check_vec_index (Lisp_Object lvec
, ptrdiff_t i
)
582 if (! (0 <= i
&& i
< ASIZE (lvec
)))
583 args_out_of_range_3 (make_fixnum_or_float (i
),
584 make_number (0), make_number (ASIZE (lvec
) - 1));
588 module_vec_set (emacs_env
*env
, emacs_value vec
, ptrdiff_t i
, emacs_value val
)
590 /* FIXME: This function should return bool because it can fail. */
591 MODULE_FUNCTION_BEGIN ();
592 Lisp_Object lvec
= value_to_lisp (vec
);
593 check_vec_index (lvec
, i
);
594 ASET (lvec
, i
, value_to_lisp (val
));
598 module_vec_get (emacs_env
*env
, emacs_value vec
, ptrdiff_t i
)
600 MODULE_FUNCTION_BEGIN (module_nil
);
601 Lisp_Object lvec
= value_to_lisp (vec
);
602 check_vec_index (lvec
, i
);
603 return lisp_to_value (AREF (lvec
, i
));
607 module_vec_size (emacs_env
*env
, emacs_value vec
)
609 /* FIXME: Return a sentinel value (e.g., -1) on error. */
610 MODULE_FUNCTION_BEGIN (0);
611 Lisp_Object lvec
= value_to_lisp (vec
);
616 /* This function should return true if and only if maybe_quit would do
619 module_should_quit (emacs_env
*env
)
621 MODULE_FUNCTION_BEGIN_NO_CATCH (false);
622 return (! NILP (Vquit_flag
) && NILP (Vinhibit_quit
)) || pending_signals
;
628 DEFUN ("module-load", Fmodule_load
, Smodule_load
, 1, 1, 0,
629 doc
: /* Load module FILE. */)
632 dynlib_handle_ptr handle
;
633 emacs_init_function module_init
;
637 handle
= dynlib_open (SSDATA (file
));
639 xsignal2 (Qmodule_open_failed
, file
, build_string (dynlib_error ()));
641 gpl_sym
= dynlib_sym (handle
, "plugin_is_GPL_compatible");
643 xsignal1 (Qmodule_not_gpl_compatible
, file
);
645 module_init
= (emacs_init_function
) dynlib_func (handle
, "emacs_module_init");
647 xsignal1 (Qmissing_module_init_function
, file
);
649 struct emacs_runtime_private rt
; /* Includes the public emacs_env. */
650 struct emacs_env_private priv
;
651 initialize_environment (&rt
.pub
, &priv
);
652 struct emacs_runtime pub
=
655 .private_members
= &rt
,
656 .get_environment
= module_get_environment
658 int r
= module_init (&pub
);
659 finalize_environment (&rt
.pub
, &priv
);
663 if (FIXNUM_OVERFLOW_P (r
))
664 xsignal0 (Qoverflow_error
);
665 xsignal2 (Qmodule_init_failed
, file
, make_number (r
));
672 funcall_module (Lisp_Object function
, ptrdiff_t nargs
, Lisp_Object
*arglist
)
674 const struct Lisp_Module_Function
*func
= XMODULE_FUNCTION (function
);
675 eassume (0 <= func
->min_arity
);
676 if (! (func
->min_arity
<= nargs
677 && (func
->max_arity
< 0 || nargs
<= func
->max_arity
)))
678 xsignal2 (Qwrong_number_of_arguments
, function
, make_natnum (nargs
));
681 struct emacs_env_private priv
;
682 initialize_environment (&pub
, &priv
);
685 ATTRIBUTE_MAY_ALIAS emacs_value
*args
;
687 args
= (emacs_value
*) arglist
;
690 args
= SAFE_ALLOCA (nargs
* sizeof *args
);
691 for (ptrdiff_t i
= 0; i
< nargs
; i
++)
692 args
[i
] = lisp_to_value (arglist
[i
]);
695 emacs_value ret
= func
->subr (&pub
, nargs
, args
, func
->data
);
698 eassert (&priv
== pub
.private_members
);
700 /* Process the quit flag first, so that quitting doesn't get
701 overridden by other non-local exits. */
704 switch (priv
.pending_non_local_exit
)
706 case emacs_funcall_exit_return
:
707 finalize_environment (&pub
, &priv
);
708 return value_to_lisp (ret
);
709 case emacs_funcall_exit_signal
:
711 Lisp_Object symbol
= priv
.non_local_exit_symbol
;
712 Lisp_Object data
= priv
.non_local_exit_data
;
713 finalize_environment (&pub
, &priv
);
714 xsignal (symbol
, data
);
716 case emacs_funcall_exit_throw
:
718 Lisp_Object tag
= priv
.non_local_exit_symbol
;
719 Lisp_Object value
= priv
.non_local_exit_data
;
720 finalize_environment (&pub
, &priv
);
729 module_function_arity (const struct Lisp_Module_Function
*const function
)
731 ptrdiff_t minargs
= function
->min_arity
;
732 eassert (minargs
>= 0);
733 eassert (minargs
<= MOST_POSITIVE_FIXNUM
);
734 ptrdiff_t maxargs
= function
->max_arity
;
735 eassert (maxargs
>= minargs
|| maxargs
== MANY
);
736 eassert (maxargs
<= MOST_POSITIVE_FIXNUM
);
737 return Fcons (make_number (minargs
),
738 maxargs
== MANY
? Qmany
: make_number (maxargs
));
742 /* Helper functions. */
745 check_main_thread (void)
748 eassert (pthread_equal (pthread_self (), main_thread_id
));
749 #elif defined WINDOWSNT
750 eassert (GetCurrentThreadId () == dwMainThreadId
);
755 module_non_local_exit_signal_1 (emacs_env
*env
, Lisp_Object sym
,
758 struct emacs_env_private
*p
= env
->private_members
;
759 if (p
->pending_non_local_exit
== emacs_funcall_exit_return
)
761 p
->pending_non_local_exit
= emacs_funcall_exit_signal
;
762 p
->non_local_exit_symbol
= sym
;
763 p
->non_local_exit_data
= data
;
768 module_non_local_exit_throw_1 (emacs_env
*env
, Lisp_Object tag
,
771 struct emacs_env_private
*p
= env
->private_members
;
772 if (p
->pending_non_local_exit
== emacs_funcall_exit_return
)
774 p
->pending_non_local_exit
= emacs_funcall_exit_throw
;
775 p
->non_local_exit_symbol
= tag
;
776 p
->non_local_exit_data
= value
;
780 /* Signal an out-of-memory condition to the caller. */
782 module_out_of_memory (emacs_env
*env
)
784 /* TODO: Reimplement this so it works even if memory-signal-data has
786 module_non_local_exit_signal_1 (env
, XCAR (Vmemory_signal_data
),
787 XCDR (Vmemory_signal_data
));
791 /* Value conversion. */
793 /* Unique Lisp_Object used to mark those emacs_values which are really
794 just containers holding a Lisp_Object that does not fit as an emacs_value,
795 either because it is an integer out of range, or is not properly aligned.
796 Used only if !plain_values. */
797 static Lisp_Object ltv_mark
;
799 /* Convert V to the corresponding internal object O, such that
800 V == lisp_to_value_bits (O). Never fails. */
802 value_to_lisp_bits (emacs_value v
)
804 intptr_t i
= (intptr_t) v
;
805 if (plain_values
|| USE_LSB_TAG
)
808 /* With wide EMACS_INT and when tag bits are the most significant,
809 reassembling integers differs from reassembling pointers in two
810 ways. First, save and restore the least-significant bits of the
811 integer, not the most-significant bits. Second, sign-extend the
812 integer when restoring, but zero-extend pointers because that
813 makes TAG_PTR faster. */
815 EMACS_UINT tag
= i
& (GCALIGNMENT
- 1);
816 EMACS_UINT untagged
= i
- tag
;
821 bool negative
= tag
& 1;
822 EMACS_UINT sign_extension
823 = negative
? VALMASK
& ~(INTPTR_MAX
>> INTTYPEBITS
): 0;
825 intptr_t all_but_sign
= u
>> GCTYPEBITS
;
826 untagged
= sign_extension
+ all_but_sign
;
831 return XIL ((tag
<< VALBITS
) + untagged
);
834 /* If V was computed from lisp_to_value (O), then return O.
835 Exits non-locally only if the stack overflows. */
837 value_to_lisp (emacs_value v
)
839 Lisp_Object o
= value_to_lisp_bits (v
);
840 if (! plain_values
&& CONSP (o
) && EQ (XCDR (o
), ltv_mark
))
845 /* Attempt to convert O to an emacs_value. Do not do any checking or
846 or allocate any storage; the caller should prevent or detect
847 any resulting bit pattern that is not a valid emacs_value. */
849 lisp_to_value_bits (Lisp_Object o
)
851 EMACS_UINT u
= XLI (o
);
853 /* Compress U into the space of a pointer, possibly losing information. */
854 uintptr_t p
= (plain_values
|| USE_LSB_TAG
856 : (INTEGERP (o
) ? u
<< VALBITS
: u
& VALMASK
) + XTYPE (o
));
857 return (emacs_value
) p
;
860 #ifndef HAVE_STRUCT_ATTRIBUTE_ALIGNED
861 enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED
= 0 };
864 /* Convert O to an emacs_value. Allocate storage if needed; this can
865 signal if memory is exhausted. Must be an injective function. */
867 lisp_to_value (Lisp_Object o
)
869 emacs_value v
= lisp_to_value_bits (o
);
871 if (! EQ (o
, value_to_lisp_bits (v
)))
873 /* Package the incompressible object pointer inside a pair
874 that is compressible. */
875 Lisp_Object pair
= Fcons (o
, ltv_mark
);
877 if (! HAVE_STRUCT_ATTRIBUTE_ALIGNED
)
879 /* Keep calling Fcons until it returns a compressible pair.
880 This shouldn't take long. */
881 while ((intptr_t) XCONS (pair
) & (GCALIGNMENT
- 1))
882 pair
= Fcons (o
, pair
);
884 /* Plant the mark. The garbage collector will eventually
885 reclaim any just-allocated incompressible pairs. */
886 XSETCDR (pair
, ltv_mark
);
889 v
= (emacs_value
) ((intptr_t) XCONS (pair
) + Lisp_Cons
);
892 eassert (EQ (o
, value_to_lisp (v
)));
897 /* Environment lifetime management. */
899 /* Must be called before the environment can be used. */
901 initialize_environment (emacs_env
*env
, struct emacs_env_private
*priv
)
903 priv
->pending_non_local_exit
= emacs_funcall_exit_return
;
904 env
->size
= sizeof *env
;
905 env
->private_members
= priv
;
906 env
->make_global_ref
= module_make_global_ref
;
907 env
->free_global_ref
= module_free_global_ref
;
908 env
->non_local_exit_check
= module_non_local_exit_check
;
909 env
->non_local_exit_clear
= module_non_local_exit_clear
;
910 env
->non_local_exit_get
= module_non_local_exit_get
;
911 env
->non_local_exit_signal
= module_non_local_exit_signal
;
912 env
->non_local_exit_throw
= module_non_local_exit_throw
;
913 env
->make_function
= module_make_function
;
914 env
->funcall
= module_funcall
;
915 env
->intern
= module_intern
;
916 env
->type_of
= module_type_of
;
917 env
->is_not_nil
= module_is_not_nil
;
919 env
->extract_integer
= module_extract_integer
;
920 env
->make_integer
= module_make_integer
;
921 env
->extract_float
= module_extract_float
;
922 env
->make_float
= module_make_float
;
923 env
->copy_string_contents
= module_copy_string_contents
;
924 env
->make_string
= module_make_string
;
925 env
->make_user_ptr
= module_make_user_ptr
;
926 env
->get_user_ptr
= module_get_user_ptr
;
927 env
->set_user_ptr
= module_set_user_ptr
;
928 env
->get_user_finalizer
= module_get_user_finalizer
;
929 env
->set_user_finalizer
= module_set_user_finalizer
;
930 env
->vec_set
= module_vec_set
;
931 env
->vec_get
= module_vec_get
;
932 env
->vec_size
= module_vec_size
;
933 env
->should_quit
= module_should_quit
;
934 Vmodule_environments
= Fcons (make_save_ptr (env
), Vmodule_environments
);
937 /* Must be called before the lifetime of the environment object
940 finalize_environment (emacs_env
*env
, struct emacs_env_private
*priv
)
942 eassert (env
->private_members
== priv
);
943 eassert (XSAVE_POINTER (XCAR (Vmodule_environments
), 0) == env
);
944 Vmodule_environments
= XCDR (Vmodule_environments
);
948 /* Non-local exit handling. */
950 /* Must be called after setting up a handler immediately before
951 returning from the function. See the comments in lisp.h and the
952 code in eval.c for details. The macros below arrange for this
953 function to be called automatically. PHANDLERLIST points to a word
954 containing the handler list, for sanity checking. */
956 module_reset_handlerlist (struct handler
*const *phandlerlist
)
958 eassert (handlerlist
== *phandlerlist
);
959 handlerlist
= handlerlist
->next
;
962 /* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets
963 stored in the environment. Set the pending non-local exit flag. */
965 module_handle_signal (emacs_env
*env
, Lisp_Object err
)
967 module_non_local_exit_signal_1 (env
, XCAR (err
), XCDR (err
));
970 /* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets
971 stored in the environment. Set the pending non-local exit flag. */
973 module_handle_throw (emacs_env
*env
, Lisp_Object tag_val
)
975 module_non_local_exit_throw_1 (env
, XCAR (tag_val
), XCDR (tag_val
));
979 /* Segment initializer. */
982 syms_of_module (void)
985 ltv_mark
= Fcons (Qnil
, Qnil
);
986 eassert (NILP (value_to_lisp (module_nil
)));
988 DEFSYM (Qmodule_refs_hash
, "module-refs-hash");
989 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash
,
990 doc
: /* Module global reference table. */);
993 = make_hash_table (hashtest_eq
, DEFAULT_HASH_SIZE
,
994 DEFAULT_REHASH_SIZE
, DEFAULT_REHASH_THRESHOLD
,
996 Funintern (Qmodule_refs_hash
, Qnil
);
998 DEFSYM (Qmodule_environments
, "module-environments");
999 DEFVAR_LISP ("module-environments", Vmodule_environments
,
1000 doc
: /* List of active module environments. */);
1001 Vmodule_environments
= Qnil
;
1002 /* Unintern `module-environments' because it is only used
1004 Funintern (Qmodule_environments
, Qnil
);
1006 DEFSYM (Qmodule_load_failed
, "module-load-failed");
1007 Fput (Qmodule_load_failed
, Qerror_conditions
,
1008 listn (CONSTYPE_PURE
, 2, Qmodule_load_failed
, Qerror
));
1009 Fput (Qmodule_load_failed
, Qerror_message
,
1010 build_pure_c_string ("Module load failed"));
1012 DEFSYM (Qmodule_open_failed
, "module-open-failed");
1013 Fput (Qmodule_open_failed
, Qerror_conditions
,
1014 listn (CONSTYPE_PURE
, 3,
1015 Qmodule_open_failed
, Qmodule_load_failed
, Qerror
));
1016 Fput (Qmodule_open_failed
, Qerror_message
,
1017 build_pure_c_string ("Module could not be opened"));
1019 DEFSYM (Qmodule_not_gpl_compatible
, "module-not-gpl-compatible");
1020 Fput (Qmodule_not_gpl_compatible
, Qerror_conditions
,
1021 listn (CONSTYPE_PURE
, 3,
1022 Qmodule_not_gpl_compatible
, Qmodule_load_failed
, Qerror
));
1023 Fput (Qmodule_not_gpl_compatible
, Qerror_message
,
1024 build_pure_c_string ("Module is not GPL compatible"));
1026 DEFSYM (Qmissing_module_init_function
, "missing-module-init-function");
1027 Fput (Qmissing_module_init_function
, Qerror_conditions
,
1028 listn (CONSTYPE_PURE
, 3,
1029 Qmissing_module_init_function
, Qmodule_load_failed
, Qerror
));
1030 Fput (Qmissing_module_init_function
, Qerror_message
,
1031 build_pure_c_string ("Module does not export an "
1032 "initialization function"));
1034 DEFSYM (Qmodule_init_failed
, "module-init-failed");
1035 Fput (Qmodule_init_failed
, Qerror_conditions
,
1036 listn (CONSTYPE_PURE
, 3,
1037 Qmodule_init_failed
, Qmodule_load_failed
, Qerror
));
1038 Fput (Qmodule_init_failed
, Qerror_message
,
1039 build_pure_c_string ("Module initialization failed"));
1041 DEFSYM (Qinvalid_arity
, "invalid-arity");
1042 Fput (Qinvalid_arity
, Qerror_conditions
,
1043 listn (CONSTYPE_PURE
, 2, Qinvalid_arity
, Qerror
));
1044 Fput (Qinvalid_arity
, Qerror_message
,
1045 build_pure_c_string ("Invalid function arity"));
1047 /* Unintern `module-refs-hash' because it is internal-only and Lisp
1048 code or modules should not access it. */
1049 Funintern (Qmodule_refs_hash
, Qnil
);
1051 DEFSYM (Qmodule_function_p
, "module-function-p");
1053 defsubr (&Smodule_load
);