aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2015-11-19 11:31:45 -0800
committerPaul Eggert2015-11-19 11:32:21 -0800
commitc8a972b0c3082edfcca4a85562224499f75bfe9b (patch)
tree6266e9c2d1d168e49ef6de34e800435162cca2d4 /src
parent7cd728c813f2c472a2f6a0cb0c3fb3ee46c9d8ad (diff)
downloademacs-c8a972b0c3082edfcca4a85562224499f75bfe9b.tar.gz
emacs-c8a972b0c3082edfcca4a85562224499f75bfe9b.zip
Style fixes for indenting etc. in module code
This is mostly indenting and spacing changes. Also, remove some unnecessary static decls instead of bothering to reindent them. * src/module.h (EMACS_EXTERN_C_BEGIN): Remove, and do this inline, as most other Emacs files do for this sort of thing.
Diffstat (limited to 'src')
-rw-r--r--src/dynlib.c45
-rw-r--r--src/dynlib.h8
-rw-r--r--src/lisp.h3
-rw-r--r--src/module.c731
-rw-r--r--src/module.h299
5 files changed, 513 insertions, 573 deletions
diff --git a/src/dynlib.c b/src/dynlib.c
index fbc5f9b873b..491a08e0787 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -26,63 +26,68 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 26
27#include "dynlib.h" 27#include "dynlib.h"
28 28
29/* 29#if defined _WIN32
30 * Windows systems 30
31 */ 31/* MS-Windows systems. */
32#if defined(_WIN32)
33 32
34#include <windows.h> 33#include <windows.h>
35 34
36dynlib_handle_ptr dynlib_open (const char * path) 35dynlib_handle_ptr
36dynlib_open (const char *path)
37{ 37{
38 38
39 return (dynlib_handle_ptr) LoadLibrary (path); 39 return (dynlib_handle_ptr) LoadLibrary (path);
40} 40}
41 41
42void * dynlib_sym (dynlib_handle_ptr h, const char * sym) 42void *
43dynlib_sym (dynlib_handle_ptr h, const char *sym)
43{ 44{
44 return GetProcAddress ((HMODULE) h, sym); 45 return GetProcAddress ((HMODULE) h, sym);
45} 46}
46 47
47bool dynlib_addr (void *ptr, const char **path, const char **sym) 48bool
49dynlib_addr (void *ptr, const char **path, const char **sym)
48{ 50{
49 return false; /* not implemented */ 51 return false; /* not implemented */
50} 52}
51 53
52const char * dynlib_error (void) 54const char *
55dynlib_error (void)
53{ 56{
54 /* TODO: use GetLastError(), FormatMessage(), ... */ 57 /* TODO: use GetLastError(), FormatMessage(), ... */
55 return "Can't load DLL"; 58 return "Can't load DLL";
56} 59}
57 60
58int dynlib_close (dynlib_handle_ptr h) 61int
62dynlib_close (dynlib_handle_ptr h)
59{ 63{
60 return FreeLibrary ((HMODULE) h) != 0; 64 return FreeLibrary ((HMODULE) h) != 0;
61} 65}
62 66
67#elif defined HAVE_UNISTD_H
63 68
64/* 69/* POSIX systems. */
65 * POSIX systems
66 */
67#elif defined(HAVE_UNISTD_H)
68 70
69#include <dlfcn.h> 71#include <dlfcn.h>
70 72
71dynlib_handle_ptr dynlib_open (const char * path) 73dynlib_handle_ptr
74dynlib_open (const char *path)
72{ 75{
73 return dlopen (path, RTLD_LAZY); 76 return dlopen (path, RTLD_LAZY);
74} 77}
75 78
76void * dynlib_sym (dynlib_handle_ptr h, const char * sym) 79void *
80dynlib_sym (dynlib_handle_ptr h, const char *sym)
77{ 81{
78 return dlsym (h, sym); 82 return dlsym (h, sym);
79} 83}
80 84
81bool dynlib_addr (void *ptr, const char **path, const char **sym) 85bool
86dynlib_addr (void *ptr, const char **path, const char **sym)
82{ 87{
83#ifdef HAVE_DLADDR 88#ifdef HAVE_DLADDR
84 Dl_info info; 89 Dl_info info;
85 if (dladdr (ptr, &info) != 0 && info.dli_fname != NULL && info.dli_sname != NULL) 90 if (dladdr (ptr, &info) && info.dli_fname && info.dli_sname)
86 { 91 {
87 *path = info.dli_fname; 92 *path = info.dli_fname;
88 *sym = info.dli_sname; 93 *sym = info.dli_sname;
@@ -92,12 +97,14 @@ bool dynlib_addr (void *ptr, const char **path, const char **sym)
92 return false; 97 return false;
93} 98}
94 99
95const char * dynlib_error (void) 100const char *
101dynlib_error (void)
96{ 102{
97 return dlerror (); 103 return dlerror ();
98} 104}
99 105
100int dynlib_close (dynlib_handle_ptr h) 106int
107dynlib_close (dynlib_handle_ptr h)
101{ 108{
102 return dlclose (h) == 0; 109 return dlclose (h) == 0;
103} 110}
diff --git a/src/dynlib.h b/src/dynlib.h
index 852842df478..bd03666b860 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -23,11 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23#include <config.h> 23#include <config.h>
24#include <stdbool.h> 24#include <stdbool.h>
25 25
26typedef void* dynlib_handle_ptr; 26typedef void *dynlib_handle_ptr;
27dynlib_handle_ptr dynlib_open (const char * path); 27dynlib_handle_ptr dynlib_open (const char *path);
28void * dynlib_sym (dynlib_handle_ptr h, const char * sym); 28void *dynlib_sym (dynlib_handle_ptr h, const char *sym);
29bool dynlib_addr (void *ptr, const char **path, const char **sym); 29bool dynlib_addr (void *ptr, const char **path, const char **sym);
30const char * dynlib_error (void); 30const char *dynlib_error (void);
31int dynlib_close (dynlib_handle_ptr h); 31int dynlib_close (dynlib_handle_ptr h);
32 32
33#endif /* DYNLIB_H */ 33#endif /* DYNLIB_H */
diff --git a/src/lisp.h b/src/lisp.h
index 3b6ea76943d..ce5a6d2aea8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2246,7 +2246,7 @@ struct Lisp_User_Ptr
2246 bool_bf gcmarkbit : 1; 2246 bool_bf gcmarkbit : 1;
2247 unsigned spacer : 15; 2247 unsigned spacer : 15;
2248 2248
2249 void (*finalizer) (void*); 2249 void (*finalizer) (void *);
2250 void *p; 2250 void *p;
2251}; 2251};
2252#endif 2252#endif
@@ -2347,7 +2347,6 @@ XUSER_PTR (Lisp_Object a)
2347} 2347}
2348#endif 2348#endif
2349 2349
2350
2351 2350
2352/* Forwarding pointer to an int variable. 2351/* Forwarding pointer to an int variable.
2353 This is allowed only in the value cell of a symbol, 2352 This is allowed only in the value cell of a symbol,
diff --git a/src/module.c b/src/module.c
index 4069b881394..35a9f48eb12 100644
--- a/src/module.c
+++ b/src/module.c
@@ -30,285 +30,193 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30#include "verify.h" 30#include "verify.h"
31 31
32 32
33/* Feature tests */ 33/* Feature tests. */
34 34
35enum { 35/* True if __attribute__ ((cleanup (...))) works, false otherwise. */
36 /* 1 if we have __attribute__((cleanup(...))), 0 otherwise */
37 module_has_cleanup =
38#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP 36#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP
39 1 37enum { module_has_cleanup = true };
40#else 38#else
41 0 39enum { module_has_cleanup = false };
42#endif 40#endif
43};
44 41
45/* Handle to the main thread. Used to verify that modules call us in 42/* Handle to the main thread. Used to verify that modules call us in
46 the right thread. */ 43 the right thread. */
47#if defined(HAVE_THREADS_H) 44#ifdef HAVE_THREADS_H
48#include <threads.h> 45# include <threads.h>
49static thrd_t main_thread; 46static thrd_t main_thread;
50#elif defined(HAVE_PTHREAD) 47#elif defined HAVE_PTHREAD
51#include <pthread.h> 48# include <pthread.h>
52static pthread_t main_thread; 49static pthread_t main_thread;
53#elif defined(WINDOWSNT) 50#elif defined WINDOWSNT
54#include <windows.h> 51# include <windows.h>
55/* On Windows, we store both a handle to the main thread and the 52/* On Windows, store both a handle to the main thread and the
56 thread ID because the latter can be reused when a thread 53 thread ID because the latter can be reused when a thread
57 terminates. */ 54 terminates. */
58static HANDLE main_thread; 55static HANDLE main_thread;
59static DWORD main_thread_id; 56static DWORD main_thread_id;
60#endif 57#endif
61 58
62 59
63/* Implementation of runtime and environment functions */ 60/* Memory management. */
64
65static emacs_env* module_get_environment (struct emacs_runtime *ert);
66
67static emacs_value module_make_global_ref (emacs_env *env,
68 emacs_value ref);
69static void module_free_global_ref (emacs_env *env,
70 emacs_value ref);
71static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *env);
72static void module_non_local_exit_clear (emacs_env *env);
73static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data);
74static void module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data);
75static void module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value);
76static emacs_value module_make_function (emacs_env *env,
77 int min_arity,
78 int max_arity,
79 emacs_subr subr,
80 const char *documentation,
81 void *data);
82static emacs_value module_funcall (emacs_env *env,
83 emacs_value fun,
84 int nargs,
85 emacs_value args[]);
86static emacs_value module_intern (emacs_env *env, const char *name);
87static emacs_value module_type_of (emacs_env *env, emacs_value value);
88static bool module_is_not_nil (emacs_env *env, emacs_value value);
89static bool module_eq (emacs_env *env, emacs_value a, emacs_value b);
90static int64_t module_extract_integer (emacs_env *env, emacs_value n);
91static emacs_value module_make_integer (emacs_env *env, int64_t n);
92static emacs_value module_make_float (emacs_env *env, double d);
93static double module_extract_float (emacs_env *env, emacs_value f);
94static bool module_copy_string_contents (emacs_env *env,
95 emacs_value value,
96 char *buffer,
97 size_t* length);
98static emacs_value module_make_string (emacs_env *env, const char *str, size_t lenght);
99static emacs_value module_make_user_ptr (emacs_env *env,
100 emacs_finalizer_function fin,
101 void *ptr);
102static void* module_get_user_ptr (emacs_env *env, emacs_value uptr);
103static void module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr);
104static emacs_finalizer_function module_get_user_finalizer (emacs_env *env, emacs_value uptr);
105static void module_set_user_finalizer (emacs_env *env,
106 emacs_value uptr,
107 emacs_finalizer_function fin);
108
109
110/* Helper functions */
111
112/* If checking is enabled, abort if the current thread is not the
113 Emacs main thread. */
114static void check_main_thread (void);
115
116/* Internal versions of `module_non_local_exit_signal' and `module_non_local_exit_throw'. */
117static void module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, Lisp_Object data);
118static void module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, Lisp_Object value);
119
120/* Module version of `wrong_type_argument'. */
121static void module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value);
122
123/* Signal an out-of-memory condition to the caller. */
124static void module_out_of_memory (emacs_env *env);
125
126/* Signal arguments are out of range. */
127static void module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2);
128
129
130/* Value conversion */
131
132/* Converts an `emacs_value' to the corresponding internal object.
133 Never fails. */
134static Lisp_Object value_to_lisp (emacs_value v);
135
136/* Converts an internal object to an `emacs_value'. Allocates storage
137 from the environment; returns NULL if allocation fails. */
138static emacs_value lisp_to_value (emacs_env *env, Lisp_Object o);
139
140
141/* Memory management */
142 61
143/* An `emacs_value' is just a pointer to a structure holding an 62/* An `emacs_value' is just a pointer to a structure holding an
144 internal Lisp object. */ 63 internal Lisp object. */
145struct emacs_value_tag { Lisp_Object v; }; 64struct emacs_value_tag { Lisp_Object v; };
146 65
147/* Local value objects use a simple fixed-sized block allocation 66/* Local value objects use a simple fixed-sized block allocation
148 scheme without explicit deallocation. All local values are 67 scheme without explicit deallocation. All local values are
149 deallocated when the lifetime of their environment ends. We keep 68 deallocated when the lifetime of their environment ends. Keep
150 track of a current frame from which new values are allocated, 69 track of a current frame from which new values are allocated,
151 appending further dynamically-allocated frames if necessary. */ 70 appending further dynamically-allocated frames if necessary. */
152 71
153enum { value_frame_size = 512 }; 72enum { value_frame_size = 512 };
154 73
155/* A block from which `emacs_value' object can be allocated. */ 74/* A block from which `emacs_value' object can be allocated. */
156struct emacs_value_frame { 75struct emacs_value_frame
157 /* Storage for values */ 76{
77 /* Storage for values. */
158 struct emacs_value_tag objects[value_frame_size]; 78 struct emacs_value_tag objects[value_frame_size];
159 79
160 /* Index of the next free value in `objects' */ 80 /* Index of the next free value in `objects'. */
161 size_t offset; 81 size_t offset;
162 82
163 /* Pointer to next frame, if any */ 83 /* Pointer to next frame, if any. */
164 struct emacs_value_frame *next; 84 struct emacs_value_frame *next;
165}; 85};
166 86
167/* Must be called for each frame before it can be used for
168 allocation. */
169static void initialize_frame (struct emacs_value_frame *frame);
170
171/* A structure that holds an initial frame (so that the first local 87/* A structure that holds an initial frame (so that the first local
172 values require no dynamic allocation) and keeps track of the 88 values require no dynamic allocation) and keeps track of the
173 current frame. */ 89 current frame. */
174static struct emacs_value_storage { 90static struct emacs_value_storage
91{
175 struct emacs_value_frame initial; 92 struct emacs_value_frame initial;
176 struct emacs_value_frame *current; 93 struct emacs_value_frame *current;
177} global_storage; 94} global_storage;
178 95
179/* Must be called for any storage object before it can be used for
180 allocation. */
181static void initialize_storage (struct emacs_value_storage *storage);
182
183/* Must be called for any initialized storage object before its
184 lifetime ends. Frees all dynamically-allocated frames. */
185static void finalize_storage (struct emacs_value_storage *storage);
186
187/* Allocates a new value from STORAGE and stores OBJ in it. Returns
188 NULL if allocations fails and uses ENV for non local exit reporting. */
189static emacs_value allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage,
190 Lisp_Object obj);
191
192 96
193/* Private runtime and environment members */ 97/* Private runtime and environment members. */
194 98
195/* The private part of an environment stores the current non local exit state 99/* The private part of an environment stores the current non local exit state
196 and holds the `emacs_value' objects allocated during the lifetime 100 and holds the `emacs_value' objects allocated during the lifetime
197 of the environment. */ 101 of the environment. */
198struct emacs_env_private { 102struct emacs_env_private
103{
199 enum emacs_funcall_exit pending_non_local_exit; 104 enum emacs_funcall_exit pending_non_local_exit;
200 105
201 /* Dedicated storage for non-local exit symbol and data so that we always 106 /* Dedicated storage for non-local exit symbol and data so that
202 have storage available for them, even in an out-of-memory 107 storage is always available for them, even in an out-of-memory
203 situation. */ 108 situation. */
204 struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; 109 struct emacs_value_tag non_local_exit_symbol, non_local_exit_data;
205 110
206 struct emacs_value_storage storage; 111 struct emacs_value_storage storage;
207}; 112};
208 113
209/* Combines public and private parts in one structure. This structure 114/* Combine public and private parts in one structure. This structure
210 is used whenever an environment is created. */ 115 is used whenever an environment is created. */
211struct env_storage { 116struct env_storage
117{
212 emacs_env pub; 118 emacs_env pub;
213 struct emacs_env_private priv; 119 struct emacs_env_private priv;
214}; 120};
215 121
216/* Must be called before the environment can be used. */
217static void initialize_environment (struct env_storage *env);
218
219/* Must be called before the lifetime of the environment object
220 ends. */
221static void finalize_environment (struct env_storage *env);
222
223/* The private parts of an `emacs_runtime' object contain the initial 122/* The private parts of an `emacs_runtime' object contain the initial
224 environment. */ 123 environment. */
225struct emacs_runtime_private { 124struct emacs_runtime_private
125{
226 struct env_storage environment; 126 struct env_storage environment;
227}; 127};
228 128
229 129
230/* Convenience macros for non-local exit handling */
231 130
232/* Emacs uses setjmp(3) and longjmp(3) for non-local exits, but we 131/* Forward declarations. */
233 can't allow module frames to be skipped because they are in general
234 not prepared for long jumps (e.g. the behavior in C++ is undefined
235 if objects with nontrivial destructors would be skipped).
236 Therefore we catch all non-local exits. There are two kinds of
237 non-local exits: `signal' and `throw'. The macros in this section
238 can be used to catch both. We use macros so that we don't have to
239 write lots of additional variants of `internal_condition_case'
240 etc. and don't have to worry about passing information to the
241 handler functions. */
242 132
243/* Called on `signal'. ERR will be a cons cell (SYMBOL . DATA), which 133struct module_fun_env;
244 gets stored in the environment. Sets the pending non-local exit flag. */
245static void module_handle_signal (emacs_env *env, Lisp_Object err);
246 134
247/* Called on `throw'. TAG_VAL will be a cons cell (TAG . VALUE), 135static Lisp_Object module_format_fun_env (const struct module_fun_env *);
248 which gets stored in the environment. Sets the pending non-local exit 136static Lisp_Object value_to_lisp (emacs_value);
249 flag. */ 137static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object);
250static void module_handle_throw (emacs_env *env, Lisp_Object tag_val); 138static emacs_value lisp_to_value (emacs_env *, Lisp_Object);
139static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
140static void check_main_thread (void);
141static void finalize_environment (struct env_storage *);
142static void initialize_environment (struct env_storage *);
143static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object);
144static void module_handle_signal (emacs_env *, const Lisp_Object);
145static void module_handle_throw (emacs_env *, Lisp_Object);
146static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object);
147static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object);
148static void module_out_of_memory (emacs_env *);
149static void module_reset_handlerlist (const int *);
150static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
251 151
252/* Must be called after setting up a handler immediately before 152
253 returning from the function. See the comments in lisp.h and the 153/* Convenience macros for non-local exit handling. */
254 code in eval.c for details. The macros below arrange for this 154
255 function to be called automatically. DUMMY is ignored. */ 155/* Emacs uses setjmp and longjmp for non-local exits, but
256static void module_reset_handlerlist (const int *dummy); 156 module frames cannot be skipped because they are in general
157 not prepared for long jumps (e.g., the behavior in C++ is undefined
158 if objects with nontrivial destructors would be skipped).
159 Therefore, catch all non-local exits. There are two kinds of
160 non-local exits: `signal' and `throw'. The macros in this section
161 can be used to catch both. Use macros to avoid additional variants
162 of `internal_condition_case' etc., and to avoid worrying about
163 passing information to the handler functions. */
257 164
258/* Place this macro at the beginning of a function returning a number 165/* Place this macro at the beginning of a function returning a number
259 or a pointer to handle signals. The function must have an ENV 166 or a pointer to handle signals. The function must have an ENV
260 parameter. The function will return 0 (or NULL) if a signal is 167 parameter. The function will return 0 (or NULL) if a signal is
261 caught. */ 168 caught. */
262#define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN(0) 169#define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN (0)
263 170
264/* Place this macro at the beginning of a function returning void to 171/* Place this macro at the beginning of a function returning void to
265 handle signals. The function must have an ENV parameter. */ 172 handle signals. The function must have an ENV parameter. */
266#define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN() 173#define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN ()
267 174
268#define MODULE_HANDLE_SIGNALS_RETURN(retval) \ 175#define MODULE_HANDLE_SIGNALS_RETURN(retval) \
269 MODULE_SETJMP(CONDITION_CASE, module_handle_signal, retval) 176 MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval)
270 177
271/* Place this macro at the beginning of a function returning a pointer 178/* Place this macro at the beginning of a function returning a pointer
272 to handle non-local exits via `throw'. The function must have an 179 to handle non-local exits via `throw'. The function must have an
273 ENV parameter. The function will return NULL if a `throw' is 180 ENV parameter. The function will return NULL if a `throw' is
274 caught. */ 181 caught. */
275#define MODULE_HANDLE_THROW \ 182#define MODULE_HANDLE_THROW \
276 MODULE_SETJMP(CATCHER_ALL, module_handle_throw, NULL) 183 MODULE_SETJMP (CATCHER_ALL, module_handle_throw, NULL)
277 184
278#define MODULE_SETJMP(handlertype, handlerfunc, retval) \ 185#define MODULE_SETJMP(handlertype, handlerfunc, retval) \
279 MODULE_SETJMP_1(handlertype, handlerfunc, retval, \ 186 MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \
280 internal_handler_##handlertype, \ 187 internal_handler_##handlertype, \
281 internal_cleanup_##handlertype) 188 internal_cleanup_##handlertype)
282 189
283#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \ 190/* It is very important that pushing the handler doesn't itself raise
284 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \ 191 a signal. Install the cleanup only after the handler has been
285 struct handler *c; \ 192 pushed. Use __attribute__ ((cleanup)) to avoid
286 /* It is very important that pushing the handler doesn't itself raise a \ 193 non-local-exit-prone manual cleanup. */
287 signal. */ \ 194#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \
288 if (!push_handler_nosignal(&c, Qt, handlertype)) { \ 195 do { \
289 module_out_of_memory(env); \ 196 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \
290 return retval; \ 197 struct handler *c; \
291 } \ 198 if (!push_handler_nosignal (&c, Qt, handlertype)) \
292 verify(module_has_cleanup); \ 199 { \
293 /* We can install the cleanup only after the handler has been pushed. Use \ 200 module_out_of_memory (env); \
294 __attribute__((cleanup)) to avoid non-local-exit-prone manual cleanup. */ \ 201 return retval; \
295 const int dummy __attribute__((cleanup(module_reset_handlerlist))); \ 202 } \
296 if (sys_setjmp(c->jmp)) { \ 203 verify (module_has_cleanup); \
297 (handlerfunc)(env, c->val); \ 204 const int dummy __attribute__ ((cleanup (module_reset_handlerlist))); \
298 return retval; \ 205 if (sys_setjmp (c->jmp)) \
299 } \ 206 { \
300 /* Force the macro to be followed by a semicolon. */ \ 207 (handlerfunc) (env, c->val); \
301 do { \ 208 return retval; \
302 } while (0) 209 } \
210 } while (false)
303 211
304 212
305/* Function environments */ 213/* Function environments. */
306 214
307/* A function environment is an auxiliary structure used by 215/* A function environment is an auxiliary structure used by
308 `module_make_function' to store information about a module 216 `module_make_function' to store information about a module
309 function. It is stored in a save pointer and retrieved by 217 function. It is stored in a save pointer and retrieved by
310 `module-call'. Its members correspond to the arguments given to 218 `module-call'. Its members correspond to the arguments given to
311 `module_make_function'. */ 219 `module_make_function'. */
312 220
313struct module_fun_env 221struct module_fun_env
314{ 222{
@@ -317,34 +225,30 @@ struct module_fun_env
317 void *data; 225 void *data;
318}; 226};
319 227
320/* Returns a string object that contains a user-friendly 228/* The function definition of `module-call'. `module-call' is
321 representation of the function environment. */ 229 uninterned because user code couldn't meaningfully use it, so keep
322static Lisp_Object module_format_fun_env (const struct module_fun_env *env); 230 its definition around somewhere else. */
323
324/* Holds the function definition of `module-call'. `module-call' is
325 uninterned because user code couldn't meaningfully use it, so we
326 have to keep its definition around somewhere else. */
327static Lisp_Object module_call_func; 231static Lisp_Object module_call_func;
328 232
329 233
330/* Implementation of runtime and environment functions */ 234/* Implementation of runtime and environment functions. */
331 235
332/* We catch signals and throws only if the code can actually signal or 236/* Catch signals and throws only if the code can actually signal or
333 throw. */ 237 throw. If checking is enabled, abort if the current thread is not
238 the Emacs main thread. */
334 239
335static emacs_env* module_get_environment (struct emacs_runtime *ert) 240static emacs_env *
241module_get_environment (struct emacs_runtime *ert)
336{ 242{
337 check_main_thread (); 243 check_main_thread ();
338 return &ert->private_members->environment.pub; 244 return &ert->private_members->environment.pub;
339} 245}
340 246
341/* 247/* To make global refs (GC-protected global values) keep a hash that
342 * To make global refs (GC-protected global values) we keep a hash 248 maps global Lisp objects to reference counts. */
343 * that maps global Lisp objects to reference counts.
344 */
345 249
346static emacs_value module_make_global_ref (emacs_env *env, 250static emacs_value
347 emacs_value ref) 251module_make_global_ref (emacs_env *env, emacs_value ref)
348{ 252{
349 check_main_thread (); 253 check_main_thread ();
350 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 254 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -376,12 +280,12 @@ static emacs_value module_make_global_ref (emacs_env *env,
376 return allocate_emacs_value (env, &global_storage, new_obj); 280 return allocate_emacs_value (env, &global_storage, new_obj);
377} 281}
378 282
379static void module_free_global_ref (emacs_env *env, 283static void
380 emacs_value ref) 284module_free_global_ref (emacs_env *env, emacs_value ref)
381{ 285{
382 check_main_thread (); 286 check_main_thread ();
383 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 287 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
384 /* TODO: This probably never signals. */ 288 /* TODO: This probably never signals. */
385 MODULE_HANDLE_SIGNALS_VOID; 289 MODULE_HANDLE_SIGNALS_VOID;
386 eassert (HASH_TABLE_P (Vmodule_refs_hash)); 290 eassert (HASH_TABLE_P (Vmodule_refs_hash));
387 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); 291 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
@@ -407,19 +311,22 @@ static void module_free_global_ref (emacs_env *env,
407 } 311 }
408} 312}
409 313
410static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *env) 314static enum emacs_funcall_exit
315module_non_local_exit_check (emacs_env *env)
411{ 316{
412 check_main_thread (); 317 check_main_thread ();
413 return env->private_members->pending_non_local_exit; 318 return env->private_members->pending_non_local_exit;
414} 319}
415 320
416static void module_non_local_exit_clear (emacs_env *env) 321static void
322module_non_local_exit_clear (emacs_env *env)
417{ 323{
418 check_main_thread (); 324 check_main_thread ();
419 env->private_members->pending_non_local_exit = emacs_funcall_exit_return; 325 env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
420} 326}
421 327
422static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) 328static enum emacs_funcall_exit
329module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
423{ 330{
424 check_main_thread (); 331 check_main_thread ();
425 struct emacs_env_private *const p = env->private_members; 332 struct emacs_env_private *const p = env->private_members;
@@ -431,42 +338,36 @@ static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env, emacs_
431 return p->pending_non_local_exit; 338 return p->pending_non_local_exit;
432} 339}
433 340
434/* 341/* Like for `signal', DATA must be a list. */
435 * Like for `signal', DATA must be a list 342static void
436 */ 343module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
437static void module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
438{ 344{
439 check_main_thread (); 345 check_main_thread ();
440 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 346 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
441 module_non_local_exit_signal_1 (env, value_to_lisp (sym), value_to_lisp (data)); 347 module_non_local_exit_signal_1 (env, value_to_lisp (sym),
348 value_to_lisp (data));
442} 349}
443 350
444static void module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) 351static void
352module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
445{ 353{
446 check_main_thread (); 354 check_main_thread ();
447 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 355 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
448 module_non_local_exit_throw_1 (env, value_to_lisp (tag), value_to_lisp (value)); 356 module_non_local_exit_throw_1 (env, value_to_lisp (tag),
357 value_to_lisp (value));
449} 358}
450 359
451/* 360/* A module function is lambda function that calls `module-call',
452 * A module function is lambda function that calls `module-call', 361 passing the function pointer of the module function along with the
453 * passing the function pointer of the module function along with the 362 module emacs_env pointer as arguments.
454 * module emacs_env pointer as arguments. 363
455 * 364 (function (lambda (&rest arglist)
456 * (function 365 (module-call envobj arglist))) */
457 * (lambda 366
458 * (&rest arglist) 367static emacs_value
459 * (module-call 368module_make_function (emacs_env *env, int min_arity, int max_arity,
460 * envobj 369 emacs_subr subr, const char *const documentation,
461 * arglist))) 370 void *data)
462 *
463 */
464static emacs_value module_make_function (emacs_env *env,
465 int min_arity,
466 int max_arity,
467 emacs_subr subr,
468 const char *const documentation,
469 void *data)
470{ 371{
471 check_main_thread (); 372 check_main_thread ();
472 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 373 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -475,15 +376,15 @@ static emacs_value module_make_function (emacs_env *env,
475 if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM) 376 if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM)
476 xsignal0 (Qoverflow_error); 377 xsignal0 (Qoverflow_error);
477 378
478 if (min_arity < 0 || 379 if (min_arity < 0
479 (max_arity >= 0 && max_arity < min_arity) || 380 || (max_arity >= 0 && max_arity < min_arity)
480 (max_arity < 0 && max_arity != emacs_variadic_function)) 381 || (max_arity < 0 && max_arity != emacs_variadic_function))
481 xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); 382 xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity));
482 383
483 Lisp_Object envobj; 384 Lisp_Object envobj;
484 385
485 /* XXX: This should need to be freed when envobj is GC'd */ 386 /* XXX: This should need to be freed when envobj is GC'd. */
486 struct module_fun_env *envptr = xzalloc (sizeof (*envptr)); 387 struct module_fun_env *envptr = xzalloc (sizeof *envptr);
487 envptr->min_arity = min_arity; 388 envptr->min_arity = min_arity;
488 envptr->max_arity = max_arity; 389 envptr->max_arity = max_arity;
489 envptr->subr = subr; 390 envptr->subr = subr;
@@ -500,20 +401,16 @@ static emacs_value module_make_function (emacs_env *env,
500 return lisp_to_value (env, ret); 401 return lisp_to_value (env, ret);
501} 402}
502 403
503static emacs_value module_funcall (emacs_env *env, 404static emacs_value
504 emacs_value fun, 405module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[])
505 int nargs,
506 emacs_value args[])
507{ 406{
508 check_main_thread (); 407 check_main_thread ();
509 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 408 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
510 MODULE_HANDLE_SIGNALS; 409 MODULE_HANDLE_SIGNALS;
511 MODULE_HANDLE_THROW; 410 MODULE_HANDLE_THROW;
512 411
513 /* 412 /* Make a new Lisp_Object array starting with the function as the
514 * Make a new Lisp_Object array starting with the function as the 413 first arg, because that's what Ffuncall takes. */
515 * first arg, because that's what Ffuncall takes
516 */
517 Lisp_Object newargs[nargs + 1]; 414 Lisp_Object newargs[nargs + 1];
518 newargs[0] = value_to_lisp (fun); 415 newargs[0] = value_to_lisp (fun);
519 for (int i = 0; i < nargs; i++) 416 for (int i = 0; i < nargs; i++)
@@ -521,7 +418,8 @@ static emacs_value module_funcall (emacs_env *env,
521 return lisp_to_value (env, Ffuncall (nargs + 1, newargs)); 418 return lisp_to_value (env, Ffuncall (nargs + 1, newargs));
522} 419}
523 420
524static emacs_value module_intern (emacs_env *env, const char *name) 421static emacs_value
422module_intern (emacs_env *env, const char *name)
525{ 423{
526 check_main_thread (); 424 check_main_thread ();
527 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 425 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -529,28 +427,32 @@ static emacs_value module_intern (emacs_env *env, const char *name)
529 return lisp_to_value (env, intern (name)); 427 return lisp_to_value (env, intern (name));
530} 428}
531 429
532static emacs_value module_type_of (emacs_env *env, emacs_value value) 430static emacs_value
431module_type_of (emacs_env *env, emacs_value value)
533{ 432{
534 check_main_thread (); 433 check_main_thread ();
535 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 434 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
536 return lisp_to_value (env, Ftype_of (value_to_lisp (value))); 435 return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
537} 436}
538 437
539static bool module_is_not_nil (emacs_env *env, emacs_value value) 438static bool
439module_is_not_nil (emacs_env *env, emacs_value value)
540{ 440{
541 check_main_thread (); 441 check_main_thread ();
542 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 442 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
543 return ! NILP (value_to_lisp (value)); 443 return ! NILP (value_to_lisp (value));
544} 444}
545 445
546static bool module_eq (emacs_env *env, emacs_value a, emacs_value b) 446static bool
447module_eq (emacs_env *env, emacs_value a, emacs_value b)
547{ 448{
548 check_main_thread (); 449 check_main_thread ();
549 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 450 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
550 return EQ (value_to_lisp (a), value_to_lisp (b)); 451 return EQ (value_to_lisp (a), value_to_lisp (b));
551} 452}
552 453
553static int64_t module_extract_integer (emacs_env *env, emacs_value n) 454static int64_t
455module_extract_integer (emacs_env *env, emacs_value n)
554{ 456{
555 verify (INT64_MIN <= MOST_NEGATIVE_FIXNUM); 457 verify (INT64_MIN <= MOST_NEGATIVE_FIXNUM);
556 verify (INT64_MAX >= MOST_POSITIVE_FIXNUM); 458 verify (INT64_MAX >= MOST_POSITIVE_FIXNUM);
@@ -565,7 +467,8 @@ static int64_t module_extract_integer (emacs_env *env, emacs_value n)
565 return XINT (l); 467 return XINT (l);
566} 468}
567 469
568static emacs_value module_make_integer (emacs_env *env, int64_t n) 470static emacs_value
471module_make_integer (emacs_env *env, int64_t n)
569{ 472{
570 check_main_thread (); 473 check_main_thread ();
571 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 474 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -582,7 +485,8 @@ static emacs_value module_make_integer (emacs_env *env, int64_t n)
582 return lisp_to_value (env, make_number (n)); 485 return lisp_to_value (env, make_number (n));
583} 486}
584 487
585static double module_extract_float (emacs_env *env, emacs_value f) 488static double
489module_extract_float (emacs_env *env, emacs_value f)
586{ 490{
587 check_main_thread (); 491 check_main_thread ();
588 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 492 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -595,7 +499,8 @@ static double module_extract_float (emacs_env *env, emacs_value f)
595 return XFLOAT_DATA (lisp); 499 return XFLOAT_DATA (lisp);
596} 500}
597 501
598static emacs_value module_make_float (emacs_env *env, double d) 502static emacs_value
503module_make_float (emacs_env *env, double d)
599{ 504{
600 check_main_thread (); 505 check_main_thread ();
601 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 506 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -603,10 +508,9 @@ static emacs_value module_make_float (emacs_env *env, double d)
603 return lisp_to_value (env, make_float (d)); 508 return lisp_to_value (env, make_float (d));
604} 509}
605 510
606static bool module_copy_string_contents (emacs_env *env, 511static bool
607 emacs_value value, 512module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
608 char *buffer, 513 size_t *length)
609 size_t* length)
610{ 514{
611 check_main_thread (); 515 check_main_thread ();
612 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 516 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -620,10 +524,8 @@ static bool module_copy_string_contents (emacs_env *env,
620 524
621 size_t raw_size = SBYTES (lisp_str); 525 size_t raw_size = SBYTES (lisp_str);
622 526
623 /* 527 /* Emacs internal encoding is more-or-less UTF8, let's assume utf8
624 * Emacs internal encoding is more-or-less UTF8, let's assume utf8 528 encoded emacs string are the same byte size. */
625 * encoded emacs string are the same byte size.
626 */
627 529
628 if (!buffer || length == 0 || *length-1 < raw_size) 530 if (!buffer || length == 0 || *length-1 < raw_size)
629 { 531 {
@@ -640,7 +542,8 @@ static bool module_copy_string_contents (emacs_env *env,
640 return true; 542 return true;
641} 543}
642 544
643static emacs_value module_make_string (emacs_env *env, const char *str, size_t length) 545static emacs_value
546module_make_string (emacs_env *env, const char *str, size_t length)
644{ 547{
645 check_main_thread (); 548 check_main_thread ();
646 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 549 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -650,19 +553,19 @@ static emacs_value module_make_string (emacs_env *env, const char *str, size_t l
650 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); 553 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
651 return NULL; 554 return NULL;
652 } 555 }
653 /* Assume STR is utf8 encoded */ 556 /* Assume STR is utf8 encoded. */
654 return lisp_to_value (env, make_string (str, length)); 557 return lisp_to_value (env, make_string (str, length));
655} 558}
656 559
657static emacs_value module_make_user_ptr (emacs_env *env, 560static emacs_value
658 emacs_finalizer_function fin, 561module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
659 void *ptr)
660{ 562{
661 check_main_thread (); 563 check_main_thread ();
662 return lisp_to_value (env, make_user_ptr (fin, ptr)); 564 return lisp_to_value (env, make_user_ptr (fin, ptr));
663} 565}
664 566
665static void* module_get_user_ptr (emacs_env *env, emacs_value uptr) 567static void *
568module_get_user_ptr (emacs_env *env, emacs_value uptr)
666{ 569{
667 check_main_thread (); 570 check_main_thread ();
668 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 571 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -675,7 +578,8 @@ static void* module_get_user_ptr (emacs_env *env, emacs_value uptr)
675 return XUSER_PTR (lisp)->p; 578 return XUSER_PTR (lisp)->p;
676} 579}
677 580
678static void module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) 581static void
582module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
679{ 583{
680 check_main_thread (); 584 check_main_thread ();
681 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 585 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -684,7 +588,8 @@ static void module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
684 XUSER_PTR (lisp)->p = ptr; 588 XUSER_PTR (lisp)->p = ptr;
685} 589}
686 590
687static emacs_finalizer_function module_get_user_finalizer (emacs_env *env, emacs_value uptr) 591static emacs_finalizer_function
592module_get_user_finalizer (emacs_env *env, emacs_value uptr)
688{ 593{
689 check_main_thread (); 594 check_main_thread ();
690 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 595 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -697,9 +602,9 @@ static emacs_finalizer_function module_get_user_finalizer (emacs_env *env, emacs
697 return XUSER_PTR (lisp)->finalizer; 602 return XUSER_PTR (lisp)->finalizer;
698} 603}
699 604
700static void module_set_user_finalizer (emacs_env *env, 605static void
701 emacs_value uptr, 606module_set_user_finalizer (emacs_env *env, emacs_value uptr,
702 emacs_finalizer_function fin) 607 emacs_finalizer_function fin)
703{ 608{
704 check_main_thread (); 609 check_main_thread ();
705 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 610 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -708,10 +613,8 @@ static void module_set_user_finalizer (emacs_env *env,
708 XUSER_PTR (lisp)->finalizer = fin; 613 XUSER_PTR (lisp)->finalizer = fin;
709} 614}
710 615
711static void module_vec_set (emacs_env *env, 616static void
712 emacs_value vec, 617module_vec_set (emacs_env *env, emacs_value vec, size_t i, emacs_value val)
713 size_t i,
714 emacs_value val)
715{ 618{
716 check_main_thread (); 619 check_main_thread ();
717 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 620 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -734,11 +637,10 @@ static void module_vec_set (emacs_env *env,
734 ASET (lvec, i, value_to_lisp (val)); 637 ASET (lvec, i, value_to_lisp (val));
735} 638}
736 639
737static emacs_value module_vec_get (emacs_env *env, 640static emacs_value
738 emacs_value vec, 641module_vec_get (emacs_env *env, emacs_value vec, size_t i)
739 size_t i)
740{ 642{
741 /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits */ 643 /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */
742 verify (PTRDIFF_MAX <= SIZE_MAX); 644 verify (PTRDIFF_MAX <= SIZE_MAX);
743 check_main_thread (); 645 check_main_thread ();
744 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 646 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -753,7 +655,7 @@ static emacs_value module_vec_get (emacs_env *env,
753 module_wrong_type (env, Qvectorp, lvec); 655 module_wrong_type (env, Qvectorp, lvec);
754 return NULL; 656 return NULL;
755 } 657 }
756 /* Prevent error-prone comparison between types of different signedness. */ 658 /* Prevent error-prone comparison between types of different signedness. */
757 const size_t size = ASIZE (lvec); 659 const size_t size = ASIZE (lvec);
758 eassert (size >= 0); 660 eassert (size >= 0);
759 if (i >= size) 661 if (i >= size)
@@ -766,10 +668,10 @@ static emacs_value module_vec_get (emacs_env *env,
766 return lisp_to_value (env, AREF (lvec, i)); 668 return lisp_to_value (env, AREF (lvec, i));
767} 669}
768 670
769static size_t module_vec_size (emacs_env *env, 671static size_t
770 emacs_value vec) 672module_vec_size (emacs_env *env, emacs_value vec)
771{ 673{
772 /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits */ 674 /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits. */
773 verify (PTRDIFF_MAX <= SIZE_MAX); 675 verify (PTRDIFF_MAX <= SIZE_MAX);
774 check_main_thread (); 676 check_main_thread ();
775 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 677 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -784,7 +686,7 @@ static size_t module_vec_size (emacs_env *env,
784} 686}
785 687
786 688
787/* Subroutines */ 689/* Subroutines. */
788 690
789DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, 691DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
790 doc: /* Load module FILE. */) 692 doc: /* Load module FILE. */)
@@ -836,28 +738,30 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
836DEFUN ("module-call", Fmodule_call, Smodule_call, 2, 2, 0, 738DEFUN ("module-call", Fmodule_call, Smodule_call, 2, 2, 0,
837 doc: /* Internal function to call a module function. 739 doc: /* Internal function to call a module function.
838ENVOBJ is a save pointer to a module_fun_env structure. 740ENVOBJ is a save pointer to a module_fun_env structure.
839ARGLIST is a list of arguments passed to SUBRPTR. */) 741ARGLIST is a list of arguments passed to SUBRPTR. */)
840 (Lisp_Object envobj, Lisp_Object arglist) 742 (Lisp_Object envobj, Lisp_Object arglist)
841{ 743{
842 const struct module_fun_env *const envptr = 744 const struct module_fun_env *const envptr = XSAVE_POINTER (envobj, 0);
843 (const struct module_fun_env *) XSAVE_POINTER (envobj, 0);
844 const EMACS_INT len = XINT (Flength (arglist)); 745 const EMACS_INT len = XINT (Flength (arglist));
845 eassert (len >= 0); 746 eassert (len >= 0);
846 if (len > MOST_POSITIVE_FIXNUM) 747 if (len > MOST_POSITIVE_FIXNUM)
847 xsignal0 (Qoverflow_error); 748 xsignal0 (Qoverflow_error);
848 if (len > INT_MAX || len < envptr->min_arity || (envptr->max_arity >= 0 && len > envptr->max_arity)) 749 if (len > INT_MAX || len < envptr->min_arity
849 xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr), make_number (len)); 750 || (envptr->max_arity >= 0 && len > envptr->max_arity))
751 xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr),
752 make_number (len));
850 753
851 struct env_storage env; 754 struct env_storage env;
852 initialize_environment (&env); 755 initialize_environment (&env);
853 756
854 emacs_value *args = xzalloc (len * sizeof (*args)); 757 emacs_value *args = xzalloc (len * sizeof *args);
855 int i; 758 int i;
856 759
857 for (i = 0; i < len; i++) 760 for (i = 0; i < len; i++)
858 { 761 {
859 args[i] = lisp_to_value (&env.pub, XCAR (arglist)); 762 args[i] = lisp_to_value (&env.pub, XCAR (arglist));
860 if (! args[i]) memory_full (sizeof *args[i]); 763 if (! args[i])
764 memory_full (sizeof *args[i]);
861 arglist = XCDR (arglist); 765 arglist = XCDR (arglist);
862 } 766 }
863 767
@@ -868,11 +772,12 @@ ARGLIST is a list of arguments passed to SUBRPTR. */)
868 { 772 {
869 case emacs_funcall_exit_return: 773 case emacs_funcall_exit_return:
870 finalize_environment (&env); 774 finalize_environment (&env);
871 if (ret == NULL) xsignal1 (Qinvalid_module_call, module_format_fun_env (envptr)); 775 if (ret == NULL)
776 xsignal1 (Qinvalid_module_call, module_format_fun_env (envptr));
872 return value_to_lisp (ret); 777 return value_to_lisp (ret);
873 case emacs_funcall_exit_signal: 778 case emacs_funcall_exit_signal:
874 { 779 {
875 const Lisp_Object symbol = value_to_lisp (&env.priv.non_local_exit_symbol); 780 Lisp_Object symbol = value_to_lisp (&env.priv.non_local_exit_symbol);
876 const Lisp_Object data = value_to_lisp (&env.priv.non_local_exit_data); 781 const Lisp_Object data = value_to_lisp (&env.priv.non_local_exit_data);
877 finalize_environment (&env); 782 finalize_environment (&env);
878 xsignal (symbol, data); 783 xsignal (symbol, data);
@@ -888,24 +793,27 @@ ARGLIST is a list of arguments passed to SUBRPTR. */)
888} 793}
889 794
890 795
891/* Helper functions */ 796/* Helper functions. */
892 797
893static void check_main_thread (void) 798static void
799check_main_thread (void)
894{ 800{
895#if defined(HAVE_THREADS_H) 801#ifdef HAVE_THREADS_H
896 eassert (thrd_equal (thdr_current (), main_thread); 802 eassert (thrd_equal (thdr_current (), main_thread));
897#elif defined(HAVE_PTHREAD) 803#elif defined HAVE_PTHREAD
898 eassert (pthread_equal (pthread_self (), main_thread)); 804 eassert (pthread_equal (pthread_self (), main_thread));
899#elif defined(WINDOWSNT) 805#elif defined WINDOWSNT
900 /* CompareObjectHandles would be perfect, but is only available in 806 /* CompareObjectHandles would be perfect, but is only available in
901 Windows 10. Also check whether the thread is still running to 807 Windows 10. Also check whether the thread is still running to
902 protect against thread identifier reuse. */ 808 protect against thread identifier reuse. */
903 eassert (GetCurrentThreadId () == main_thread_id 809 eassert (GetCurrentThreadId () == main_thread_id
904 && WaitForSingleObject (main_thread, 0) == WAIT_TIMEOUT); 810 && WaitForSingleObject (main_thread, 0) == WAIT_TIMEOUT);
905#endif 811#endif
906} 812}
907 813
908static void module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, Lisp_Object data) 814static void
815module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
816 Lisp_Object data)
909{ 817{
910 struct emacs_env_private *const p = env->private_members; 818 struct emacs_env_private *const p = env->private_members;
911 eassert (p->pending_non_local_exit == emacs_funcall_exit_return); 819 eassert (p->pending_non_local_exit == emacs_funcall_exit_return);
@@ -914,7 +822,9 @@ static void module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, Lis
914 p->non_local_exit_data.v = data; 822 p->non_local_exit_data.v = data;
915} 823}
916 824
917static void module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, Lisp_Object value) 825static void
826module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
827 Lisp_Object value)
918{ 828{
919 struct emacs_env_private *const p = env->private_members; 829 struct emacs_env_private *const p = env->private_members;
920 eassert (p->pending_non_local_exit == emacs_funcall_exit_return); 830 eassert (p->pending_non_local_exit == emacs_funcall_exit_return);
@@ -923,53 +833,77 @@ static void module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, Lisp
923 p->non_local_exit_data.v = value; 833 p->non_local_exit_data.v = value;
924} 834}
925 835
926static void module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value) 836/* Module version of `wrong_type_argument'. */
837static void
838module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value)
927{ 839{
928 module_non_local_exit_signal_1 (env, Qwrong_type_argument, list2 (predicate, value)); 840 module_non_local_exit_signal_1 (env, Qwrong_type_argument,
841 list2 (predicate, value));
929} 842}
930 843
931static void module_out_of_memory (emacs_env *env) 844/* Signal an out-of-memory condition to the caller. */
845static void
846module_out_of_memory (emacs_env *env)
932{ 847{
933 // TODO: Reimplement this so it works even if memory-signal-data has been modified. 848 /* TODO: Reimplement this so it works even if memory-signal-data has
934 module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data), XCDR (Vmemory_signal_data)); 849 been modified. */
850 module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data),
851 XCDR (Vmemory_signal_data));
935} 852}
936 853
937static void module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2) 854/* Signal arguments are out of range. */
855static void
856module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
938{ 857{
939 module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2)); 858 module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2));
940} 859}
941 860
942 861
943/* Value conversion */ 862/* Value conversion. */
944 863
945static Lisp_Object value_to_lisp (emacs_value v) 864/* Convert an `emacs_value' to the corresponding internal object.
865 Never fails. */
866static Lisp_Object
867value_to_lisp (emacs_value v)
946{ 868{
947 return v->v; 869 return v->v;
948} 870}
949 871
950static emacs_value lisp_to_value (emacs_env *env, Lisp_Object o) 872/* Convert an internal object to an `emacs_value'. Allocate storage
873 from the environment; return NULL if allocation fails. */
874static emacs_value
875lisp_to_value (emacs_env *env, Lisp_Object o)
951{ 876{
952 struct emacs_env_private *const p = env->private_members; 877 struct emacs_env_private *const p = env->private_members;
953 if (p->pending_non_local_exit != emacs_funcall_exit_return) return NULL; 878 if (p->pending_non_local_exit != emacs_funcall_exit_return)
879 return NULL;
954 return allocate_emacs_value (env, &p->storage, o); 880 return allocate_emacs_value (env, &p->storage, o);
955} 881}
956 882
957 883
958/* Memory management */ 884/* Memory management. */
959 885
960static void initialize_frame (struct emacs_value_frame *frame) 886/* Must be called for each frame before it can be used for allocation. */
887static void
888initialize_frame (struct emacs_value_frame *frame)
961{ 889{
962 frame->offset = 0; 890 frame->offset = 0;
963 frame->next = NULL; 891 frame->next = NULL;
964} 892}
965 893
966static void initialize_storage (struct emacs_value_storage *storage) 894/* Must be called for any storage object before it can be used for
895 allocation. */
896static void
897initialize_storage (struct emacs_value_storage *storage)
967{ 898{
968 initialize_frame (&storage->initial); 899 initialize_frame (&storage->initial);
969 storage->current = &storage->initial; 900 storage->current = &storage->initial;
970} 901}
971 902
972static void finalize_storage (struct emacs_value_storage *storage) 903/* Must be called for any initialized storage object before its
904 lifetime ends. Free all dynamically-allocated frames. */
905static void
906finalize_storage (struct emacs_value_storage *storage)
973{ 907{
974 struct emacs_value_frame *next = storage->initial.next; 908 struct emacs_value_frame *next = storage->initial.next;
975 while (next != NULL) 909 while (next != NULL)
@@ -980,8 +914,11 @@ static void finalize_storage (struct emacs_value_storage *storage)
980 } 914 }
981} 915}
982 916
983static emacs_value allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, 917/* Allocate a new value from STORAGE and stores OBJ in it. Return
984 Lisp_Object obj) 918 NULL if allocations fails and use ENV for non local exit reporting. */
919static emacs_value
920allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage,
921 Lisp_Object obj)
985{ 922{
986 eassert (storage->current); 923 eassert (storage->current);
987 eassert (storage->current->offset < value_frame_size); 924 eassert (storage->current->offset < value_frame_size);
@@ -1004,46 +941,50 @@ static emacs_value allocate_emacs_value (emacs_env *env, struct emacs_value_stor
1004} 941}
1005 942
1006/* Mark all objects allocated from local environments so that they 943/* Mark all objects allocated from local environments so that they
1007 don't get garbage-collected. */ 944 don't get garbage-collected. */
1008void mark_modules (void) 945void mark_modules (void)
1009{ 946{
1010 for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) 947 for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem))
1011 { 948 {
1012 const struct env_storage *const env = XSAVE_POINTER (tem, 0); 949 const struct env_storage *const env = XSAVE_POINTER (tem, 0);
1013 for (const struct emacs_value_frame *frame = &env->priv.storage.initial; frame != NULL; frame = frame->next) 950 for (const struct emacs_value_frame *frame = &env->priv.storage.initial;
951 frame != NULL;
952 frame = frame->next)
1014 for (size_t i = 0; i < frame->offset; ++i) 953 for (size_t i = 0; i < frame->offset; ++i)
1015 mark_object (frame->objects[i].v); 954 mark_object (frame->objects[i].v);
1016 } 955 }
1017} 956}
1018 957
1019 958
1020/* Environment lifetime management */ 959/* Environment lifetime management. */
1021 960
1022static void initialize_environment (struct env_storage *env) 961/* Must be called before the environment can be used. */
962static void
963initialize_environment (struct env_storage *env)
1023{ 964{
1024 env->priv.pending_non_local_exit = emacs_funcall_exit_return; 965 env->priv.pending_non_local_exit = emacs_funcall_exit_return;
1025 initialize_storage (&env->priv.storage); 966 initialize_storage (&env->priv.storage);
1026 env->pub.size = sizeof env->pub; 967 env->pub.size = sizeof env->pub;
1027 env->pub.private_members = &env->priv; 968 env->pub.private_members = &env->priv;
1028 env->pub.make_global_ref = module_make_global_ref; 969 env->pub.make_global_ref = module_make_global_ref;
1029 env->pub.free_global_ref = module_free_global_ref; 970 env->pub.free_global_ref = module_free_global_ref;
1030 env->pub.non_local_exit_check = module_non_local_exit_check; 971 env->pub.non_local_exit_check = module_non_local_exit_check;
1031 env->pub.non_local_exit_clear = module_non_local_exit_clear; 972 env->pub.non_local_exit_clear = module_non_local_exit_clear;
1032 env->pub.non_local_exit_get = module_non_local_exit_get; 973 env->pub.non_local_exit_get = module_non_local_exit_get;
1033 env->pub.non_local_exit_signal = module_non_local_exit_signal; 974 env->pub.non_local_exit_signal = module_non_local_exit_signal;
1034 env->pub.non_local_exit_throw = module_non_local_exit_throw; 975 env->pub.non_local_exit_throw = module_non_local_exit_throw;
1035 env->pub.make_function = module_make_function; 976 env->pub.make_function = module_make_function;
1036 env->pub.funcall = module_funcall; 977 env->pub.funcall = module_funcall;
1037 env->pub.intern = module_intern; 978 env->pub.intern = module_intern;
1038 env->pub.type_of = module_type_of; 979 env->pub.type_of = module_type_of;
1039 env->pub.is_not_nil = module_is_not_nil; 980 env->pub.is_not_nil = module_is_not_nil;
1040 env->pub.eq = module_eq; 981 env->pub.eq = module_eq;
1041 env->pub.extract_integer = module_extract_integer; 982 env->pub.extract_integer = module_extract_integer;
1042 env->pub.make_integer = module_make_integer; 983 env->pub.make_integer = module_make_integer;
1043 env->pub.extract_float = module_extract_float; 984 env->pub.extract_float = module_extract_float;
1044 env->pub.make_float = module_make_float; 985 env->pub.make_float = module_make_float;
1045 env->pub.copy_string_contents = module_copy_string_contents; 986 env->pub.copy_string_contents = module_copy_string_contents;
1046 env->pub.make_string = module_make_string; 987 env->pub.make_string = module_make_string;
1047 env->pub.make_user_ptr = module_make_user_ptr; 988 env->pub.make_user_ptr = module_make_user_ptr;
1048 env->pub.get_user_ptr = module_get_user_ptr; 989 env->pub.get_user_ptr = module_get_user_ptr;
1049 env->pub.set_user_ptr = module_set_user_ptr; 990 env->pub.set_user_ptr = module_set_user_ptr;
@@ -1055,36 +996,53 @@ static void initialize_environment (struct env_storage *env)
1055 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments); 996 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
1056} 997}
1057 998
1058static void finalize_environment (struct env_storage *env) 999/* Must be called before the lifetime of the environment object
1000 ends. */
1001static void
1002finalize_environment (struct env_storage *env)
1059{ 1003{
1060 finalize_storage (&env->priv.storage); 1004 finalize_storage (&env->priv.storage);
1061 Vmodule_environments = XCDR (Vmodule_environments); 1005 Vmodule_environments = XCDR (Vmodule_environments);
1062} 1006}
1063 1007
1064 1008
1065/* Non-local exit handling */ 1009/* Non-local exit handling. */
1066 1010
1067static void module_reset_handlerlist(const int *dummy) 1011/* Must be called after setting up a handler immediately before
1012 returning from the function. See the comments in lisp.h and the
1013 code in eval.c for details. The macros below arrange for this
1014 function to be called automatically. DUMMY is ignored. */
1015static void
1016module_reset_handlerlist (const int *dummy)
1068{ 1017{
1069 handlerlist = handlerlist->next; 1018 handlerlist = handlerlist->next;
1070} 1019}
1071 1020
1072static void module_handle_signal (emacs_env *const env, const Lisp_Object err) 1021/* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets
1022 stored in the environment. Set the pending non-local exit flag. */
1023static void
1024module_handle_signal (emacs_env *const env, const Lisp_Object err)
1073{ 1025{
1074 module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err)); 1026 module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err));
1075} 1027}
1076 1028
1077static void module_handle_throw (emacs_env *const env, const Lisp_Object tag_val) 1029/* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets
1030 stored in the environment. Set the pending non-local exit flag. */
1031static void
1032module_handle_throw (emacs_env *const env, const Lisp_Object tag_val)
1078{ 1033{
1079 module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val)); 1034 module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val));
1080} 1035}
1081 1036
1082 1037
1083/* Function environments */ 1038/* Function environments. */
1084 1039
1085static Lisp_Object module_format_fun_env (const struct module_fun_env *const env) 1040/* Return a string object that contains a user-friendly
1041 representation of the function environment. */
1042static Lisp_Object
1043module_format_fun_env (const struct module_fun_env *const env)
1086{ 1044{
1087 /* Try to print a function name if possible. */ 1045 /* Try to print a function name if possible. */
1088 const char *path, *sym; 1046 const char *path, *sym;
1089 if (dynlib_addr (env->subr, &path, &sym)) 1047 if (dynlib_addr (env->subr, &path, &sym))
1090 { 1048 {
@@ -1108,26 +1066,28 @@ static Lisp_Object module_format_fun_env (const struct module_fun_env *const env
1108} 1066}
1109 1067
1110 1068
1111/* Segment initializer */ 1069/* Segment initializer. */
1112 1070
1113void syms_of_module (void) 1071void
1072syms_of_module (void)
1114{ 1073{
1115 DEFSYM (Qmodule_refs_hash, "module-refs-hash"); 1074 DEFSYM (Qmodule_refs_hash, "module-refs-hash");
1116 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, 1075 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash,
1117 doc: /* Module global referrence table. */); 1076 doc: /* Module global referrence table. */);
1118 1077
1119 Vmodule_refs_hash = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), 1078 Vmodule_refs_hash
1120 make_float (DEFAULT_REHASH_SIZE), 1079 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
1121 make_float (DEFAULT_REHASH_THRESHOLD), 1080 make_float (DEFAULT_REHASH_SIZE),
1122 Qnil); 1081 make_float (DEFAULT_REHASH_THRESHOLD),
1082 Qnil);
1123 Funintern (Qmodule_refs_hash, Qnil); 1083 Funintern (Qmodule_refs_hash, Qnil);
1124 1084
1125 DEFSYM (Qmodule_environments, "module-environments"); 1085 DEFSYM (Qmodule_environments, "module-environments");
1126 DEFVAR_LISP ("module-environments", Vmodule_environments, 1086 DEFVAR_LISP ("module-environments", Vmodule_environments,
1127 doc: /* List of active module environments. */); 1087 doc: /* List of active module environments. */);
1128 Vmodule_environments = Qnil; 1088 Vmodule_environments = Qnil;
1129 /* Unintern `module-environments' because it is only used 1089 /* Unintern `module-environments' because it is only used
1130 internally. */ 1090 internally. */
1131 Funintern (Qmodule_environments, Qnil); 1091 Funintern (Qmodule_environments, Qnil);
1132 1092
1133 DEFSYM (Qmodule_load_failed, "module-load-failed"); 1093 DEFSYM (Qmodule_load_failed, "module-load-failed");
@@ -1151,7 +1111,7 @@ void syms_of_module (void)
1151 initialize_storage (&global_storage); 1111 initialize_storage (&global_storage);
1152 1112
1153 /* Unintern `module-refs-hash' because it is internal-only and Lisp 1113 /* Unintern `module-refs-hash' because it is internal-only and Lisp
1154 code or modules should not access it. */ 1114 code or modules should not access it. */
1155 Funintern (Qmodule_refs_hash, Qnil); 1115 Funintern (Qmodule_refs_hash, Qnil);
1156 1116
1157 defsubr (&Smodule_load); 1117 defsubr (&Smodule_load);
@@ -1159,39 +1119,40 @@ void syms_of_module (void)
1159 /* Don't call defsubr on `module-call' because that would intern it, 1119 /* Don't call defsubr on `module-call' because that would intern it,
1160 but `module-call' is an internal function that users cannot 1120 but `module-call' is an internal function that users cannot
1161 meaningfully use. Instead, assign its definition to a private 1121 meaningfully use. Instead, assign its definition to a private
1162 variable. */ 1122 variable. */
1163 XSETPVECTYPE (&Smodule_call, PVEC_SUBR); 1123 XSETPVECTYPE (&Smodule_call, PVEC_SUBR);
1164 XSETSUBR (module_call_func, &Smodule_call); 1124 XSETSUBR (module_call_func, &Smodule_call);
1165} 1125}
1166 1126
1167/* Unlike syms_of_module, this initializer is called even from an 1127/* Unlike syms_of_module, this initializer is called even from an
1168 * initialized (dumped) Emacs. */ 1128 initialized (dumped) Emacs. */
1169 1129
1170void module_init (void) 1130void
1131module_init (void)
1171{ 1132{
1172 /* It is not guaranteed that dynamic initializers run in the main thread, 1133 /* It is not guaranteed that dynamic initializers run in the main thread,
1173 therefore we detect the main thread here. */ 1134 therefore detect the main thread here. */
1174#if defined(HAVE_THREADS_H) 1135#ifdef HAVE_THREADS_H
1175 main_thread = thrd_current (); 1136 main_thread = thrd_current ();
1176#elif defined(HAVE_PTHREAD) 1137#elif defined HAVE_PTHREAD
1177 main_thread = pthread_self (); 1138 main_thread = pthread_self ();
1178#elif defined(WINDOWSNT) 1139#elif defined WINDOWSNT
1179 /* This calls APIs that are only available on Vista and later. */ 1140 /* This calls APIs that are only available on Vista and later. */
1180#if 0 1141# if false
1181 /* GetCurrentProcess returns a pseudohandle, which we have to duplicate. */ 1142 /* GetCurrentProcess returns a pseudohandle, which must be duplicated. */
1182 if (! DuplicateHandle (GetCurrentProcess(), GetCurrentThread(), 1143 if (! DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
1183 GetCurrentProcess(), &main_thread, 1144 GetCurrentProcess (), &main_thread,
1184 SYNCHRONIZE | THREAD_QUERY_INFORMATION, 1145 SYNCHRONIZE | THREAD_QUERY_INFORMATION,
1185 FALSE, 0)) 1146 FALSE, 0))
1186 emacs_abort (); 1147 emacs_abort ();
1187#else 1148# else
1188 /* GetCurrentThread returns a pseudohandle, which we have to duplicate. */ 1149 /* GetCurrentThread returns a pseudohandle, which must be duplicated. */
1189 HANDLE th = GetCurrentThread (); 1150 HANDLE th = GetCurrentThread ();
1190 if (!DuplicateHandle (GetCurrentProcess (), th, 1151 if (!DuplicateHandle (GetCurrentProcess (), th,
1191 GetCurrentProcess (), &main_thread, 0, FALSE, 1152 GetCurrentProcess (), &main_thread, 0, FALSE,
1192 DUPLICATE_SAME_ACCESS)) 1153 DUPLICATE_SAME_ACCESS))
1193 emacs_abort (); 1154 emacs_abort ();
1194 main_thread_id = GetCurrentThreadId (); 1155 main_thread_id = GetCurrentThreadId ();
1195#endif 1156# endif
1196#endif 1157#endif
1197} 1158}
diff --git a/src/module.h b/src/module.h
index 9f43c898af4..d4fad9d32a0 100644
--- a/src/module.h
+++ b/src/module.h
@@ -24,206 +24,179 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24#include <stdlib.h> 24#include <stdlib.h>
25#include <stdbool.h> 25#include <stdbool.h>
26 26
27#ifdef __cplusplus 27#if defined __cplusplus && __cplusplus >= 201103L
28#define EMACS_EXTERN_C_BEGIN extern "C" { 28# define EMACS_NOEXCEPT noexcept
29#define EMACS_EXTERN_C_END }
30#else 29#else
31#define EMACS_EXTERN_C_BEGIN 30# define EMACS_NOEXCEPT
32#define EMACS_EXTERN_C_END
33#endif 31#endif
34 32
35#if defined(__cplusplus) && __cplusplus >= 201103L 33#ifdef __cplusplus
36#define EMACS_NOEXCEPT noexcept 34extern "C" {
37#else
38#define EMACS_NOEXCEPT
39#endif 35#endif
40 36
41EMACS_EXTERN_C_BEGIN 37/* Current environment. */
42
43/* Current environement */
44typedef struct emacs_env_25 emacs_env; 38typedef struct emacs_env_25 emacs_env;
45 39
46/* Opaque structure pointer representing an Emacs Lisp value */ 40/* Opaque structure pointer representing an Emacs Lisp value. */
47typedef struct emacs_value_tag* emacs_value; 41typedef struct emacs_value_tag *emacs_value;
48 42
49enum emacs_arity { 43enum emacs_arity { emacs_variadic_function = -2 };
50 emacs_variadic_function = -2
51};
52 44
53/* Struct passed to a module init function (emacs_module_init) */ 45/* Struct passed to a module init function (emacs_module_init). */
54struct emacs_runtime { 46struct emacs_runtime
55 /* Structure size (for version checking) */ 47{
48 /* Structure size (for version checking). */
56 size_t size; 49 size_t size;
57 50
58 /* Private data; users should not touch this */ 51 /* Private data; users should not touch this. */
59 struct emacs_runtime_private *private_members; 52 struct emacs_runtime_private *private_members;
60 53
61 /* Returns an environment pointer. */ 54 /* Return an environment pointer. */
62 emacs_env* (*get_environment)(struct emacs_runtime *ert); 55 emacs_env *(*get_environment) (struct emacs_runtime *ert);
63}; 56};
64 57
65 58
66/* Function prototype for the module init function */ 59/* Function prototype for the module init function. */
67typedef int (*emacs_init_function)(struct emacs_runtime *ert); 60typedef int (*emacs_init_function) (struct emacs_runtime *ert);
68 61
69/* Function prototype for the module Lisp functions */ 62/* Function prototype for the module Lisp functions. */
70typedef emacs_value (*emacs_subr)(emacs_env *env, 63typedef emacs_value (*emacs_subr) (emacs_env *env, int nargs, emacs_value args[],
71 int nargs, 64 void *data);
72 emacs_value args[],
73 void *data);
74 65
75/* Function prototype for module user-pointer finalizers */ 66/* Function prototype for module user-pointer finalizers. */
76typedef void (*emacs_finalizer_function)(void*); 67typedef void (*emacs_finalizer_function) (void *);
77 68
78/* Possible Emacs function call outcomes. */ 69/* Possible Emacs function call outcomes. */
79enum emacs_funcall_exit { 70enum emacs_funcall_exit
80 /* Function has returned normally. */ 71{
72 /* Function has returned normally. */
81 emacs_funcall_exit_return = 0, 73 emacs_funcall_exit_return = 0,
82 /* Function has signaled an error using `signal'. */ 74
75 /* Function has signaled an error using `signal'. */
83 emacs_funcall_exit_signal = 1, 76 emacs_funcall_exit_signal = 1,
84 /* Function has exit using `throw'. */ 77
78 /* Function has exit using `throw'. */
85 emacs_funcall_exit_throw = 2, 79 emacs_funcall_exit_throw = 2,
86}; 80};
87 81
88struct emacs_env_25 { 82struct emacs_env_25
89 /* 83{
90 * Structure size (for version checking) 84 /* Structure size (for version checking). */
91 */
92
93 size_t size; 85 size_t size;
94 86
95 /* Private data; users should not touch this */ 87 /* Private data; users should not touch this. */
96 struct emacs_env_private *private_members; 88 struct emacs_env_private *private_members;
97 89
98 /* 90 /* Memory management. */
99 * Memory management 91
100 */ 92 emacs_value (*make_global_ref) (emacs_env *env,
93 emacs_value any_reference);
94
95 void (*free_global_ref) (emacs_env *env,
96 emacs_value global_reference);
97
98 /* Non-local exit handling. */
99
100 enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env);
101
102 void (*non_local_exit_clear) (emacs_env *env);
103
104 enum emacs_funcall_exit (*non_local_exit_get)
105 (emacs_env *env,
106 emacs_value *non_local_exit_symbol_out,
107 emacs_value *non_local_exit_data_out);
108
109 void (*non_local_exit_signal) (emacs_env *env,
110 emacs_value non_local_exit_symbol,
111 emacs_value non_local_exit_data);
112
113 void (*non_local_exit_throw) (emacs_env *env,
114 emacs_value tag,
115 emacs_value value);
116
117 /* Function registration. */
118
119 emacs_value (*make_function) (emacs_env *env,
120 int min_arity,
121 int max_arity,
122 emacs_value (*function) (emacs_env *, int,
123 emacs_value *, void *)
124 EMACS_NOEXCEPT,
125 const char *documentation,
126 void *data);
101 127
128 emacs_value (*funcall) (emacs_env *env,
129 emacs_value function,
130 int nargs,
131 emacs_value args[]);
102 132
103 emacs_value (*make_global_ref)(emacs_env *env, 133 emacs_value (*intern) (emacs_env *env,
104 emacs_value any_reference); 134 const char *symbol_name);
105 135
106 void (*free_global_ref)(emacs_env *env, 136 /* Type conversion. */
107 emacs_value global_reference);
108 137
109 /* 138 emacs_value (*type_of) (emacs_env *env,
110 * Non-local exit handling 139 emacs_value value);
111 */
112 140
113 enum emacs_funcall_exit (*non_local_exit_check)(emacs_env *env); 141 bool (*is_not_nil) (emacs_env *env, emacs_value value);
114 142
115 void (*non_local_exit_clear)(emacs_env *env); 143 bool (*eq) (emacs_env *env, emacs_value a, emacs_value b);
116 144
117 enum emacs_funcall_exit (*non_local_exit_get)(emacs_env *env, 145 int_fast64_t (*extract_integer) (emacs_env *env,
118 emacs_value *non_local_exit_symbol_out, 146 emacs_value value);
119 emacs_value *non_local_exit_data_out); 147
120 148 emacs_value (*make_integer) (emacs_env *env, int_fast64_t value);
121 void (*non_local_exit_signal)(emacs_env *env, 149
122 emacs_value non_local_exit_symbol, 150 double (*extract_float) (emacs_env *env, emacs_value value);
123 emacs_value non_local_exit_data); 151
124 152 emacs_value (*make_float) (emacs_env *env, double value);
125 void (*non_local_exit_throw)(emacs_env *env, 153
126 emacs_value tag, 154 /* Copy the content of the Lisp string VALUE to BUFFER as an utf8
127 emacs_value value); 155 null-terminated string.
128 156
129 /* 157 SIZE must point to the total size of the buffer. If BUFFER is
130 * Function registration 158 NULL or if SIZE is not big enough, write the required buffer size
131 */ 159 to SIZE and return false.
132 160
133 emacs_value (*make_function)(emacs_env *env, 161 Note that SIZE must include the last null byte (e.g. "abc" needs
134 int min_arity, 162 a buffer of size 4).
135 int max_arity, 163
136 emacs_value (*function)(emacs_env*, int, emacs_value*, void*) EMACS_NOEXCEPT, 164 Return true if the string was successfully copied. */
137 const char *documentation, 165
138 void *data); 166 bool (*copy_string_contents) (emacs_env *env,
139 167 emacs_value value,
140 emacs_value (*funcall)(emacs_env *env, 168 char *buffer,
141 emacs_value function, 169 size_t *size_inout);
142 int nargs, 170
143 emacs_value args[]); 171 /* Create a Lisp string from a utf8 encoded string. */
144 172 emacs_value (*make_string) (emacs_env *env,
145 emacs_value (*intern)(emacs_env *env, 173 const char *contents, size_t length);
146 const char *symbol_name); 174
147 175 /* Embedded pointer type. */
148 /* 176 emacs_value (*make_user_ptr) (emacs_env *env,
149 * Type conversion 177 void (*fin) (void *) EMACS_NOEXCEPT,
150 */ 178 void *ptr);
151 179
152 emacs_value (*type_of)(emacs_env *env, 180 void *(*get_user_ptr) (emacs_env *env, emacs_value uptr);
153 emacs_value value); 181 void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr);
154 182
155 bool (*is_not_nil)(emacs_env *env, emacs_value value); 183 void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr))
156 184 (void *) EMACS_NOEXCEPT;
157 bool (*eq)(emacs_env *env, emacs_value a, emacs_value b); 185 void (*set_user_finalizer) (emacs_env *env,
158 186 emacs_value uptr,
159 int64_t (*extract_integer)(emacs_env *env, 187 void (*fin) (void *) EMACS_NOEXCEPT);
160 emacs_value value); 188
161 189 /* Vector functions. */
162 emacs_value (*make_integer)(emacs_env *env, 190 emacs_value (*vec_get) (emacs_env *env, emacs_value vec, size_t i);
163 int64_t value); 191
164 192 void (*vec_set) (emacs_env *env, emacs_value vec, size_t i,
165 double (*extract_float)(emacs_env *env,
166 emacs_value value);
167
168 emacs_value (*make_float)(emacs_env *env,
169 double value);
170
171 /*
172 * Copy the content of the lisp string VALUE to BUFFER as an utf8
173 * null-terminated string.
174 *
175 * SIZE must point to the total size of the buffer. If BUFFER is
176 * NULL or if SIZE is not big enough, write the required buffer size
177 * to SIZE and return false.
178 *
179 * Note that SIZE must include the last null byte (e.g. "abc" needs
180 * a buffer of size 4).
181 *
182 * Returns true if the string was successfully copied.
183 */
184
185 bool (*copy_string_contents)(emacs_env *env,
186 emacs_value value,
187 char *buffer,
188 size_t *size_inout);
189
190 /*
191 * Create a lisp string from a utf8 encoded string.
192 */
193 emacs_value (*make_string)(emacs_env *env,
194 const char *contents, size_t length);
195
196 /*
197 * Embedded pointer type
198 */
199 emacs_value (*make_user_ptr)(emacs_env *env,
200 void (*fin)(void *) EMACS_NOEXCEPT,
201 void *ptr);
202
203 void* (*get_user_ptr)(emacs_env *env, emacs_value uptr);
204 void (*set_user_ptr)(emacs_env *env, emacs_value uptr, void *ptr);
205
206 void (*(*get_user_finalizer)(emacs_env *env, emacs_value uptr))(void *) EMACS_NOEXCEPT;
207 void (*set_user_finalizer)(emacs_env *env,
208 emacs_value uptr,
209 void (*fin)(void *) EMACS_NOEXCEPT);
210
211 /*
212 * Vector functions
213 */
214 emacs_value (*vec_get) (emacs_env *env,
215 emacs_value vec,
216 size_t i);
217
218 void (*vec_set) (emacs_env *env,
219 emacs_value vec,
220 size_t i,
221 emacs_value val); 193 emacs_value val);
222 194
223 size_t (*vec_size) (emacs_env *env, 195 size_t (*vec_size) (emacs_env *env, emacs_value vec);
224 emacs_value vec);
225}; 196};
226 197
227EMACS_EXTERN_C_END 198#ifdef __cplusplus
199}
200#endif
228 201
229#endif /* EMACS_MODULE_H */ 202#endif /* EMACS_MODULE_H */