1 /* emacs-module.c - Module loading and runtime implementation
3 Copyright (C) 2015 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
10 (at 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"
37 /* True if __attribute__ ((cleanup (...))) works, false otherwise. */
38 #ifdef HAVE_VAR_ATTRIBUTE_CLEANUP
39 enum { module_has_cleanup
= true };
41 enum { module_has_cleanup
= false };
44 /* Handle to the main thread. Used to verify that modules call us in
48 static thrd_t main_thread
;
49 #elif defined HAVE_PTHREAD
51 static pthread_t main_thread
;
52 #elif defined WINDOWSNT
55 static DWORD main_thread
;
59 /* Memory management. */
61 /* An `emacs_value' is just a pointer to a structure holding an
62 internal Lisp object. */
63 struct emacs_value_tag
{ Lisp_Object v
; };
65 /* Local value objects use a simple fixed-sized block allocation
66 scheme without explicit deallocation. All local values are
67 deallocated when the lifetime of their environment ends. Keep
68 track of a current frame from which new values are allocated,
69 appending further dynamically-allocated frames if necessary. */
71 enum { value_frame_size
= 512 };
73 /* A block from which `emacs_value' object can be allocated. */
74 struct emacs_value_frame
76 /* Storage for values. */
77 struct emacs_value_tag objects
[value_frame_size
];
79 /* Index of the next free value in `objects'. */
82 /* Pointer to next frame, if any. */
83 struct emacs_value_frame
*next
;
86 /* A structure that holds an initial frame (so that the first local
87 values require no dynamic allocation) and keeps track of the
89 static struct emacs_value_storage
91 struct emacs_value_frame initial
;
92 struct emacs_value_frame
*current
;
96 /* Private runtime and environment members. */
98 /* The private part of an environment stores the current non local exit state
99 and holds the `emacs_value' objects allocated during the lifetime
100 of the environment. */
101 struct emacs_env_private
103 enum emacs_funcall_exit pending_non_local_exit
;
105 /* Dedicated storage for non-local exit symbol and data so that
106 storage is always available for them, even in an out-of-memory
108 struct emacs_value_tag non_local_exit_symbol
, non_local_exit_data
;
110 struct emacs_value_storage storage
;
113 /* Combine public and private parts in one structure. This structure
114 is used whenever an environment is created. */
118 struct emacs_env_private priv
;
121 /* The private parts of an `emacs_runtime' object contain the initial
123 struct emacs_runtime_private
125 struct env_storage environment
;
130 /* Forward declarations. */
132 struct module_fun_env
;
134 static Lisp_Object
module_format_fun_env (const struct module_fun_env
*);
135 static Lisp_Object
value_to_lisp (emacs_value
);
136 static emacs_value
allocate_emacs_value (emacs_env
*, struct emacs_value_storage
*, Lisp_Object
);
137 static emacs_value
lisp_to_value (emacs_env
*, Lisp_Object
);
138 static enum emacs_funcall_exit
module_non_local_exit_check (emacs_env
*);
139 static void check_main_thread (void);
140 static void finalize_environment (struct env_storage
*);
141 static void initialize_environment (struct env_storage
*);
142 static void module_args_out_of_range (emacs_env
*, Lisp_Object
, Lisp_Object
);
143 static void module_handle_signal (emacs_env
*, Lisp_Object
);
144 static void module_handle_throw (emacs_env
*, Lisp_Object
);
145 static void module_non_local_exit_signal_1 (emacs_env
*, Lisp_Object
, Lisp_Object
);
146 static void module_non_local_exit_throw_1 (emacs_env
*, Lisp_Object
, Lisp_Object
);
147 static void module_out_of_memory (emacs_env
*);
148 static void module_reset_handlerlist (const int *);
149 static void module_wrong_type (emacs_env
*, Lisp_Object
, Lisp_Object
);
152 /* Convenience macros for non-local exit handling. */
154 /* Emacs uses setjmp and longjmp for non-local exits, but
155 module frames cannot be skipped because they are in general
156 not prepared for long jumps (e.g., the behavior in C++ is undefined
157 if objects with nontrivial destructors would be skipped).
158 Therefore, catch all non-local exits. There are two kinds of
159 non-local exits: `signal' and `throw'. The macros in this section
160 can be used to catch both. Use macros to avoid additional variants
161 of `internal_condition_case' etc., and to avoid worrying about
162 passing information to the handler functions. */
164 /* Place this macro at the beginning of a function returning a number
165 or a pointer to handle signals. The function must have an ENV
166 parameter. The function will return 0 (or NULL) if a signal is
168 #define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN (0)
170 /* Place this macro at the beginning of a function returning void to
171 handle signals. The function must have an ENV parameter. */
172 #define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN ()
174 #define MODULE_HANDLE_SIGNALS_RETURN(retval) \
175 MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval)
177 /* Place this macro at the beginning of a function returning a pointer
178 to handle non-local exits via `throw'. The function must have an
179 ENV parameter. The function will return NULL if a `throw' is
181 #define MODULE_HANDLE_THROW \
182 MODULE_SETJMP (CATCHER_ALL, module_handle_throw, NULL)
184 #define MODULE_SETJMP(handlertype, handlerfunc, retval) \
185 MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \
186 internal_handler_##handlertype, \
187 internal_cleanup_##handlertype)
189 /* It is very important that pushing the handler doesn't itself raise
190 a signal. Install the cleanup only after the handler has been
191 pushed. Use __attribute__ ((cleanup)) to avoid
192 non-local-exit-prone manual cleanup.
194 The do-while forces uses of the macro to be followed by a semicolon.
195 This macro cannot enclose its entire body inside a do-while, as the
196 code after the macro may longjmp back into the macro, which means
197 its local variable C must stay live in later code. */
199 #define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \
200 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \
201 struct handler *c = push_handler_nosignal (Qt, handlertype); \
204 module_out_of_memory (env); \
207 verify (module_has_cleanup); \
208 int dummy __attribute__ ((cleanup (module_reset_handlerlist))); \
209 if (sys_setjmp (c->jmp)) \
211 (handlerfunc) (env, c->val); \
217 /* Function environments. */
219 /* A function environment is an auxiliary structure used by
220 `module_make_function' to store information about a module
221 function. It is stored in a save pointer and retrieved by
222 `module-call'. Its members correspond to the arguments given to
223 `module_make_function'. */
225 struct module_fun_env
227 ptrdiff_t min_arity
, max_arity
;
232 /* The function definition of `module-call'. `module-call' is
233 uninterned because user code couldn't meaningfully use it, so keep
234 its definition around somewhere else. */
235 static Lisp_Object module_call_func
;
238 /* Implementation of runtime and environment functions. */
240 /* Catch signals and throws only if the code can actually signal or
241 throw. If checking is enabled, abort if the current thread is not
242 the Emacs main thread. */
245 module_get_environment (struct emacs_runtime
*ert
)
247 check_main_thread ();
248 return &ert
->private_members
->environment
.pub
;
251 /* To make global refs (GC-protected global values) keep a hash that
252 maps global Lisp objects to reference counts. */
255 module_make_global_ref (emacs_env
*env
, emacs_value ref
)
257 check_main_thread ();
258 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
259 MODULE_HANDLE_SIGNALS
;
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 (refcount
> MOST_POSITIVE_FIXNUM
)
271 module_non_local_exit_signal_1 (env
, Qoverflow_error
, Qnil
);
274 value
= make_natnum (refcount
);
275 set_hash_value_slot (h
, i
, value
);
279 hash_put (h
, new_obj
, make_natnum (1), hashcode
);
282 return allocate_emacs_value (env
, &global_storage
, new_obj
);
286 module_free_global_ref (emacs_env
*env
, emacs_value ref
)
288 check_main_thread ();
289 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
290 /* TODO: This probably never signals. */
291 /* FIXME: Wait a minute. Shouldn't this function report an error if
292 the hash lookup fails? */
293 MODULE_HANDLE_SIGNALS_VOID
;
294 struct Lisp_Hash_Table
*h
= XHASH_TABLE (Vmodule_refs_hash
);
295 Lisp_Object obj
= value_to_lisp (ref
);
297 ptrdiff_t i
= hash_lookup (h
, obj
, &hashcode
);
301 Lisp_Object value
= HASH_VALUE (h
, i
);
302 EMACS_INT refcount
= XFASTINT (value
) - 1;
305 value
= make_natnum (refcount
);
306 set_hash_value_slot (h
, i
, value
);
309 hash_remove_from_table (h
, value
);
313 static enum emacs_funcall_exit
314 module_non_local_exit_check (emacs_env
*env
)
316 check_main_thread ();
317 return env
->private_members
->pending_non_local_exit
;
321 module_non_local_exit_clear (emacs_env
*env
)
323 check_main_thread ();
324 env
->private_members
->pending_non_local_exit
= emacs_funcall_exit_return
;
327 static enum emacs_funcall_exit
328 module_non_local_exit_get (emacs_env
*env
, emacs_value
*sym
, emacs_value
*data
)
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 *sym
= &p
->non_local_exit_symbol
;
335 *data
= &p
->non_local_exit_data
;
337 return p
->pending_non_local_exit
;
340 /* Like for `signal', DATA must be a list. */
342 module_non_local_exit_signal (emacs_env
*env
, emacs_value sym
, emacs_value data
)
344 check_main_thread ();
345 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
346 module_non_local_exit_signal_1 (env
, value_to_lisp (sym
),
347 value_to_lisp (data
));
351 module_non_local_exit_throw (emacs_env
*env
, emacs_value tag
, emacs_value value
)
353 check_main_thread ();
354 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
355 module_non_local_exit_throw_1 (env
, value_to_lisp (tag
),
356 value_to_lisp (value
));
359 /* A module function is lambda function that calls `module-call',
360 passing the function pointer of the module function along with the
361 module emacs_env pointer as arguments.
363 (function (lambda (&rest arglist)
364 (module-call envobj arglist))) */
367 module_make_function (emacs_env
*env
, ptrdiff_t min_arity
, ptrdiff_t max_arity
,
368 emacs_subr subr
, const char *documentation
,
371 check_main_thread ();
372 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
373 MODULE_HANDLE_SIGNALS
;
375 if (! (0 <= min_arity
377 ? max_arity
== emacs_variadic_function
378 : min_arity
<= max_arity
)))
379 xsignal2 (Qinvalid_arity
, make_number (min_arity
), make_number (max_arity
));
381 /* FIXME: This should be freed when envobj is GC'd. */
382 struct module_fun_env
*envptr
= xmalloc (sizeof *envptr
);
383 envptr
->min_arity
= min_arity
;
384 envptr
->max_arity
= max_arity
;
388 Lisp_Object envobj
= make_save_ptr (envptr
);
389 Lisp_Object ret
= list4 (Qlambda
,
390 list2 (Qand_rest
, Qargs
),
391 documentation
? build_string (documentation
) : Qnil
,
392 list3 (module_call_func
,
396 return lisp_to_value (env
, ret
);
400 module_funcall (emacs_env
*env
, emacs_value fun
, ptrdiff_t nargs
,
403 check_main_thread ();
404 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
405 MODULE_HANDLE_SIGNALS
;
408 /* Make a new Lisp_Object array starting with the function as the
409 first arg, because that's what Ffuncall takes. */
410 Lisp_Object
*newargs
;
412 SAFE_ALLOCA_LISP (newargs
, nargs
+ 1);
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 (env
, Ffuncall (nargs
+ 1, newargs
));
422 module_intern (emacs_env
*env
, const char *name
)
424 check_main_thread ();
425 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
426 MODULE_HANDLE_SIGNALS
;
427 return lisp_to_value (env
, intern (name
));
431 module_type_of (emacs_env
*env
, emacs_value value
)
433 check_main_thread ();
434 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
435 return lisp_to_value (env
, Ftype_of (value_to_lisp (value
)));
439 module_is_not_nil (emacs_env
*env
, emacs_value value
)
441 check_main_thread ();
442 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
443 return ! NILP (value_to_lisp (value
));
447 module_eq (emacs_env
*env
, emacs_value a
, emacs_value b
)
449 check_main_thread ();
450 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
451 return EQ (value_to_lisp (a
), value_to_lisp (b
));
455 module_extract_integer (emacs_env
*env
, emacs_value n
)
457 check_main_thread ();
458 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
459 Lisp_Object l
= value_to_lisp (n
);
462 module_wrong_type (env
, Qintegerp
, l
);
469 module_make_integer (emacs_env
*env
, intmax_t n
)
471 check_main_thread ();
472 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
473 if (! (MOST_NEGATIVE_FIXNUM
<= n
&& n
<= MOST_POSITIVE_FIXNUM
))
475 module_non_local_exit_signal_1 (env
, Qoverflow_error
, Qnil
);
478 return lisp_to_value (env
, make_number (n
));
482 module_extract_float (emacs_env
*env
, emacs_value f
)
484 check_main_thread ();
485 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
486 Lisp_Object lisp
= value_to_lisp (f
);
489 module_wrong_type (env
, Qfloatp
, lisp
);
492 return XFLOAT_DATA (lisp
);
496 module_make_float (emacs_env
*env
, double d
)
498 check_main_thread ();
499 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
500 MODULE_HANDLE_SIGNALS
;
501 return lisp_to_value (env
, make_float (d
));
505 module_copy_string_contents (emacs_env
*env
, emacs_value value
, char *buffer
,
508 check_main_thread ();
509 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
510 MODULE_HANDLE_SIGNALS
;
511 Lisp_Object lisp_str
= value_to_lisp (value
);
512 if (! STRINGP (lisp_str
))
514 module_wrong_type (env
, Qstringp
, lisp_str
);
518 ptrdiff_t raw_size
= SBYTES (lisp_str
);
520 /* Emacs internal encoding is more-or-less UTF8, let's assume utf8
521 encoded emacs string are the same byte size. */
523 if (!buffer
|| length
== 0 || *length
-1 < raw_size
)
525 *length
= raw_size
+ 1;
529 Lisp_Object lisp_str_utf8
= ENCODE_UTF_8 (lisp_str
);
530 eassert (raw_size
== SBYTES (lisp_str_utf8
));
531 *length
= raw_size
+ 1;
532 memcpy (buffer
, SDATA (lisp_str_utf8
), SBYTES (lisp_str_utf8
));
533 buffer
[raw_size
] = 0;
539 module_make_string (emacs_env
*env
, const char *str
, ptrdiff_t length
)
541 check_main_thread ();
542 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
543 MODULE_HANDLE_SIGNALS
;
544 if (length
> PTRDIFF_MAX
)
546 module_non_local_exit_signal_1 (env
, Qoverflow_error
, Qnil
);
549 /* Assume STR is utf8 encoded. */
550 return lisp_to_value (env
, make_string (str
, length
));
554 module_make_user_ptr (emacs_env
*env
, emacs_finalizer_function fin
, void *ptr
)
556 check_main_thread ();
557 return lisp_to_value (env
, make_user_ptr (fin
, ptr
));
561 module_get_user_ptr (emacs_env
*env
, emacs_value uptr
)
563 check_main_thread ();
564 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
565 Lisp_Object lisp
= value_to_lisp (uptr
);
566 if (! USER_PTRP (lisp
))
568 module_wrong_type (env
, Quser_ptr
, lisp
);
571 return XUSER_PTR (lisp
)->p
;
575 module_set_user_ptr (emacs_env
*env
, emacs_value uptr
, void *ptr
)
577 check_main_thread ();
578 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
579 Lisp_Object lisp
= value_to_lisp (uptr
);
580 if (! USER_PTRP (lisp
))
581 module_wrong_type (env
, Quser_ptr
, lisp
);
582 XUSER_PTR (lisp
)->p
= ptr
;
585 static emacs_finalizer_function
586 module_get_user_finalizer (emacs_env
*env
, emacs_value uptr
)
588 check_main_thread ();
589 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
590 Lisp_Object lisp
= value_to_lisp (uptr
);
591 if (! USER_PTRP (lisp
))
593 module_wrong_type (env
, Quser_ptr
, lisp
);
596 return XUSER_PTR (lisp
)->finalizer
;
600 module_set_user_finalizer (emacs_env
*env
, emacs_value uptr
,
601 emacs_finalizer_function fin
)
603 check_main_thread ();
604 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
605 Lisp_Object lisp
= value_to_lisp (uptr
);
606 if (! USER_PTRP (lisp
))
607 module_wrong_type (env
, Quser_ptr
, lisp
);
608 XUSER_PTR (lisp
)->finalizer
= fin
;
612 module_vec_set (emacs_env
*env
, emacs_value vec
, ptrdiff_t i
, emacs_value val
)
614 check_main_thread ();
615 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
616 Lisp_Object lvec
= value_to_lisp (vec
);
617 if (! VECTORP (lvec
))
619 module_wrong_type (env
, Qvectorp
, lvec
);
622 if (! (0 <= i
&& i
< ASIZE (lvec
)))
624 if (MOST_NEGATIVE_FIXNUM
<= i
&& i
<= MOST_POSITIVE_FIXNUM
)
625 module_args_out_of_range (env
, lvec
, make_number (i
));
627 module_non_local_exit_signal_1 (env
, Qoverflow_error
, Qnil
);
630 ASET (lvec
, i
, value_to_lisp (val
));
634 module_vec_get (emacs_env
*env
, emacs_value vec
, ptrdiff_t i
)
636 check_main_thread ();
637 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
638 Lisp_Object lvec
= value_to_lisp (vec
);
639 if (! VECTORP (lvec
))
641 module_wrong_type (env
, Qvectorp
, lvec
);
644 if (! (0 <= i
&& i
< ASIZE (lvec
)))
646 if (MOST_NEGATIVE_FIXNUM
<= i
&& i
<= MOST_POSITIVE_FIXNUM
)
647 module_args_out_of_range (env
, lvec
, make_number (i
));
649 module_non_local_exit_signal_1 (env
, Qoverflow_error
, Qnil
);
652 return lisp_to_value (env
, AREF (lvec
, i
));
656 module_vec_size (emacs_env
*env
, emacs_value vec
)
658 check_main_thread ();
659 eassert (module_non_local_exit_check (env
) == emacs_funcall_exit_return
);
660 Lisp_Object lvec
= value_to_lisp (vec
);
661 if (! VECTORP (lvec
))
663 module_wrong_type (env
, Qvectorp
, lvec
);
672 DEFUN ("module-load", Fmodule_load
, Smodule_load
, 1, 1, 0,
673 doc
: /* Load module FILE. */)
676 dynlib_handle_ptr handle
;
677 emacs_init_function module_init
;
681 handle
= dynlib_open (SSDATA (file
));
683 error ("Cannot load file %s: %s", SDATA (file
), dynlib_error ());
685 gpl_sym
= dynlib_sym (handle
, "plugin_is_GPL_compatible");
687 error ("Module %s is not GPL compatible", SDATA (file
));
689 module_init
= (emacs_init_function
) dynlib_sym (handle
, "emacs_module_init");
691 error ("Module %s does not have an init function.", SDATA (file
));
693 struct emacs_runtime_private priv
;
694 struct emacs_runtime pub
=
697 .private_members
= &priv
,
698 .get_environment
= module_get_environment
700 initialize_environment (&priv
.environment
);
701 int r
= module_init (&pub
);
702 finalize_environment (&priv
.environment
);
706 if (! (MOST_NEGATIVE_FIXNUM
<= r
&& r
<= MOST_POSITIVE_FIXNUM
))
707 xsignal0 (Qoverflow_error
);
708 xsignal2 (Qmodule_load_failed
, file
, make_number (r
));
714 DEFUN ("module-call", Fmodule_call
, Smodule_call
, 2, 2, 0,
715 doc
: /* Internal function to call a module function.
716 ENVOBJ is a save pointer to a module_fun_env structure.
717 ARGLIST is a list of arguments passed to SUBRPTR. */)
718 (Lisp_Object envobj
, Lisp_Object arglist
)
720 struct module_fun_env
*envptr
= XSAVE_POINTER (envobj
, 0);
721 EMACS_INT len
= XFASTINT (Flength (arglist
));
722 eassume (0 <= envptr
->min_arity
);
723 if (! (envptr
->min_arity
<= len
724 && len
<= (envptr
->max_arity
< 0 ? PTRDIFF_MAX
: envptr
->max_arity
)))
725 xsignal2 (Qwrong_number_of_arguments
, module_format_fun_env (envptr
),
728 struct env_storage env
;
729 initialize_environment (&env
);
731 emacs_value
*args
= xnmalloc (len
, sizeof *args
);
733 for (ptrdiff_t i
= 0; i
< len
; i
++)
735 args
[i
] = lisp_to_value (&env
.pub
, XCAR (arglist
));
737 memory_full (sizeof *args
[i
]);
738 arglist
= XCDR (arglist
);
741 emacs_value ret
= envptr
->subr (&env
.pub
, len
, args
, envptr
->data
);
744 switch (env
.priv
.pending_non_local_exit
)
746 case emacs_funcall_exit_return
:
747 finalize_environment (&env
);
749 xsignal1 (Qinvalid_module_call
, module_format_fun_env (envptr
));
750 return value_to_lisp (ret
);
751 case emacs_funcall_exit_signal
:
753 Lisp_Object symbol
= value_to_lisp (&env
.priv
.non_local_exit_symbol
);
754 Lisp_Object data
= value_to_lisp (&env
.priv
.non_local_exit_data
);
755 finalize_environment (&env
);
756 xsignal (symbol
, data
);
758 case emacs_funcall_exit_throw
:
760 Lisp_Object tag
= value_to_lisp (&env
.priv
.non_local_exit_symbol
);
761 Lisp_Object value
= value_to_lisp (&env
.priv
.non_local_exit_data
);
762 finalize_environment (&env
);
771 /* Helper functions. */
774 check_main_thread (void)
776 #ifdef HAVE_THREADS_H
777 eassert (thrd_equal (thdr_current (), main_thread
));
778 #elif defined HAVE_PTHREAD
779 eassert (pthread_equal (pthread_self (), main_thread
));
780 #elif defined WINDOWSNT
781 eassert (GetCurrentThreadId () == main_thread
);
786 module_non_local_exit_signal_1 (emacs_env
*env
, Lisp_Object sym
,
789 struct emacs_env_private
*p
= env
->private_members
;
790 eassert (p
->pending_non_local_exit
== emacs_funcall_exit_return
);
791 p
->pending_non_local_exit
= emacs_funcall_exit_signal
;
792 p
->non_local_exit_symbol
.v
= sym
;
793 p
->non_local_exit_data
.v
= data
;
797 module_non_local_exit_throw_1 (emacs_env
*env
, Lisp_Object tag
,
800 struct emacs_env_private
*p
= env
->private_members
;
801 eassert (p
->pending_non_local_exit
== emacs_funcall_exit_return
);
802 p
->pending_non_local_exit
= emacs_funcall_exit_throw
;
803 p
->non_local_exit_symbol
.v
= tag
;
804 p
->non_local_exit_data
.v
= value
;
807 /* Module version of `wrong_type_argument'. */
809 module_wrong_type (emacs_env
*env
, Lisp_Object predicate
, Lisp_Object value
)
811 module_non_local_exit_signal_1 (env
, Qwrong_type_argument
,
812 list2 (predicate
, value
));
815 /* Signal an out-of-memory condition to the caller. */
817 module_out_of_memory (emacs_env
*env
)
819 /* TODO: Reimplement this so it works even if memory-signal-data has
821 module_non_local_exit_signal_1 (env
, XCAR (Vmemory_signal_data
),
822 XCDR (Vmemory_signal_data
));
825 /* Signal arguments are out of range. */
827 module_args_out_of_range (emacs_env
*env
, Lisp_Object a1
, Lisp_Object a2
)
829 module_non_local_exit_signal_1 (env
, Qargs_out_of_range
, list2 (a1
, a2
));
833 /* Value conversion. */
835 /* Convert an `emacs_value' to the corresponding internal object.
838 value_to_lisp (emacs_value v
)
843 /* Convert an internal object to an `emacs_value'. Allocate storage
844 from the environment; return NULL if allocation fails. */
846 lisp_to_value (emacs_env
*env
, Lisp_Object o
)
848 struct emacs_env_private
*p
= env
->private_members
;
849 if (p
->pending_non_local_exit
!= emacs_funcall_exit_return
)
851 return allocate_emacs_value (env
, &p
->storage
, o
);
855 /* Memory management. */
857 /* Must be called for each frame before it can be used for allocation. */
859 initialize_frame (struct emacs_value_frame
*frame
)
865 /* Must be called for any storage object before it can be used for
868 initialize_storage (struct emacs_value_storage
*storage
)
870 initialize_frame (&storage
->initial
);
871 storage
->current
= &storage
->initial
;
874 /* Must be called for any initialized storage object before its
875 lifetime ends. Free all dynamically-allocated frames. */
877 finalize_storage (struct emacs_value_storage
*storage
)
879 struct emacs_value_frame
*next
= storage
->initial
.next
;
882 struct emacs_value_frame
*current
= next
;
883 next
= current
->next
;
888 /* Allocate a new value from STORAGE and stores OBJ in it. Return
889 NULL if allocation fails and use ENV for non local exit reporting. */
891 allocate_emacs_value (emacs_env
*env
, struct emacs_value_storage
*storage
,
894 eassert (storage
->current
);
895 eassert (storage
->current
->offset
< value_frame_size
);
896 eassert (! storage
->current
->next
);
897 if (storage
->current
->offset
== value_frame_size
- 1)
899 storage
->current
->next
= malloc (sizeof *storage
->current
->next
);
900 if (! storage
->current
->next
)
902 module_out_of_memory (env
);
905 initialize_frame (storage
->current
->next
);
906 storage
->current
= storage
->current
->next
;
908 emacs_value value
= storage
->current
->objects
+ storage
->current
->offset
;
910 ++storage
->current
->offset
;
914 /* Mark all objects allocated from local environments so that they
915 don't get garbage-collected. */
916 void mark_modules (void)
918 for (Lisp_Object tem
= Vmodule_environments
; CONSP (tem
); tem
= XCDR (tem
))
920 struct env_storage
*env
= XSAVE_POINTER (tem
, 0);
921 for (struct emacs_value_frame
*frame
= &env
->priv
.storage
.initial
;
924 for (int i
= 0; i
< frame
->offset
; ++i
)
925 mark_object (frame
->objects
[i
].v
);
930 /* Environment lifetime management. */
932 /* Must be called before the environment can be used. */
934 initialize_environment (struct env_storage
*env
)
936 env
->priv
.pending_non_local_exit
= emacs_funcall_exit_return
;
937 initialize_storage (&env
->priv
.storage
);
938 env
->pub
.size
= sizeof env
->pub
;
939 env
->pub
.private_members
= &env
->priv
;
940 env
->pub
.make_global_ref
= module_make_global_ref
;
941 env
->pub
.free_global_ref
= module_free_global_ref
;
942 env
->pub
.non_local_exit_check
= module_non_local_exit_check
;
943 env
->pub
.non_local_exit_clear
= module_non_local_exit_clear
;
944 env
->pub
.non_local_exit_get
= module_non_local_exit_get
;
945 env
->pub
.non_local_exit_signal
= module_non_local_exit_signal
;
946 env
->pub
.non_local_exit_throw
= module_non_local_exit_throw
;
947 env
->pub
.make_function
= module_make_function
;
948 env
->pub
.funcall
= module_funcall
;
949 env
->pub
.intern
= module_intern
;
950 env
->pub
.type_of
= module_type_of
;
951 env
->pub
.is_not_nil
= module_is_not_nil
;
952 env
->pub
.eq
= module_eq
;
953 env
->pub
.extract_integer
= module_extract_integer
;
954 env
->pub
.make_integer
= module_make_integer
;
955 env
->pub
.extract_float
= module_extract_float
;
956 env
->pub
.make_float
= module_make_float
;
957 env
->pub
.copy_string_contents
= module_copy_string_contents
;
958 env
->pub
.make_string
= module_make_string
;
959 env
->pub
.make_user_ptr
= module_make_user_ptr
;
960 env
->pub
.get_user_ptr
= module_get_user_ptr
;
961 env
->pub
.set_user_ptr
= module_set_user_ptr
;
962 env
->pub
.get_user_finalizer
= module_get_user_finalizer
;
963 env
->pub
.set_user_finalizer
= module_set_user_finalizer
;
964 env
->pub
.vec_set
= module_vec_set
;
965 env
->pub
.vec_get
= module_vec_get
;
966 env
->pub
.vec_size
= module_vec_size
;
967 Vmodule_environments
= Fcons (make_save_ptr (env
), Vmodule_environments
);
970 /* Must be called before the lifetime of the environment object
973 finalize_environment (struct env_storage
*env
)
975 finalize_storage (&env
->priv
.storage
);
976 Vmodule_environments
= XCDR (Vmodule_environments
);
980 /* Non-local exit handling. */
982 /* Must be called after setting up a handler immediately before
983 returning from the function. See the comments in lisp.h and the
984 code in eval.c for details. The macros below arrange for this
985 function to be called automatically. DUMMY is ignored. */
987 module_reset_handlerlist (const int *dummy
)
989 handlerlist
= handlerlist
->next
;
992 /* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets
993 stored in the environment. Set the pending non-local exit flag. */
995 module_handle_signal (emacs_env
*env
, Lisp_Object err
)
997 module_non_local_exit_signal_1 (env
, XCAR (err
), XCDR (err
));
1000 /* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets
1001 stored in the environment. Set the pending non-local exit flag. */
1003 module_handle_throw (emacs_env
*env
, Lisp_Object tag_val
)
1005 module_non_local_exit_throw_1 (env
, XCAR (tag_val
), XCDR (tag_val
));
1009 /* Function environments. */
1011 /* Return a string object that contains a user-friendly
1012 representation of the function environment. */
1014 module_format_fun_env (const struct module_fun_env
*env
)
1016 /* Try to print a function name if possible. */
1017 const char *path
, *sym
;
1018 if (dynlib_addr (env
->subr
, &path
, &sym
))
1020 static char const format
[] = "#<module function %s from %s>";
1021 int size
= snprintf (NULL
, 0, format
, sym
, path
);
1023 char buffer
[size
+ 1];
1024 snprintf (buffer
, sizeof buffer
, format
, sym
, path
);
1025 return make_unibyte_string (buffer
, size
);
1029 static char const format
[] = "#<module function at %p>";
1030 void *subr
= env
->subr
;
1031 int size
= snprintf (NULL
, 0, format
, subr
);
1033 char buffer
[size
+ 1];
1034 snprintf (buffer
, sizeof buffer
, format
, subr
);
1035 return make_unibyte_string (buffer
, size
);
1040 /* Segment initializer. */
1043 syms_of_module (void)
1045 DEFSYM (Qmodule_refs_hash
, "module-refs-hash");
1046 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash
,
1047 doc
: /* Module global referrence table. */);
1050 = make_hash_table (hashtest_eq
, make_number (DEFAULT_HASH_SIZE
),
1051 make_float (DEFAULT_REHASH_SIZE
),
1052 make_float (DEFAULT_REHASH_THRESHOLD
),
1054 Funintern (Qmodule_refs_hash
, Qnil
);
1056 DEFSYM (Qmodule_environments
, "module-environments");
1057 DEFVAR_LISP ("module-environments", Vmodule_environments
,
1058 doc
: /* List of active module environments. */);
1059 Vmodule_environments
= Qnil
;
1060 /* Unintern `module-environments' because it is only used
1062 Funintern (Qmodule_environments
, Qnil
);
1064 DEFSYM (Qmodule_load_failed
, "module-load-failed");
1065 Fput (Qmodule_load_failed
, Qerror_conditions
,
1066 listn (CONSTYPE_PURE
, 2, Qmodule_load_failed
, Qerror
));
1067 Fput (Qmodule_load_failed
, Qerror_message
,
1068 build_pure_c_string ("Module load failed"));
1070 DEFSYM (Qinvalid_module_call
, "invalid-module-call");
1071 Fput (Qinvalid_module_call
, Qerror_conditions
,
1072 listn (CONSTYPE_PURE
, 2, Qinvalid_module_call
, Qerror
));
1073 Fput (Qinvalid_module_call
, Qerror_message
,
1074 build_pure_c_string ("Invalid module call"));
1076 DEFSYM (Qinvalid_arity
, "invalid-arity");
1077 Fput (Qinvalid_arity
, Qerror_conditions
,
1078 listn (CONSTYPE_PURE
, 2, Qinvalid_arity
, Qerror
));
1079 Fput (Qinvalid_arity
, Qerror_message
,
1080 build_pure_c_string ("Invalid function arity"));
1082 initialize_storage (&global_storage
);
1084 /* Unintern `module-refs-hash' because it is internal-only and Lisp
1085 code or modules should not access it. */
1086 Funintern (Qmodule_refs_hash
, Qnil
);
1088 defsubr (&Smodule_load
);
1090 /* Don't call defsubr on `module-call' because that would intern it,
1091 but `module-call' is an internal function that users cannot
1092 meaningfully use. Instead, assign its definition to a private
1094 XSETPVECTYPE (&Smodule_call
, PVEC_SUBR
);
1095 XSETSUBR (module_call_func
, &Smodule_call
);
1098 /* Unlike syms_of_module, this initializer is called even from an
1099 initialized (dumped) Emacs. */
1104 /* It is not guaranteed that dynamic initializers run in the main thread,
1105 therefore detect the main thread here. */
1106 #ifdef HAVE_THREADS_H
1107 main_thread
= thrd_current ();
1108 #elif defined HAVE_PTHREAD
1109 main_thread
= pthread_self ();
1110 #elif defined WINDOWSNT
1111 /* The 'main' function already recorded the main thread's thread ID,
1112 so we need just to use it . */
1113 main_thread
= dwMainThreadId
;