From: Paul Eggert Date: Thu, 19 Nov 2015 21:50:23 +0000 (-0800) Subject: Rename module.c to emacs-module.c, etc. X-Git-Tag: emacs-25.0.90~731 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f2c002592196297a3517b3ed1f05c8ac7b096044;p=emacs.git Rename module.c to emacs-module.c, etc. * src/emacs-module.c: Rename from src/module.c. * src/emacs-module.h: Rename from src/module.h. All uses changed. --- diff --git a/configure.ac b/configure.ac index 4d34c1ad25e..d5638bf2002 100644 --- a/configure.ac +++ b/configure.ac @@ -3320,7 +3320,7 @@ if test "${with_modules}" != "no"; then fi if test "${HAVE_MODULES}" = yes; then - MODULES_OBJ="dynlib.o module.o" + MODULES_OBJ="dynlib.o emacs-module.o" AC_DEFINE(HAVE_MODULES, 1, [Define to 1 if dynamic modules are enabled]) AC_DEFINE_UNQUOTED(MODULES_SUFFIX, "$MODULES_SUFFIX", [System extension for dynamic libraries]) diff --git a/modules/mod-test/mod-test.c b/modules/mod-test/mod-test.c index b58b86c9047..e27fb582355 100644 --- a/modules/mod-test/mod-test.c +++ b/modules/mod-test/mod-test.c @@ -19,7 +19,7 @@ along with GNU Emacs. If not, see . */ #include #include -#include +#include int plugin_is_GPL_compatible; diff --git a/modules/modhelp.py b/modules/modhelp.py index 45b849ee747..2210030ecd6 100755 --- a/modules/modhelp.py +++ b/modules/modhelp.py @@ -149,7 +149,7 @@ all: ${module}.so ${module}.doc '''), string.Template('${c_file}'): string.Template(''' -#include +#include int plugin_is_GPL_compatible; diff --git a/src/Makefile.in b/src/Makefile.in index 15171d43668..4fee1bea883 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -232,7 +232,7 @@ LIBZ = @LIBZ@ ## system-specific libs for dynamic modules, else empty LIBMODULES = @LIBMODULES@ -## dynlib.o module.o if modules enabled, else empty +## dynlib.o emacs-module.o if modules enabled, else empty MODULES_OBJ = @MODULES_OBJ@ XRANDR_LIBS = @XRANDR_LIBS@ diff --git a/src/emacs-module.c b/src/emacs-module.c new file mode 100644 index 00000000000..4fa01bf5bed --- /dev/null +++ b/src/emacs-module.c @@ -0,0 +1,1160 @@ +/* emacs-module.c - Module loading and runtime implementation + +Copyright (C) 2015 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include +#include +#include +#include + +#include +#include "lisp.h" +#include "emacs-module.h" +#include "dynlib.h" +#include "coding.h" +#include "verify.h" + + +/* Feature tests. */ + +/* True if __attribute__ ((cleanup (...))) works, false otherwise. */ +#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP +enum { module_has_cleanup = true }; +#else +enum { module_has_cleanup = false }; +#endif + +/* Handle to the main thread. Used to verify that modules call us in + the right thread. */ +#ifdef HAVE_THREADS_H +# include +static thrd_t main_thread; +#elif defined HAVE_PTHREAD +# include +static pthread_t main_thread; +#elif defined WINDOWSNT +# include +/* On Windows, store both a handle to the main thread and the + thread ID because the latter can be reused when a thread + terminates. */ +static HANDLE main_thread; +static DWORD main_thread_id; +#endif + + +/* Memory management. */ + +/* An `emacs_value' is just a pointer to a structure holding an + internal Lisp object. */ +struct emacs_value_tag { Lisp_Object v; }; + +/* Local value objects use a simple fixed-sized block allocation + scheme without explicit deallocation. All local values are + deallocated when the lifetime of their environment ends. Keep + track of a current frame from which new values are allocated, + appending further dynamically-allocated frames if necessary. */ + +enum { value_frame_size = 512 }; + +/* A block from which `emacs_value' object can be allocated. */ +struct emacs_value_frame +{ + /* Storage for values. */ + struct emacs_value_tag objects[value_frame_size]; + + /* Index of the next free value in `objects'. */ + size_t offset; + + /* Pointer to next frame, if any. */ + struct emacs_value_frame *next; +}; + +/* A structure that holds an initial frame (so that the first local + values require no dynamic allocation) and keeps track of the + current frame. */ +static struct emacs_value_storage +{ + struct emacs_value_frame initial; + struct emacs_value_frame *current; +} global_storage; + + +/* Private runtime and environment members. */ + +/* The private part of an environment stores the current non local exit state + and holds the `emacs_value' objects allocated during the lifetime + of the environment. */ +struct emacs_env_private +{ + enum emacs_funcall_exit pending_non_local_exit; + + /* Dedicated storage for non-local exit symbol and data so that + storage is always available for them, even in an out-of-memory + situation. */ + struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; + + struct emacs_value_storage storage; +}; + +/* Combine public and private parts in one structure. This structure + is used whenever an environment is created. */ +struct env_storage +{ + emacs_env pub; + struct emacs_env_private priv; +}; + +/* The private parts of an `emacs_runtime' object contain the initial + environment. */ +struct emacs_runtime_private +{ + struct env_storage environment; +}; + + + +/* Forward declarations. */ + +struct module_fun_env; + +static Lisp_Object module_format_fun_env (const struct module_fun_env *); +static Lisp_Object value_to_lisp (emacs_value); +static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); +static emacs_value lisp_to_value (emacs_env *, Lisp_Object); +static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); +static void check_main_thread (void); +static void finalize_environment (struct env_storage *); +static void initialize_environment (struct env_storage *); +static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object); +static void module_handle_signal (emacs_env *, const Lisp_Object); +static void module_handle_throw (emacs_env *, Lisp_Object); +static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object); +static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object); +static void module_out_of_memory (emacs_env *); +static void module_reset_handlerlist (const int *); +static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object); + + +/* Convenience macros for non-local exit handling. */ + +/* Emacs uses setjmp and longjmp for non-local exits, but + module frames cannot be skipped because they are in general + not prepared for long jumps (e.g., the behavior in C++ is undefined + if objects with nontrivial destructors would be skipped). + Therefore, catch all non-local exits. There are two kinds of + non-local exits: `signal' and `throw'. The macros in this section + can be used to catch both. Use macros to avoid additional variants + of `internal_condition_case' etc., and to avoid worrying about + passing information to the handler functions. */ + +/* Place this macro at the beginning of a function returning a number + or a pointer to handle signals. The function must have an ENV + parameter. The function will return 0 (or NULL) if a signal is + caught. */ +#define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN (0) + +/* Place this macro at the beginning of a function returning void to + handle signals. The function must have an ENV parameter. */ +#define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN () + +#define MODULE_HANDLE_SIGNALS_RETURN(retval) \ + MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval) + +/* Place this macro at the beginning of a function returning a pointer + to handle non-local exits via `throw'. The function must have an + ENV parameter. The function will return NULL if a `throw' is + caught. */ +#define MODULE_HANDLE_THROW \ + MODULE_SETJMP (CATCHER_ALL, module_handle_throw, NULL) + +#define MODULE_SETJMP(handlertype, handlerfunc, retval) \ + MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \ + internal_handler_##handlertype, \ + internal_cleanup_##handlertype) + +/* It is very important that pushing the handler doesn't itself raise + a signal. Install the cleanup only after the handler has been + pushed. Use __attribute__ ((cleanup)) to avoid + non-local-exit-prone manual cleanup. */ +#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \ + do { \ + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \ + struct handler *c; \ + if (!push_handler_nosignal (&c, Qt, handlertype)) \ + { \ + module_out_of_memory (env); \ + return retval; \ + } \ + verify (module_has_cleanup); \ + const int dummy __attribute__ ((cleanup (module_reset_handlerlist))); \ + if (sys_setjmp (c->jmp)) \ + { \ + (handlerfunc) (env, c->val); \ + return retval; \ + } \ + } while (false) + + +/* Function environments. */ + +/* A function environment is an auxiliary structure used by + `module_make_function' to store information about a module + function. It is stored in a save pointer and retrieved by + `module-call'. Its members correspond to the arguments given to + `module_make_function'. */ + +struct module_fun_env +{ + int min_arity, max_arity; + emacs_subr subr; + void *data; +}; + +/* The function definition of `module-call'. `module-call' is + uninterned because user code couldn't meaningfully use it, so keep + its definition around somewhere else. */ +static Lisp_Object module_call_func; + + +/* Implementation of runtime and environment functions. */ + +/* Catch signals and throws only if the code can actually signal or + throw. If checking is enabled, abort if the current thread is not + the Emacs main thread. */ + +static emacs_env * +module_get_environment (struct emacs_runtime *ert) +{ + check_main_thread (); + return &ert->private_members->environment.pub; +} + +/* To make global refs (GC-protected global values) keep a hash that + maps global Lisp objects to reference counts. */ + +static emacs_value +module_make_global_ref (emacs_env *env, emacs_value ref) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + eassert (HASH_TABLE_P (Vmodule_refs_hash)); + struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); + Lisp_Object new_obj = value_to_lisp (ref); + EMACS_UINT hashcode; + ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); + + if (i >= 0) + { + Lisp_Object value = HASH_VALUE (h, i); + eassert (NATNUMP (value)); + const EMACS_UINT refcount = XFASTINT (value); + if (refcount >= MOST_POSITIVE_FIXNUM) + { + module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); + return NULL; + } + XSETFASTINT (value, refcount + 1); + set_hash_value_slot (h, i, value); + } + else + { + hash_put (h, new_obj, make_natnum (1), hashcode); + } + + return allocate_emacs_value (env, &global_storage, new_obj); +} + +static void +module_free_global_ref (emacs_env *env, emacs_value ref) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + /* TODO: This probably never signals. */ + MODULE_HANDLE_SIGNALS_VOID; + eassert (HASH_TABLE_P (Vmodule_refs_hash)); + struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); + Lisp_Object obj = value_to_lisp (ref); + EMACS_UINT hashcode; + ptrdiff_t i = hash_lookup (h, obj, &hashcode); + + if (i >= 0) + { + Lisp_Object value = HASH_VALUE (h, i); + eassert (NATNUMP (value)); + const EMACS_UINT refcount = XFASTINT (value); + eassert (refcount > 0); + if (refcount > 1) + { + XSETFASTINT (value, refcount - 1); + set_hash_value_slot (h, i, value); + } + else + { + hash_remove_from_table (h, value); + } + } +} + +static enum emacs_funcall_exit +module_non_local_exit_check (emacs_env *env) +{ + check_main_thread (); + return env->private_members->pending_non_local_exit; +} + +static void +module_non_local_exit_clear (emacs_env *env) +{ + check_main_thread (); + env->private_members->pending_non_local_exit = emacs_funcall_exit_return; +} + +static enum emacs_funcall_exit +module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) +{ + check_main_thread (); + struct emacs_env_private *const p = env->private_members; + if (p->pending_non_local_exit != emacs_funcall_exit_return) + { + *sym = &p->non_local_exit_symbol; + *data = &p->non_local_exit_data; + } + return p->pending_non_local_exit; +} + +/* Like for `signal', DATA must be a list. */ +static void +module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + module_non_local_exit_signal_1 (env, value_to_lisp (sym), + value_to_lisp (data)); +} + +static void +module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + module_non_local_exit_throw_1 (env, value_to_lisp (tag), + value_to_lisp (value)); +} + +/* A module function is lambda function that calls `module-call', + passing the function pointer of the module function along with the + module emacs_env pointer as arguments. + + (function (lambda (&rest arglist) + (module-call envobj arglist))) */ + +static emacs_value +module_make_function (emacs_env *env, int min_arity, int max_arity, + emacs_subr subr, const char *const documentation, + void *data) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + + if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM) + xsignal0 (Qoverflow_error); + + if (min_arity < 0 + || (max_arity >= 0 && max_arity < min_arity) + || (max_arity < 0 && max_arity != emacs_variadic_function)) + xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); + + Lisp_Object envobj; + + /* XXX: This should need to be freed when envobj is GC'd. */ + struct module_fun_env *envptr = xzalloc (sizeof *envptr); + envptr->min_arity = min_arity; + envptr->max_arity = max_arity; + envptr->subr = subr; + envptr->data = data; + envobj = make_save_ptr (envptr); + + Lisp_Object ret = list4 (Qlambda, + list2 (Qand_rest, Qargs), + documentation ? build_string (documentation) : Qnil, + list3 (module_call_func, + envobj, + Qargs)); + + return lisp_to_value (env, ret); +} + +static emacs_value +module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[]) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + MODULE_HANDLE_THROW; + + /* Make a new Lisp_Object array starting with the function as the + first arg, because that's what Ffuncall takes. */ + Lisp_Object newargs[nargs + 1]; + newargs[0] = value_to_lisp (fun); + for (int i = 0; i < nargs; i++) + newargs[1 + i] = value_to_lisp (args[i]); + return lisp_to_value (env, Ffuncall (nargs + 1, newargs)); +} + +static emacs_value +module_intern (emacs_env *env, const char *name) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + return lisp_to_value (env, intern (name)); +} + +static emacs_value +module_type_of (emacs_env *env, emacs_value value) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + return lisp_to_value (env, Ftype_of (value_to_lisp (value))); +} + +static bool +module_is_not_nil (emacs_env *env, emacs_value value) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + return ! NILP (value_to_lisp (value)); +} + +static bool +module_eq (emacs_env *env, emacs_value a, emacs_value b) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + return EQ (value_to_lisp (a), value_to_lisp (b)); +} + +static int64_t +module_extract_integer (emacs_env *env, emacs_value n) +{ + verify (INT64_MIN <= MOST_NEGATIVE_FIXNUM); + verify (INT64_MAX >= MOST_POSITIVE_FIXNUM); + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object l = value_to_lisp (n); + if (! INTEGERP (l)) + { + module_wrong_type (env, Qintegerp, l); + return 0; + } + return XINT (l); +} + +static emacs_value +module_make_integer (emacs_env *env, int64_t n) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + if (n < MOST_NEGATIVE_FIXNUM) + { + module_non_local_exit_signal_1 (env, Qunderflow_error, Qnil); + return NULL; + } + if (n > MOST_POSITIVE_FIXNUM) + { + module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); + return NULL; + } + return lisp_to_value (env, make_number (n)); +} + +static double +module_extract_float (emacs_env *env, emacs_value f) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object lisp = value_to_lisp (f); + if (! FLOATP (lisp)) + { + module_wrong_type (env, Qfloatp, lisp); + return 0; + } + return XFLOAT_DATA (lisp); +} + +static emacs_value +module_make_float (emacs_env *env, double d) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + return lisp_to_value (env, make_float (d)); +} + +static bool +module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, + size_t *length) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + Lisp_Object lisp_str = value_to_lisp (value); + if (! STRINGP (lisp_str)) + { + module_wrong_type (env, Qstringp, lisp_str); + return false; + } + + size_t raw_size = SBYTES (lisp_str); + + /* Emacs internal encoding is more-or-less UTF8, let's assume utf8 + encoded emacs string are the same byte size. */ + + if (!buffer || length == 0 || *length-1 < raw_size) + { + *length = raw_size + 1; + return false; + } + + Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str); + eassert (raw_size == SBYTES (lisp_str_utf8)); + *length = raw_size + 1; + memcpy (buffer, SDATA (lisp_str_utf8), SBYTES (lisp_str_utf8)); + buffer[raw_size] = 0; + + return true; +} + +static emacs_value +module_make_string (emacs_env *env, const char *str, size_t length) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + MODULE_HANDLE_SIGNALS; + if (length > PTRDIFF_MAX) + { + module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); + return NULL; + } + /* Assume STR is utf8 encoded. */ + return lisp_to_value (env, make_string (str, length)); +} + +static emacs_value +module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) +{ + check_main_thread (); + return lisp_to_value (env, make_user_ptr (fin, ptr)); +} + +static void * +module_get_user_ptr (emacs_env *env, emacs_value uptr) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object lisp = value_to_lisp (uptr); + if (! USER_PTRP (lisp)) + { + module_wrong_type (env, Quser_ptr, lisp); + return NULL; + } + return XUSER_PTR (lisp)->p; +} + +static void +module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object lisp = value_to_lisp (uptr); + if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp); + XUSER_PTR (lisp)->p = ptr; +} + +static emacs_finalizer_function +module_get_user_finalizer (emacs_env *env, emacs_value uptr) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object lisp = value_to_lisp (uptr); + if (! USER_PTRP (lisp)) + { + module_wrong_type (env, Quser_ptr, lisp); + return NULL; + } + return XUSER_PTR (lisp)->finalizer; +} + +static void +module_set_user_finalizer (emacs_env *env, emacs_value uptr, + emacs_finalizer_function fin) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + const Lisp_Object lisp = value_to_lisp (uptr); + if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp); + XUSER_PTR (lisp)->finalizer = fin; +} + +static void +module_vec_set (emacs_env *env, emacs_value vec, size_t i, emacs_value val) +{ + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + if (i > MOST_POSITIVE_FIXNUM) + { + module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); + return; + } + Lisp_Object lvec = value_to_lisp (vec); + if (! VECTORP (lvec)) + { + module_wrong_type (env, Qvectorp, lvec); + return; + } + if (i >= ASIZE (lvec)) + { + module_args_out_of_range (env, lvec, make_number (i)); + return; + } + ASET (lvec, i, value_to_lisp (val)); +} + +static emacs_value +module_vec_get (emacs_env *env, emacs_value vec, size_t i) +{ + /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */ + verify (PTRDIFF_MAX <= SIZE_MAX); + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + if (i > MOST_POSITIVE_FIXNUM) + { + module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); + return NULL; + } + Lisp_Object lvec = value_to_lisp (vec); + if (! VECTORP (lvec)) + { + module_wrong_type (env, Qvectorp, lvec); + return NULL; + } + /* Prevent error-prone comparison between types of different signedness. */ + const size_t size = ASIZE (lvec); + eassert (size >= 0); + if (i >= size) + { + if (i > MOST_POSITIVE_FIXNUM) + i = (size_t) MOST_POSITIVE_FIXNUM; + module_args_out_of_range (env, lvec, make_number (i)); + return NULL; + } + return lisp_to_value (env, AREF (lvec, i)); +} + +static size_t +module_vec_size (emacs_env *env, emacs_value vec) +{ + /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */ + verify (PTRDIFF_MAX <= SIZE_MAX); + check_main_thread (); + eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); + Lisp_Object lvec = value_to_lisp (vec); + if (! VECTORP (lvec)) + { + module_wrong_type (env, Qvectorp, lvec); + return 0; + } + eassert (ASIZE (lvec) >= 0); + return ASIZE (lvec); +} + + +/* Subroutines. */ + +DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, + doc: /* Load module FILE. */) + (Lisp_Object file) +{ + dynlib_handle_ptr handle; + emacs_init_function module_init; + void *gpl_sym; + + CHECK_STRING (file); + handle = dynlib_open (SSDATA (file)); + if (!handle) + error ("Cannot load file %s: %s", SDATA (file), dynlib_error ()); + + gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible"); + if (!gpl_sym) + error ("Module %s is not GPL compatible", SDATA (file)); + + module_init = (emacs_init_function) dynlib_sym (handle, "emacs_module_init"); + if (!module_init) + error ("Module %s does not have an init function.", SDATA (file)); + + struct { + struct emacs_runtime pub; + struct emacs_runtime_private priv; + } runtime = { + .pub = { + .size = sizeof runtime.pub, + .get_environment = module_get_environment, + .private_members = &runtime.priv + } + }; + initialize_environment (&runtime.priv.environment); + int r = module_init (&runtime.pub); + finalize_environment (&runtime.priv.environment); + + if (r != 0) + { + if (r < MOST_NEGATIVE_FIXNUM) + xsignal0 (Qunderflow_error); + if (r > MOST_POSITIVE_FIXNUM) + xsignal0 (Qoverflow_error); + xsignal2 (Qmodule_load_failed, file, make_number (r)); + } + + return Qt; +} + +DEFUN ("module-call", Fmodule_call, Smodule_call, 2, 2, 0, + doc: /* Internal function to call a module function. +ENVOBJ is a save pointer to a module_fun_env structure. +ARGLIST is a list of arguments passed to SUBRPTR. */) + (Lisp_Object envobj, Lisp_Object arglist) +{ + const struct module_fun_env *const envptr = XSAVE_POINTER (envobj, 0); + const EMACS_INT len = XINT (Flength (arglist)); + eassert (len >= 0); + if (len > MOST_POSITIVE_FIXNUM) + xsignal0 (Qoverflow_error); + if (len > INT_MAX || len < envptr->min_arity + || (envptr->max_arity >= 0 && len > envptr->max_arity)) + xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr), + make_number (len)); + + struct env_storage env; + initialize_environment (&env); + + emacs_value *args = xzalloc (len * sizeof *args); + int i; + + for (i = 0; i < len; i++) + { + args[i] = lisp_to_value (&env.pub, XCAR (arglist)); + if (! args[i]) + memory_full (sizeof *args[i]); + arglist = XCDR (arglist); + } + + emacs_value ret = envptr->subr (&env.pub, len, args, envptr->data); + xfree (args); + + switch (env.priv.pending_non_local_exit) + { + case emacs_funcall_exit_return: + finalize_environment (&env); + if (ret == NULL) + xsignal1 (Qinvalid_module_call, module_format_fun_env (envptr)); + return value_to_lisp (ret); + case emacs_funcall_exit_signal: + { + Lisp_Object symbol = value_to_lisp (&env.priv.non_local_exit_symbol); + const Lisp_Object data = value_to_lisp (&env.priv.non_local_exit_data); + finalize_environment (&env); + xsignal (symbol, data); + } + case emacs_funcall_exit_throw: + { + const Lisp_Object tag = value_to_lisp (&env.priv.non_local_exit_symbol); + const Lisp_Object value = value_to_lisp (&env.priv.non_local_exit_data); + finalize_environment (&env); + Fthrow (tag, value); + } + default: + eassume (false); + } +} + + +/* Helper functions. */ + +static void +check_main_thread (void) +{ +#ifdef HAVE_THREADS_H + eassert (thrd_equal (thdr_current (), main_thread)); +#elif defined HAVE_PTHREAD + eassert (pthread_equal (pthread_self (), main_thread)); +#elif defined WINDOWSNT + /* CompareObjectHandles would be perfect, but is only available in + Windows 10. Also check whether the thread is still running to + protect against thread identifier reuse. */ + eassert (GetCurrentThreadId () == main_thread_id + && WaitForSingleObject (main_thread, 0) == WAIT_TIMEOUT); +#endif +} + +static void +module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, + Lisp_Object data) +{ + struct emacs_env_private *const p = env->private_members; + eassert (p->pending_non_local_exit == emacs_funcall_exit_return); + p->pending_non_local_exit = emacs_funcall_exit_signal; + p->non_local_exit_symbol.v = sym; + p->non_local_exit_data.v = data; +} + +static void +module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, + Lisp_Object value) +{ + struct emacs_env_private *const p = env->private_members; + eassert (p->pending_non_local_exit == emacs_funcall_exit_return); + p->pending_non_local_exit = emacs_funcall_exit_throw; + p->non_local_exit_symbol.v = tag; + p->non_local_exit_data.v = value; +} + +/* Module version of `wrong_type_argument'. */ +static void +module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value) +{ + module_non_local_exit_signal_1 (env, Qwrong_type_argument, + list2 (predicate, value)); +} + +/* Signal an out-of-memory condition to the caller. */ +static void +module_out_of_memory (emacs_env *env) +{ + /* TODO: Reimplement this so it works even if memory-signal-data has + been modified. */ + module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data), + XCDR (Vmemory_signal_data)); +} + +/* Signal arguments are out of range. */ +static void +module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2) +{ + module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2)); +} + + +/* Value conversion. */ + +/* Convert an `emacs_value' to the corresponding internal object. + Never fails. */ +static Lisp_Object +value_to_lisp (emacs_value v) +{ + return v->v; +} + +/* Convert an internal object to an `emacs_value'. Allocate storage + from the environment; return NULL if allocation fails. */ +static emacs_value +lisp_to_value (emacs_env *env, Lisp_Object o) +{ + struct emacs_env_private *const p = env->private_members; + if (p->pending_non_local_exit != emacs_funcall_exit_return) + return NULL; + return allocate_emacs_value (env, &p->storage, o); +} + + +/* Memory management. */ + +/* Must be called for each frame before it can be used for allocation. */ +static void +initialize_frame (struct emacs_value_frame *frame) +{ + frame->offset = 0; + frame->next = NULL; +} + +/* Must be called for any storage object before it can be used for + allocation. */ +static void +initialize_storage (struct emacs_value_storage *storage) +{ + initialize_frame (&storage->initial); + storage->current = &storage->initial; +} + +/* Must be called for any initialized storage object before its + lifetime ends. Free all dynamically-allocated frames. */ +static void +finalize_storage (struct emacs_value_storage *storage) +{ + struct emacs_value_frame *next = storage->initial.next; + while (next != NULL) + { + struct emacs_value_frame *const current = next; + next = current->next; + free (current); + } +} + +/* Allocate a new value from STORAGE and stores OBJ in it. Return + NULL if allocations fails and use ENV for non local exit reporting. */ +static emacs_value +allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, + Lisp_Object obj) +{ + eassert (storage->current); + eassert (storage->current->offset < value_frame_size); + eassert (! storage->current->next); + if (storage->current->offset == value_frame_size - 1) + { + storage->current->next = malloc (sizeof *storage->current->next); + if (! storage->current->next) + { + module_out_of_memory (env); + return NULL; + } + initialize_frame (storage->current->next); + storage->current = storage->current->next; + } + const emacs_value value = storage->current->objects + storage->current->offset; + value->v = obj; + ++storage->current->offset; + return value; +} + +/* Mark all objects allocated from local environments so that they + don't get garbage-collected. */ +void mark_modules (void) +{ + for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) + { + const struct env_storage *const env = XSAVE_POINTER (tem, 0); + for (const struct emacs_value_frame *frame = &env->priv.storage.initial; + frame != NULL; + frame = frame->next) + for (size_t i = 0; i < frame->offset; ++i) + mark_object (frame->objects[i].v); + } +} + + +/* Environment lifetime management. */ + +/* Must be called before the environment can be used. */ +static void +initialize_environment (struct env_storage *env) +{ + env->priv.pending_non_local_exit = emacs_funcall_exit_return; + initialize_storage (&env->priv.storage); + env->pub.size = sizeof env->pub; + env->pub.private_members = &env->priv; + env->pub.make_global_ref = module_make_global_ref; + env->pub.free_global_ref = module_free_global_ref; + env->pub.non_local_exit_check = module_non_local_exit_check; + env->pub.non_local_exit_clear = module_non_local_exit_clear; + env->pub.non_local_exit_get = module_non_local_exit_get; + env->pub.non_local_exit_signal = module_non_local_exit_signal; + env->pub.non_local_exit_throw = module_non_local_exit_throw; + env->pub.make_function = module_make_function; + env->pub.funcall = module_funcall; + env->pub.intern = module_intern; + env->pub.type_of = module_type_of; + env->pub.is_not_nil = module_is_not_nil; + env->pub.eq = module_eq; + env->pub.extract_integer = module_extract_integer; + env->pub.make_integer = module_make_integer; + env->pub.extract_float = module_extract_float; + env->pub.make_float = module_make_float; + env->pub.copy_string_contents = module_copy_string_contents; + env->pub.make_string = module_make_string; + env->pub.make_user_ptr = module_make_user_ptr; + env->pub.get_user_ptr = module_get_user_ptr; + env->pub.set_user_ptr = module_set_user_ptr; + env->pub.get_user_finalizer = module_get_user_finalizer; + env->pub.set_user_finalizer = module_set_user_finalizer; + env->pub.vec_set = module_vec_set; + env->pub.vec_get = module_vec_get; + env->pub.vec_size = module_vec_size; + Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments); +} + +/* Must be called before the lifetime of the environment object + ends. */ +static void +finalize_environment (struct env_storage *env) +{ + finalize_storage (&env->priv.storage); + Vmodule_environments = XCDR (Vmodule_environments); +} + + +/* Non-local exit handling. */ + +/* Must be called after setting up a handler immediately before + returning from the function. See the comments in lisp.h and the + code in eval.c for details. The macros below arrange for this + function to be called automatically. DUMMY is ignored. */ +static void +module_reset_handlerlist (const int *dummy) +{ + handlerlist = handlerlist->next; +} + +/* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets + stored in the environment. Set the pending non-local exit flag. */ +static void +module_handle_signal (emacs_env *const env, const Lisp_Object err) +{ + module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err)); +} + +/* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets + stored in the environment. Set the pending non-local exit flag. */ +static void +module_handle_throw (emacs_env *const env, const Lisp_Object tag_val) +{ + module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val)); +} + + +/* Function environments. */ + +/* Return a string object that contains a user-friendly + representation of the function environment. */ +static Lisp_Object +module_format_fun_env (const struct module_fun_env *const env) +{ + /* Try to print a function name if possible. */ + const char *path, *sym; + if (dynlib_addr (env->subr, &path, &sym)) + { + const char *const format = "#"; + const int size = snprintf (NULL, 0, format, sym, path); + eassert (size > 0); + char buffer[size + 1]; + snprintf (buffer, sizeof buffer, format, sym, path); + return make_unibyte_string (buffer, size); + } + else + { + const char *const format = "#"; + const void *const subr = env->subr; + const int size = snprintf (NULL, 0, format, subr); + eassert (size > 0); + char buffer[size + 1]; + snprintf (buffer, sizeof buffer, format, subr); + return make_unibyte_string (buffer, size); + } +} + + +/* Segment initializer. */ + +void +syms_of_module (void) +{ + DEFSYM (Qmodule_refs_hash, "module-refs-hash"); + DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, + doc: /* Module global referrence table. */); + + Vmodule_refs_hash + = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), + make_float (DEFAULT_REHASH_SIZE), + make_float (DEFAULT_REHASH_THRESHOLD), + Qnil); + Funintern (Qmodule_refs_hash, Qnil); + + DEFSYM (Qmodule_environments, "module-environments"); + DEFVAR_LISP ("module-environments", Vmodule_environments, + doc: /* List of active module environments. */); + Vmodule_environments = Qnil; + /* Unintern `module-environments' because it is only used + internally. */ + Funintern (Qmodule_environments, Qnil); + + DEFSYM (Qmodule_load_failed, "module-load-failed"); + Fput (Qmodule_load_failed, Qerror_conditions, + listn (CONSTYPE_PURE, 2, Qmodule_load_failed, Qerror)); + Fput (Qmodule_load_failed, Qerror_message, + build_pure_c_string ("Module load failed")); + + DEFSYM (Qinvalid_module_call, "invalid-module-call"); + Fput (Qinvalid_module_call, Qerror_conditions, + listn (CONSTYPE_PURE, 2, Qinvalid_module_call, Qerror)); + Fput (Qinvalid_module_call, Qerror_message, + build_pure_c_string ("Invalid module call")); + + DEFSYM (Qinvalid_arity, "invalid-arity"); + Fput (Qinvalid_arity, Qerror_conditions, + listn (CONSTYPE_PURE, 2, Qinvalid_arity, Qerror)); + Fput (Qinvalid_arity, Qerror_message, + build_pure_c_string ("Invalid function arity")); + + initialize_storage (&global_storage); + + /* Unintern `module-refs-hash' because it is internal-only and Lisp + code or modules should not access it. */ + Funintern (Qmodule_refs_hash, Qnil); + + defsubr (&Smodule_load); + + /* Don't call defsubr on `module-call' because that would intern it, + but `module-call' is an internal function that users cannot + meaningfully use. Instead, assign its definition to a private + variable. */ + XSETPVECTYPE (&Smodule_call, PVEC_SUBR); + XSETSUBR (module_call_func, &Smodule_call); +} + +/* Unlike syms_of_module, this initializer is called even from an + initialized (dumped) Emacs. */ + +void +module_init (void) +{ + /* It is not guaranteed that dynamic initializers run in the main thread, + therefore detect the main thread here. */ +#ifdef HAVE_THREADS_H + main_thread = thrd_current (); +#elif defined HAVE_PTHREAD + main_thread = pthread_self (); +#elif defined WINDOWSNT + /* This calls APIs that are only available on Vista and later. */ +# if false + /* GetCurrentProcess returns a pseudohandle, which must be duplicated. */ + if (! DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), + GetCurrentProcess (), &main_thread, + SYNCHRONIZE | THREAD_QUERY_INFORMATION, + FALSE, 0)) + emacs_abort (); +# else + /* GetCurrentThread returns a pseudohandle, which must be duplicated. */ + HANDLE th = GetCurrentThread (); + if (!DuplicateHandle (GetCurrentProcess (), th, + GetCurrentProcess (), &main_thread, 0, FALSE, + DUPLICATE_SAME_ACCESS)) + emacs_abort (); + main_thread_id = GetCurrentThreadId (); +# endif +#endif +} diff --git a/src/emacs-module.h b/src/emacs-module.h new file mode 100644 index 00000000000..046959775ac --- /dev/null +++ b/src/emacs-module.h @@ -0,0 +1,202 @@ +/* emacs-module.h - GNU Emacs module API. + +Copyright (C) 2015 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef EMACS_MODULE_H +#define EMACS_MODULE_H + +#include +#include +#include + +#if defined __cplusplus && __cplusplus >= 201103L +# define EMACS_NOEXCEPT noexcept +#else +# define EMACS_NOEXCEPT +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* Current environment. */ +typedef struct emacs_env_25 emacs_env; + +/* Opaque structure pointer representing an Emacs Lisp value. */ +typedef struct emacs_value_tag *emacs_value; + +enum emacs_arity { emacs_variadic_function = -2 }; + +/* Struct passed to a module init function (emacs_module_init). */ +struct emacs_runtime +{ + /* Structure size (for version checking). */ + size_t size; + + /* Private data; users should not touch this. */ + struct emacs_runtime_private *private_members; + + /* Return an environment pointer. */ + emacs_env *(*get_environment) (struct emacs_runtime *ert); +}; + + +/* Function prototype for the module init function. */ +typedef int (*emacs_init_function) (struct emacs_runtime *ert); + +/* Function prototype for the module Lisp functions. */ +typedef emacs_value (*emacs_subr) (emacs_env *env, int nargs, emacs_value args[], + void *data); + +/* Function prototype for module user-pointer finalizers. */ +typedef void (*emacs_finalizer_function) (void *); + +/* Possible Emacs function call outcomes. */ +enum emacs_funcall_exit +{ + /* Function has returned normally. */ + emacs_funcall_exit_return = 0, + + /* Function has signaled an error using `signal'. */ + emacs_funcall_exit_signal = 1, + + /* Function has exit using `throw'. */ + emacs_funcall_exit_throw = 2, +}; + +struct emacs_env_25 +{ + /* Structure size (for version checking). */ + size_t size; + + /* Private data; users should not touch this. */ + struct emacs_env_private *private_members; + + /* Memory management. */ + + emacs_value (*make_global_ref) (emacs_env *env, + emacs_value any_reference); + + void (*free_global_ref) (emacs_env *env, + emacs_value global_reference); + + /* Non-local exit handling. */ + + enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env); + + void (*non_local_exit_clear) (emacs_env *env); + + enum emacs_funcall_exit (*non_local_exit_get) + (emacs_env *env, + emacs_value *non_local_exit_symbol_out, + emacs_value *non_local_exit_data_out); + + void (*non_local_exit_signal) (emacs_env *env, + emacs_value non_local_exit_symbol, + emacs_value non_local_exit_data); + + void (*non_local_exit_throw) (emacs_env *env, + emacs_value tag, + emacs_value value); + + /* Function registration. */ + + emacs_value (*make_function) (emacs_env *env, + int min_arity, + int max_arity, + emacs_value (*function) (emacs_env *, int, + emacs_value *, void *) + EMACS_NOEXCEPT, + const char *documentation, + void *data); + + emacs_value (*funcall) (emacs_env *env, + emacs_value function, + int nargs, + emacs_value args[]); + + emacs_value (*intern) (emacs_env *env, + const char *symbol_name); + + /* Type conversion. */ + + emacs_value (*type_of) (emacs_env *env, + emacs_value value); + + bool (*is_not_nil) (emacs_env *env, emacs_value value); + + bool (*eq) (emacs_env *env, emacs_value a, emacs_value b); + + int_fast64_t (*extract_integer) (emacs_env *env, + emacs_value value); + + emacs_value (*make_integer) (emacs_env *env, int_fast64_t value); + + double (*extract_float) (emacs_env *env, emacs_value value); + + emacs_value (*make_float) (emacs_env *env, double value); + + /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 + null-terminated string. + + SIZE must point to the total size of the buffer. If BUFFER is + NULL or if SIZE is not big enough, write the required buffer size + to SIZE and return false. + + Note that SIZE must include the last null byte (e.g. "abc" needs + a buffer of size 4). + + Return true if the string was successfully copied. */ + + bool (*copy_string_contents) (emacs_env *env, + emacs_value value, + char *buffer, + size_t *size_inout); + + /* Create a Lisp string from a utf8 encoded string. */ + emacs_value (*make_string) (emacs_env *env, + const char *contents, size_t length); + + /* Embedded pointer type. */ + emacs_value (*make_user_ptr) (emacs_env *env, + void (*fin) (void *) EMACS_NOEXCEPT, + void *ptr); + + void *(*get_user_ptr) (emacs_env *env, emacs_value uptr); + void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr); + + void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) + (void *) EMACS_NOEXCEPT; + void (*set_user_finalizer) (emacs_env *env, + emacs_value uptr, + void (*fin) (void *) EMACS_NOEXCEPT); + + /* Vector functions. */ + emacs_value (*vec_get) (emacs_env *env, emacs_value vec, size_t i); + + void (*vec_set) (emacs_env *env, emacs_value vec, size_t i, + emacs_value val); + + size_t (*vec_size) (emacs_env *env, emacs_value vec); +}; + +#ifdef __cplusplus +} +#endif + +#endif /* EMACS_MODULE_H */ diff --git a/src/lisp.h b/src/lisp.h index f953ceb582f..3b7bb40caa2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3914,7 +3914,7 @@ extern bool let_shadows_global_binding_p (Lisp_Object symbol); /* Defined in alloc.c. */ extern Lisp_Object make_user_ptr (void (*finalizer) (void*), void *p); -/* Defined in module.c. */ +/* Defined in emacs-module.c. */ extern void module_init (void); extern void mark_modules (void); extern void syms_of_module (void); diff --git a/src/module.c b/src/module.c deleted file mode 100644 index 98264df35a9..00000000000 --- a/src/module.c +++ /dev/null @@ -1,1160 +0,0 @@ -/* module.c - Module loading and runtime implementation - -Copyright (C) 2015 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include -#include -#include -#include - -#include -#include "lisp.h" -#include "module.h" -#include "dynlib.h" -#include "coding.h" -#include "verify.h" - - -/* Feature tests. */ - -/* True if __attribute__ ((cleanup (...))) works, false otherwise. */ -#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP -enum { module_has_cleanup = true }; -#else -enum { module_has_cleanup = false }; -#endif - -/* Handle to the main thread. Used to verify that modules call us in - the right thread. */ -#ifdef HAVE_THREADS_H -# include -static thrd_t main_thread; -#elif defined HAVE_PTHREAD -# include -static pthread_t main_thread; -#elif defined WINDOWSNT -# include -/* On Windows, store both a handle to the main thread and the - thread ID because the latter can be reused when a thread - terminates. */ -static HANDLE main_thread; -static DWORD main_thread_id; -#endif - - -/* Memory management. */ - -/* An `emacs_value' is just a pointer to a structure holding an - internal Lisp object. */ -struct emacs_value_tag { Lisp_Object v; }; - -/* Local value objects use a simple fixed-sized block allocation - scheme without explicit deallocation. All local values are - deallocated when the lifetime of their environment ends. Keep - track of a current frame from which new values are allocated, - appending further dynamically-allocated frames if necessary. */ - -enum { value_frame_size = 512 }; - -/* A block from which `emacs_value' object can be allocated. */ -struct emacs_value_frame -{ - /* Storage for values. */ - struct emacs_value_tag objects[value_frame_size]; - - /* Index of the next free value in `objects'. */ - size_t offset; - - /* Pointer to next frame, if any. */ - struct emacs_value_frame *next; -}; - -/* A structure that holds an initial frame (so that the first local - values require no dynamic allocation) and keeps track of the - current frame. */ -static struct emacs_value_storage -{ - struct emacs_value_frame initial; - struct emacs_value_frame *current; -} global_storage; - - -/* Private runtime and environment members. */ - -/* The private part of an environment stores the current non local exit state - and holds the `emacs_value' objects allocated during the lifetime - of the environment. */ -struct emacs_env_private -{ - enum emacs_funcall_exit pending_non_local_exit; - - /* Dedicated storage for non-local exit symbol and data so that - storage is always available for them, even in an out-of-memory - situation. */ - struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; - - struct emacs_value_storage storage; -}; - -/* Combine public and private parts in one structure. This structure - is used whenever an environment is created. */ -struct env_storage -{ - emacs_env pub; - struct emacs_env_private priv; -}; - -/* The private parts of an `emacs_runtime' object contain the initial - environment. */ -struct emacs_runtime_private -{ - struct env_storage environment; -}; - - - -/* Forward declarations. */ - -struct module_fun_env; - -static Lisp_Object module_format_fun_env (const struct module_fun_env *); -static Lisp_Object value_to_lisp (emacs_value); -static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); -static emacs_value lisp_to_value (emacs_env *, Lisp_Object); -static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); -static void check_main_thread (void); -static void finalize_environment (struct env_storage *); -static void initialize_environment (struct env_storage *); -static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object); -static void module_handle_signal (emacs_env *, const Lisp_Object); -static void module_handle_throw (emacs_env *, Lisp_Object); -static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object); -static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object); -static void module_out_of_memory (emacs_env *); -static void module_reset_handlerlist (const int *); -static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object); - - -/* Convenience macros for non-local exit handling. */ - -/* Emacs uses setjmp and longjmp for non-local exits, but - module frames cannot be skipped because they are in general - not prepared for long jumps (e.g., the behavior in C++ is undefined - if objects with nontrivial destructors would be skipped). - Therefore, catch all non-local exits. There are two kinds of - non-local exits: `signal' and `throw'. The macros in this section - can be used to catch both. Use macros to avoid additional variants - of `internal_condition_case' etc., and to avoid worrying about - passing information to the handler functions. */ - -/* Place this macro at the beginning of a function returning a number - or a pointer to handle signals. The function must have an ENV - parameter. The function will return 0 (or NULL) if a signal is - caught. */ -#define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN (0) - -/* Place this macro at the beginning of a function returning void to - handle signals. The function must have an ENV parameter. */ -#define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN () - -#define MODULE_HANDLE_SIGNALS_RETURN(retval) \ - MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval) - -/* Place this macro at the beginning of a function returning a pointer - to handle non-local exits via `throw'. The function must have an - ENV parameter. The function will return NULL if a `throw' is - caught. */ -#define MODULE_HANDLE_THROW \ - MODULE_SETJMP (CATCHER_ALL, module_handle_throw, NULL) - -#define MODULE_SETJMP(handlertype, handlerfunc, retval) \ - MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \ - internal_handler_##handlertype, \ - internal_cleanup_##handlertype) - -/* It is very important that pushing the handler doesn't itself raise - a signal. Install the cleanup only after the handler has been - pushed. Use __attribute__ ((cleanup)) to avoid - non-local-exit-prone manual cleanup. */ -#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \ - do { \ - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \ - struct handler *c; \ - if (!push_handler_nosignal (&c, Qt, handlertype)) \ - { \ - module_out_of_memory (env); \ - return retval; \ - } \ - verify (module_has_cleanup); \ - const int dummy __attribute__ ((cleanup (module_reset_handlerlist))); \ - if (sys_setjmp (c->jmp)) \ - { \ - (handlerfunc) (env, c->val); \ - return retval; \ - } \ - } while (false) - - -/* Function environments. */ - -/* A function environment is an auxiliary structure used by - `module_make_function' to store information about a module - function. It is stored in a save pointer and retrieved by - `module-call'. Its members correspond to the arguments given to - `module_make_function'. */ - -struct module_fun_env -{ - int min_arity, max_arity; - emacs_subr subr; - void *data; -}; - -/* The function definition of `module-call'. `module-call' is - uninterned because user code couldn't meaningfully use it, so keep - its definition around somewhere else. */ -static Lisp_Object module_call_func; - - -/* Implementation of runtime and environment functions. */ - -/* Catch signals and throws only if the code can actually signal or - throw. If checking is enabled, abort if the current thread is not - the Emacs main thread. */ - -static emacs_env * -module_get_environment (struct emacs_runtime *ert) -{ - check_main_thread (); - return &ert->private_members->environment.pub; -} - -/* To make global refs (GC-protected global values) keep a hash that - maps global Lisp objects to reference counts. */ - -static emacs_value -module_make_global_ref (emacs_env *env, emacs_value ref) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - eassert (HASH_TABLE_P (Vmodule_refs_hash)); - struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object new_obj = value_to_lisp (ref); - EMACS_UINT hashcode; - ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); - - if (i >= 0) - { - Lisp_Object value = HASH_VALUE (h, i); - eassert (NATNUMP (value)); - const EMACS_UINT refcount = XFASTINT (value); - if (refcount >= MOST_POSITIVE_FIXNUM) - { - module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); - return NULL; - } - XSETFASTINT (value, refcount + 1); - set_hash_value_slot (h, i, value); - } - else - { - hash_put (h, new_obj, make_natnum (1), hashcode); - } - - return allocate_emacs_value (env, &global_storage, new_obj); -} - -static void -module_free_global_ref (emacs_env *env, emacs_value ref) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - /* TODO: This probably never signals. */ - MODULE_HANDLE_SIGNALS_VOID; - eassert (HASH_TABLE_P (Vmodule_refs_hash)); - struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object obj = value_to_lisp (ref); - EMACS_UINT hashcode; - ptrdiff_t i = hash_lookup (h, obj, &hashcode); - - if (i >= 0) - { - Lisp_Object value = HASH_VALUE (h, i); - eassert (NATNUMP (value)); - const EMACS_UINT refcount = XFASTINT (value); - eassert (refcount > 0); - if (refcount > 1) - { - XSETFASTINT (value, refcount - 1); - set_hash_value_slot (h, i, value); - } - else - { - hash_remove_from_table (h, value); - } - } -} - -static enum emacs_funcall_exit -module_non_local_exit_check (emacs_env *env) -{ - check_main_thread (); - return env->private_members->pending_non_local_exit; -} - -static void -module_non_local_exit_clear (emacs_env *env) -{ - check_main_thread (); - env->private_members->pending_non_local_exit = emacs_funcall_exit_return; -} - -static enum emacs_funcall_exit -module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) -{ - check_main_thread (); - struct emacs_env_private *const p = env->private_members; - if (p->pending_non_local_exit != emacs_funcall_exit_return) - { - *sym = &p->non_local_exit_symbol; - *data = &p->non_local_exit_data; - } - return p->pending_non_local_exit; -} - -/* Like for `signal', DATA must be a list. */ -static void -module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - module_non_local_exit_signal_1 (env, value_to_lisp (sym), - value_to_lisp (data)); -} - -static void -module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - module_non_local_exit_throw_1 (env, value_to_lisp (tag), - value_to_lisp (value)); -} - -/* A module function is lambda function that calls `module-call', - passing the function pointer of the module function along with the - module emacs_env pointer as arguments. - - (function (lambda (&rest arglist) - (module-call envobj arglist))) */ - -static emacs_value -module_make_function (emacs_env *env, int min_arity, int max_arity, - emacs_subr subr, const char *const documentation, - void *data) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - - if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM) - xsignal0 (Qoverflow_error); - - if (min_arity < 0 - || (max_arity >= 0 && max_arity < min_arity) - || (max_arity < 0 && max_arity != emacs_variadic_function)) - xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); - - Lisp_Object envobj; - - /* XXX: This should need to be freed when envobj is GC'd. */ - struct module_fun_env *envptr = xzalloc (sizeof *envptr); - envptr->min_arity = min_arity; - envptr->max_arity = max_arity; - envptr->subr = subr; - envptr->data = data; - envobj = make_save_ptr (envptr); - - Lisp_Object ret = list4 (Qlambda, - list2 (Qand_rest, Qargs), - documentation ? build_string (documentation) : Qnil, - list3 (module_call_func, - envobj, - Qargs)); - - return lisp_to_value (env, ret); -} - -static emacs_value -module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[]) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - MODULE_HANDLE_THROW; - - /* Make a new Lisp_Object array starting with the function as the - first arg, because that's what Ffuncall takes. */ - Lisp_Object newargs[nargs + 1]; - newargs[0] = value_to_lisp (fun); - for (int i = 0; i < nargs; i++) - newargs[1 + i] = value_to_lisp (args[i]); - return lisp_to_value (env, Ffuncall (nargs + 1, newargs)); -} - -static emacs_value -module_intern (emacs_env *env, const char *name) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - return lisp_to_value (env, intern (name)); -} - -static emacs_value -module_type_of (emacs_env *env, emacs_value value) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - return lisp_to_value (env, Ftype_of (value_to_lisp (value))); -} - -static bool -module_is_not_nil (emacs_env *env, emacs_value value) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - return ! NILP (value_to_lisp (value)); -} - -static bool -module_eq (emacs_env *env, emacs_value a, emacs_value b) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - return EQ (value_to_lisp (a), value_to_lisp (b)); -} - -static int64_t -module_extract_integer (emacs_env *env, emacs_value n) -{ - verify (INT64_MIN <= MOST_NEGATIVE_FIXNUM); - verify (INT64_MAX >= MOST_POSITIVE_FIXNUM); - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object l = value_to_lisp (n); - if (! INTEGERP (l)) - { - module_wrong_type (env, Qintegerp, l); - return 0; - } - return XINT (l); -} - -static emacs_value -module_make_integer (emacs_env *env, int64_t n) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - if (n < MOST_NEGATIVE_FIXNUM) - { - module_non_local_exit_signal_1 (env, Qunderflow_error, Qnil); - return NULL; - } - if (n > MOST_POSITIVE_FIXNUM) - { - module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); - return NULL; - } - return lisp_to_value (env, make_number (n)); -} - -static double -module_extract_float (emacs_env *env, emacs_value f) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object lisp = value_to_lisp (f); - if (! FLOATP (lisp)) - { - module_wrong_type (env, Qfloatp, lisp); - return 0; - } - return XFLOAT_DATA (lisp); -} - -static emacs_value -module_make_float (emacs_env *env, double d) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - return lisp_to_value (env, make_float (d)); -} - -static bool -module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, - size_t *length) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - Lisp_Object lisp_str = value_to_lisp (value); - if (! STRINGP (lisp_str)) - { - module_wrong_type (env, Qstringp, lisp_str); - return false; - } - - size_t raw_size = SBYTES (lisp_str); - - /* Emacs internal encoding is more-or-less UTF8, let's assume utf8 - encoded emacs string are the same byte size. */ - - if (!buffer || length == 0 || *length-1 < raw_size) - { - *length = raw_size + 1; - return false; - } - - Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str); - eassert (raw_size == SBYTES (lisp_str_utf8)); - *length = raw_size + 1; - memcpy (buffer, SDATA (lisp_str_utf8), SBYTES (lisp_str_utf8)); - buffer[raw_size] = 0; - - return true; -} - -static emacs_value -module_make_string (emacs_env *env, const char *str, size_t length) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - MODULE_HANDLE_SIGNALS; - if (length > PTRDIFF_MAX) - { - module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); - return NULL; - } - /* Assume STR is utf8 encoded. */ - return lisp_to_value (env, make_string (str, length)); -} - -static emacs_value -module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) -{ - check_main_thread (); - return lisp_to_value (env, make_user_ptr (fin, ptr)); -} - -static void * -module_get_user_ptr (emacs_env *env, emacs_value uptr) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object lisp = value_to_lisp (uptr); - if (! USER_PTRP (lisp)) - { - module_wrong_type (env, Quser_ptr, lisp); - return NULL; - } - return XUSER_PTR (lisp)->p; -} - -static void -module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object lisp = value_to_lisp (uptr); - if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp); - XUSER_PTR (lisp)->p = ptr; -} - -static emacs_finalizer_function -module_get_user_finalizer (emacs_env *env, emacs_value uptr) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object lisp = value_to_lisp (uptr); - if (! USER_PTRP (lisp)) - { - module_wrong_type (env, Quser_ptr, lisp); - return NULL; - } - return XUSER_PTR (lisp)->finalizer; -} - -static void -module_set_user_finalizer (emacs_env *env, emacs_value uptr, - emacs_finalizer_function fin) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - const Lisp_Object lisp = value_to_lisp (uptr); - if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp); - XUSER_PTR (lisp)->finalizer = fin; -} - -static void -module_vec_set (emacs_env *env, emacs_value vec, size_t i, emacs_value val) -{ - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - if (i > MOST_POSITIVE_FIXNUM) - { - module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); - return; - } - Lisp_Object lvec = value_to_lisp (vec); - if (! VECTORP (lvec)) - { - module_wrong_type (env, Qvectorp, lvec); - return; - } - if (i >= ASIZE (lvec)) - { - module_args_out_of_range (env, lvec, make_number (i)); - return; - } - ASET (lvec, i, value_to_lisp (val)); -} - -static emacs_value -module_vec_get (emacs_env *env, emacs_value vec, size_t i) -{ - /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */ - verify (PTRDIFF_MAX <= SIZE_MAX); - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - if (i > MOST_POSITIVE_FIXNUM) - { - module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); - return NULL; - } - Lisp_Object lvec = value_to_lisp (vec); - if (! VECTORP (lvec)) - { - module_wrong_type (env, Qvectorp, lvec); - return NULL; - } - /* Prevent error-prone comparison between types of different signedness. */ - const size_t size = ASIZE (lvec); - eassert (size >= 0); - if (i >= size) - { - if (i > MOST_POSITIVE_FIXNUM) - i = (size_t) MOST_POSITIVE_FIXNUM; - module_args_out_of_range (env, lvec, make_number (i)); - return NULL; - } - return lisp_to_value (env, AREF (lvec, i)); -} - -static size_t -module_vec_size (emacs_env *env, emacs_value vec) -{ - /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */ - verify (PTRDIFF_MAX <= SIZE_MAX); - check_main_thread (); - eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); - Lisp_Object lvec = value_to_lisp (vec); - if (! VECTORP (lvec)) - { - module_wrong_type (env, Qvectorp, lvec); - return 0; - } - eassert (ASIZE (lvec) >= 0); - return ASIZE (lvec); -} - - -/* Subroutines. */ - -DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, - doc: /* Load module FILE. */) - (Lisp_Object file) -{ - dynlib_handle_ptr handle; - emacs_init_function module_init; - void *gpl_sym; - - CHECK_STRING (file); - handle = dynlib_open (SSDATA (file)); - if (!handle) - error ("Cannot load file %s: %s", SDATA (file), dynlib_error ()); - - gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible"); - if (!gpl_sym) - error ("Module %s is not GPL compatible", SDATA (file)); - - module_init = (emacs_init_function) dynlib_sym (handle, "emacs_module_init"); - if (!module_init) - error ("Module %s does not have an init function.", SDATA (file)); - - struct { - struct emacs_runtime pub; - struct emacs_runtime_private priv; - } runtime = { - .pub = { - .size = sizeof runtime.pub, - .get_environment = module_get_environment, - .private_members = &runtime.priv - } - }; - initialize_environment (&runtime.priv.environment); - int r = module_init (&runtime.pub); - finalize_environment (&runtime.priv.environment); - - if (r != 0) - { - if (r < MOST_NEGATIVE_FIXNUM) - xsignal0 (Qunderflow_error); - if (r > MOST_POSITIVE_FIXNUM) - xsignal0 (Qoverflow_error); - xsignal2 (Qmodule_load_failed, file, make_number (r)); - } - - return Qt; -} - -DEFUN ("module-call", Fmodule_call, Smodule_call, 2, 2, 0, - doc: /* Internal function to call a module function. -ENVOBJ is a save pointer to a module_fun_env structure. -ARGLIST is a list of arguments passed to SUBRPTR. */) - (Lisp_Object envobj, Lisp_Object arglist) -{ - const struct module_fun_env *const envptr = XSAVE_POINTER (envobj, 0); - const EMACS_INT len = XINT (Flength (arglist)); - eassert (len >= 0); - if (len > MOST_POSITIVE_FIXNUM) - xsignal0 (Qoverflow_error); - if (len > INT_MAX || len < envptr->min_arity - || (envptr->max_arity >= 0 && len > envptr->max_arity)) - xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr), - make_number (len)); - - struct env_storage env; - initialize_environment (&env); - - emacs_value *args = xzalloc (len * sizeof *args); - int i; - - for (i = 0; i < len; i++) - { - args[i] = lisp_to_value (&env.pub, XCAR (arglist)); - if (! args[i]) - memory_full (sizeof *args[i]); - arglist = XCDR (arglist); - } - - emacs_value ret = envptr->subr (&env.pub, len, args, envptr->data); - xfree (args); - - switch (env.priv.pending_non_local_exit) - { - case emacs_funcall_exit_return: - finalize_environment (&env); - if (ret == NULL) - xsignal1 (Qinvalid_module_call, module_format_fun_env (envptr)); - return value_to_lisp (ret); - case emacs_funcall_exit_signal: - { - Lisp_Object symbol = value_to_lisp (&env.priv.non_local_exit_symbol); - const Lisp_Object data = value_to_lisp (&env.priv.non_local_exit_data); - finalize_environment (&env); - xsignal (symbol, data); - } - case emacs_funcall_exit_throw: - { - const Lisp_Object tag = value_to_lisp (&env.priv.non_local_exit_symbol); - const Lisp_Object value = value_to_lisp (&env.priv.non_local_exit_data); - finalize_environment (&env); - Fthrow (tag, value); - } - default: - eassume (false); - } -} - - -/* Helper functions. */ - -static void -check_main_thread (void) -{ -#ifdef HAVE_THREADS_H - eassert (thrd_equal (thdr_current (), main_thread)); -#elif defined HAVE_PTHREAD - eassert (pthread_equal (pthread_self (), main_thread)); -#elif defined WINDOWSNT - /* CompareObjectHandles would be perfect, but is only available in - Windows 10. Also check whether the thread is still running to - protect against thread identifier reuse. */ - eassert (GetCurrentThreadId () == main_thread_id - && WaitForSingleObject (main_thread, 0) == WAIT_TIMEOUT); -#endif -} - -static void -module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, - Lisp_Object data) -{ - struct emacs_env_private *const p = env->private_members; - eassert (p->pending_non_local_exit == emacs_funcall_exit_return); - p->pending_non_local_exit = emacs_funcall_exit_signal; - p->non_local_exit_symbol.v = sym; - p->non_local_exit_data.v = data; -} - -static void -module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, - Lisp_Object value) -{ - struct emacs_env_private *const p = env->private_members; - eassert (p->pending_non_local_exit == emacs_funcall_exit_return); - p->pending_non_local_exit = emacs_funcall_exit_throw; - p->non_local_exit_symbol.v = tag; - p->non_local_exit_data.v = value; -} - -/* Module version of `wrong_type_argument'. */ -static void -module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value) -{ - module_non_local_exit_signal_1 (env, Qwrong_type_argument, - list2 (predicate, value)); -} - -/* Signal an out-of-memory condition to the caller. */ -static void -module_out_of_memory (emacs_env *env) -{ - /* TODO: Reimplement this so it works even if memory-signal-data has - been modified. */ - module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data), - XCDR (Vmemory_signal_data)); -} - -/* Signal arguments are out of range. */ -static void -module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2) -{ - module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2)); -} - - -/* Value conversion. */ - -/* Convert an `emacs_value' to the corresponding internal object. - Never fails. */ -static Lisp_Object -value_to_lisp (emacs_value v) -{ - return v->v; -} - -/* Convert an internal object to an `emacs_value'. Allocate storage - from the environment; return NULL if allocation fails. */ -static emacs_value -lisp_to_value (emacs_env *env, Lisp_Object o) -{ - struct emacs_env_private *const p = env->private_members; - if (p->pending_non_local_exit != emacs_funcall_exit_return) - return NULL; - return allocate_emacs_value (env, &p->storage, o); -} - - -/* Memory management. */ - -/* Must be called for each frame before it can be used for allocation. */ -static void -initialize_frame (struct emacs_value_frame *frame) -{ - frame->offset = 0; - frame->next = NULL; -} - -/* Must be called for any storage object before it can be used for - allocation. */ -static void -initialize_storage (struct emacs_value_storage *storage) -{ - initialize_frame (&storage->initial); - storage->current = &storage->initial; -} - -/* Must be called for any initialized storage object before its - lifetime ends. Free all dynamically-allocated frames. */ -static void -finalize_storage (struct emacs_value_storage *storage) -{ - struct emacs_value_frame *next = storage->initial.next; - while (next != NULL) - { - struct emacs_value_frame *const current = next; - next = current->next; - free (current); - } -} - -/* Allocate a new value from STORAGE and stores OBJ in it. Return - NULL if allocations fails and use ENV for non local exit reporting. */ -static emacs_value -allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, - Lisp_Object obj) -{ - eassert (storage->current); - eassert (storage->current->offset < value_frame_size); - eassert (! storage->current->next); - if (storage->current->offset == value_frame_size - 1) - { - storage->current->next = malloc (sizeof *storage->current->next); - if (! storage->current->next) - { - module_out_of_memory (env); - return NULL; - } - initialize_frame (storage->current->next); - storage->current = storage->current->next; - } - const emacs_value value = storage->current->objects + storage->current->offset; - value->v = obj; - ++storage->current->offset; - return value; -} - -/* Mark all objects allocated from local environments so that they - don't get garbage-collected. */ -void mark_modules (void) -{ - for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) - { - const struct env_storage *const env = XSAVE_POINTER (tem, 0); - for (const struct emacs_value_frame *frame = &env->priv.storage.initial; - frame != NULL; - frame = frame->next) - for (size_t i = 0; i < frame->offset; ++i) - mark_object (frame->objects[i].v); - } -} - - -/* Environment lifetime management. */ - -/* Must be called before the environment can be used. */ -static void -initialize_environment (struct env_storage *env) -{ - env->priv.pending_non_local_exit = emacs_funcall_exit_return; - initialize_storage (&env->priv.storage); - env->pub.size = sizeof env->pub; - env->pub.private_members = &env->priv; - env->pub.make_global_ref = module_make_global_ref; - env->pub.free_global_ref = module_free_global_ref; - env->pub.non_local_exit_check = module_non_local_exit_check; - env->pub.non_local_exit_clear = module_non_local_exit_clear; - env->pub.non_local_exit_get = module_non_local_exit_get; - env->pub.non_local_exit_signal = module_non_local_exit_signal; - env->pub.non_local_exit_throw = module_non_local_exit_throw; - env->pub.make_function = module_make_function; - env->pub.funcall = module_funcall; - env->pub.intern = module_intern; - env->pub.type_of = module_type_of; - env->pub.is_not_nil = module_is_not_nil; - env->pub.eq = module_eq; - env->pub.extract_integer = module_extract_integer; - env->pub.make_integer = module_make_integer; - env->pub.extract_float = module_extract_float; - env->pub.make_float = module_make_float; - env->pub.copy_string_contents = module_copy_string_contents; - env->pub.make_string = module_make_string; - env->pub.make_user_ptr = module_make_user_ptr; - env->pub.get_user_ptr = module_get_user_ptr; - env->pub.set_user_ptr = module_set_user_ptr; - env->pub.get_user_finalizer = module_get_user_finalizer; - env->pub.set_user_finalizer = module_set_user_finalizer; - env->pub.vec_set = module_vec_set; - env->pub.vec_get = module_vec_get; - env->pub.vec_size = module_vec_size; - Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments); -} - -/* Must be called before the lifetime of the environment object - ends. */ -static void -finalize_environment (struct env_storage *env) -{ - finalize_storage (&env->priv.storage); - Vmodule_environments = XCDR (Vmodule_environments); -} - - -/* Non-local exit handling. */ - -/* Must be called after setting up a handler immediately before - returning from the function. See the comments in lisp.h and the - code in eval.c for details. The macros below arrange for this - function to be called automatically. DUMMY is ignored. */ -static void -module_reset_handlerlist (const int *dummy) -{ - handlerlist = handlerlist->next; -} - -/* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets - stored in the environment. Set the pending non-local exit flag. */ -static void -module_handle_signal (emacs_env *const env, const Lisp_Object err) -{ - module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err)); -} - -/* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets - stored in the environment. Set the pending non-local exit flag. */ -static void -module_handle_throw (emacs_env *const env, const Lisp_Object tag_val) -{ - module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val)); -} - - -/* Function environments. */ - -/* Return a string object that contains a user-friendly - representation of the function environment. */ -static Lisp_Object -module_format_fun_env (const struct module_fun_env *const env) -{ - /* Try to print a function name if possible. */ - const char *path, *sym; - if (dynlib_addr (env->subr, &path, &sym)) - { - const char *const format = "#"; - const int size = snprintf (NULL, 0, format, sym, path); - eassert (size > 0); - char buffer[size + 1]; - snprintf (buffer, sizeof buffer, format, sym, path); - return make_unibyte_string (buffer, size); - } - else - { - const char *const format = "#"; - const void *const subr = env->subr; - const int size = snprintf (NULL, 0, format, subr); - eassert (size > 0); - char buffer[size + 1]; - snprintf (buffer, sizeof buffer, format, subr); - return make_unibyte_string (buffer, size); - } -} - - -/* Segment initializer. */ - -void -syms_of_module (void) -{ - DEFSYM (Qmodule_refs_hash, "module-refs-hash"); - DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, - doc: /* Module global referrence table. */); - - Vmodule_refs_hash - = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), - make_float (DEFAULT_REHASH_SIZE), - make_float (DEFAULT_REHASH_THRESHOLD), - Qnil); - Funintern (Qmodule_refs_hash, Qnil); - - DEFSYM (Qmodule_environments, "module-environments"); - DEFVAR_LISP ("module-environments", Vmodule_environments, - doc: /* List of active module environments. */); - Vmodule_environments = Qnil; - /* Unintern `module-environments' because it is only used - internally. */ - Funintern (Qmodule_environments, Qnil); - - DEFSYM (Qmodule_load_failed, "module-load-failed"); - Fput (Qmodule_load_failed, Qerror_conditions, - listn (CONSTYPE_PURE, 2, Qmodule_load_failed, Qerror)); - Fput (Qmodule_load_failed, Qerror_message, - build_pure_c_string ("Module load failed")); - - DEFSYM (Qinvalid_module_call, "invalid-module-call"); - Fput (Qinvalid_module_call, Qerror_conditions, - listn (CONSTYPE_PURE, 2, Qinvalid_module_call, Qerror)); - Fput (Qinvalid_module_call, Qerror_message, - build_pure_c_string ("Invalid module call")); - - DEFSYM (Qinvalid_arity, "invalid-arity"); - Fput (Qinvalid_arity, Qerror_conditions, - listn (CONSTYPE_PURE, 2, Qinvalid_arity, Qerror)); - Fput (Qinvalid_arity, Qerror_message, - build_pure_c_string ("Invalid function arity")); - - initialize_storage (&global_storage); - - /* Unintern `module-refs-hash' because it is internal-only and Lisp - code or modules should not access it. */ - Funintern (Qmodule_refs_hash, Qnil); - - defsubr (&Smodule_load); - - /* Don't call defsubr on `module-call' because that would intern it, - but `module-call' is an internal function that users cannot - meaningfully use. Instead, assign its definition to a private - variable. */ - XSETPVECTYPE (&Smodule_call, PVEC_SUBR); - XSETSUBR (module_call_func, &Smodule_call); -} - -/* Unlike syms_of_module, this initializer is called even from an - initialized (dumped) Emacs. */ - -void -module_init (void) -{ - /* It is not guaranteed that dynamic initializers run in the main thread, - therefore detect the main thread here. */ -#ifdef HAVE_THREADS_H - main_thread = thrd_current (); -#elif defined HAVE_PTHREAD - main_thread = pthread_self (); -#elif defined WINDOWSNT - /* This calls APIs that are only available on Vista and later. */ -# if false - /* GetCurrentProcess returns a pseudohandle, which must be duplicated. */ - if (! DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), - GetCurrentProcess (), &main_thread, - SYNCHRONIZE | THREAD_QUERY_INFORMATION, - FALSE, 0)) - emacs_abort (); -# else - /* GetCurrentThread returns a pseudohandle, which must be duplicated. */ - HANDLE th = GetCurrentThread (); - if (!DuplicateHandle (GetCurrentProcess (), th, - GetCurrentProcess (), &main_thread, 0, FALSE, - DUPLICATE_SAME_ACCESS)) - emacs_abort (); - main_thread_id = GetCurrentThreadId (); -# endif -#endif -} diff --git a/src/module.h b/src/module.h deleted file mode 100644 index d4fad9d32a0..00000000000 --- a/src/module.h +++ /dev/null @@ -1,202 +0,0 @@ -/* module.h - GNU Emacs module API. - -Copyright (C) 2015 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#ifndef EMACS_MODULE_H -#define EMACS_MODULE_H - -#include -#include -#include - -#if defined __cplusplus && __cplusplus >= 201103L -# define EMACS_NOEXCEPT noexcept -#else -# define EMACS_NOEXCEPT -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -/* Current environment. */ -typedef struct emacs_env_25 emacs_env; - -/* Opaque structure pointer representing an Emacs Lisp value. */ -typedef struct emacs_value_tag *emacs_value; - -enum emacs_arity { emacs_variadic_function = -2 }; - -/* Struct passed to a module init function (emacs_module_init). */ -struct emacs_runtime -{ - /* Structure size (for version checking). */ - size_t size; - - /* Private data; users should not touch this. */ - struct emacs_runtime_private *private_members; - - /* Return an environment pointer. */ - emacs_env *(*get_environment) (struct emacs_runtime *ert); -}; - - -/* Function prototype for the module init function. */ -typedef int (*emacs_init_function) (struct emacs_runtime *ert); - -/* Function prototype for the module Lisp functions. */ -typedef emacs_value (*emacs_subr) (emacs_env *env, int nargs, emacs_value args[], - void *data); - -/* Function prototype for module user-pointer finalizers. */ -typedef void (*emacs_finalizer_function) (void *); - -/* Possible Emacs function call outcomes. */ -enum emacs_funcall_exit -{ - /* Function has returned normally. */ - emacs_funcall_exit_return = 0, - - /* Function has signaled an error using `signal'. */ - emacs_funcall_exit_signal = 1, - - /* Function has exit using `throw'. */ - emacs_funcall_exit_throw = 2, -}; - -struct emacs_env_25 -{ - /* Structure size (for version checking). */ - size_t size; - - /* Private data; users should not touch this. */ - struct emacs_env_private *private_members; - - /* Memory management. */ - - emacs_value (*make_global_ref) (emacs_env *env, - emacs_value any_reference); - - void (*free_global_ref) (emacs_env *env, - emacs_value global_reference); - - /* Non-local exit handling. */ - - enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env); - - void (*non_local_exit_clear) (emacs_env *env); - - enum emacs_funcall_exit (*non_local_exit_get) - (emacs_env *env, - emacs_value *non_local_exit_symbol_out, - emacs_value *non_local_exit_data_out); - - void (*non_local_exit_signal) (emacs_env *env, - emacs_value non_local_exit_symbol, - emacs_value non_local_exit_data); - - void (*non_local_exit_throw) (emacs_env *env, - emacs_value tag, - emacs_value value); - - /* Function registration. */ - - emacs_value (*make_function) (emacs_env *env, - int min_arity, - int max_arity, - emacs_value (*function) (emacs_env *, int, - emacs_value *, void *) - EMACS_NOEXCEPT, - const char *documentation, - void *data); - - emacs_value (*funcall) (emacs_env *env, - emacs_value function, - int nargs, - emacs_value args[]); - - emacs_value (*intern) (emacs_env *env, - const char *symbol_name); - - /* Type conversion. */ - - emacs_value (*type_of) (emacs_env *env, - emacs_value value); - - bool (*is_not_nil) (emacs_env *env, emacs_value value); - - bool (*eq) (emacs_env *env, emacs_value a, emacs_value b); - - int_fast64_t (*extract_integer) (emacs_env *env, - emacs_value value); - - emacs_value (*make_integer) (emacs_env *env, int_fast64_t value); - - double (*extract_float) (emacs_env *env, emacs_value value); - - emacs_value (*make_float) (emacs_env *env, double value); - - /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 - null-terminated string. - - SIZE must point to the total size of the buffer. If BUFFER is - NULL or if SIZE is not big enough, write the required buffer size - to SIZE and return false. - - Note that SIZE must include the last null byte (e.g. "abc" needs - a buffer of size 4). - - Return true if the string was successfully copied. */ - - bool (*copy_string_contents) (emacs_env *env, - emacs_value value, - char *buffer, - size_t *size_inout); - - /* Create a Lisp string from a utf8 encoded string. */ - emacs_value (*make_string) (emacs_env *env, - const char *contents, size_t length); - - /* Embedded pointer type. */ - emacs_value (*make_user_ptr) (emacs_env *env, - void (*fin) (void *) EMACS_NOEXCEPT, - void *ptr); - - void *(*get_user_ptr) (emacs_env *env, emacs_value uptr); - void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr); - - void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) - (void *) EMACS_NOEXCEPT; - void (*set_user_finalizer) (emacs_env *env, - emacs_value uptr, - void (*fin) (void *) EMACS_NOEXCEPT); - - /* Vector functions. */ - emacs_value (*vec_get) (emacs_env *env, emacs_value vec, size_t i); - - void (*vec_set) (emacs_env *env, emacs_value vec, size_t i, - emacs_value val); - - size_t (*vec_size) (emacs_env *env, emacs_value vec); -}; - -#ifdef __cplusplus -} -#endif - -#endif /* EMACS_MODULE_H */