aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.in4
-rw-r--r--src/emacs.c3
-rw-r--r--src/emacs_module.h175
-rw-r--r--src/lisp.h2
-rw-r--r--src/module.c435
5 files changed, 617 insertions, 2 deletions
diff --git a/src/Makefile.in b/src/Makefile.in
index 172fa8e47cd..c212c48bc5b 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -376,7 +376,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
376 minibuf.o fileio.o dired.o \ 376 minibuf.o fileio.o dired.o \
377 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ 377 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
378 alloc.o data.o doc.o editfns.o callint.o \ 378 alloc.o data.o doc.o editfns.o callint.o \
379 eval.o floatfns.o fns.o font.o print.o lread.o \ 379 eval.o floatfns.o fns.o font.o print.o lread.o module.o \
380 syntax.o $(UNEXEC_OBJ) bytecode.o \ 380 syntax.o $(UNEXEC_OBJ) bytecode.o \
381 process.o gnutls.o callproc.o \ 381 process.o gnutls.o callproc.o \
382 region-cache.o sound.o atimer.o \ 382 region-cache.o sound.o atimer.o \
@@ -467,7 +467,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
467 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ 467 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
468 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ 468 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
469 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ 469 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
470 $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) 470 $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) -lltdl
471 471
472$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) 472$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
473 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" 473 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
diff --git a/src/emacs.c b/src/emacs.c
index 8396f5d4e45..b9e748b364c 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1432,6 +1432,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1432 syms_of_terminal (); 1432 syms_of_terminal ();
1433 syms_of_term (); 1433 syms_of_term ();
1434 syms_of_undo (); 1434 syms_of_undo ();
1435
1436 syms_of_module ();
1437
1435#ifdef HAVE_SOUND 1438#ifdef HAVE_SOUND
1436 syms_of_sound (); 1439 syms_of_sound ();
1437#endif 1440#endif
diff --git a/src/emacs_module.h b/src/emacs_module.h
new file mode 100644
index 00000000000..2dbb2a2f5ce
--- /dev/null
+++ b/src/emacs_module.h
@@ -0,0 +1,175 @@
1/*
2 emacs_module.h - Module API
3 Copyright (C) 2015 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19*/
20
21#ifndef EMACS_MODULE_H
22#define EMACS_MODULE_H
23
24#include <stdint.h>
25#include <stdlib.h>
26#include <stdbool.h>
27
28/* Current environment */
29typedef struct emacs_env_25 emacs_env;
30
31/* The size of emacs_value must match EMACS_INT:
32 32 bit system: 32 bits
33 32 bit system with --with-wide-int: 64 bits
34 64 bit system: 64 bits.
35
36 When compiling modules, define the macro EMACS_VALUE_TYPE by the
37 result of `module-emacs_value-type'. */
38typedef EMACS_VALUE_TYPE emacs_value;
39
40/* Struct passed to a module init function (emacs_module_init) */
41struct emacs_runtime {
42 size_t size;
43 emacs_env* (*get_environment)(struct emacs_runtime *ert);
44};
45
46
47/* Function prototype for the module init function */
48typedef int (*emacs_init_function)(struct emacs_runtime *ert);
49
50/* Function prototype for the module Lisp functions */
51typedef emacs_value (*emacs_subr)(emacs_env *env,
52 int nargs,
53 emacs_value args[]);
54struct emacs_env_25 {
55 /*
56 * Structure size (for version checking)
57 */
58
59 size_t size;
60
61 /*
62 * Constants
63 */
64 emacs_value Qt_value;
65 emacs_value Qnil_value;
66
67 /*
68 * Memory management
69 */
70
71 emacs_value (*make_global_reference)(emacs_env *env,
72 emacs_value any_reference);
73
74 void (*free_global_reference)(emacs_env *env,
75 emacs_value global_reference);
76
77 /*
78 * Error handling
79 */
80
81 bool (*error_check)(emacs_env *env);
82
83 void (*clear_error)(emacs_env *env);
84
85 bool (*get_error)(emacs_env *env,
86 emacs_value *error_symbol_out,
87 emacs_value *error_data_out);
88
89 void (*signal_error)(emacs_env *env,
90 const char* msg,
91 emacs_value error_data);
92
93 /*
94 * Function registration
95 */
96
97 emacs_value (*make_function)(emacs_env *env,
98 int min_arity,
99 int max_arity,
100 emacs_subr function);
101
102 emacs_value (*funcall)(emacs_env *env,
103 emacs_value function,
104 int nargs,
105 emacs_value args[]);
106
107 emacs_value (*intern)(emacs_env *env,
108 const char *symbol_name);
109
110 emacs_value (*intern_soft)(emacs_env *env,
111 const char *symbol_name);
112
113 void (*bind_function) (emacs_env *env,
114 const char *name,
115 emacs_value definition);
116
117 /*
118 * Type conversion
119 */
120
121 emacs_value (*type_of)(emacs_env *env,
122 emacs_value value);
123
124 int64_t (*fixnum_to_int)(emacs_env *env,
125 emacs_value value);
126
127 emacs_value (*make_fixnum)(emacs_env *env,
128 int64_t value);
129
130 double (*float_to_c_double)(emacs_env *env,
131 emacs_value value);
132
133 emacs_value (*make_float)(emacs_env *env,
134 double value);
135
136 bool (*copy_string_contents)(emacs_env *env,
137 emacs_value value,
138 char *buffer,
139 size_t* length_inout);
140
141 size_t (*buffer_byte_length)(emacs_env *env,
142 emacs_value start,
143 emacs_value end);
144 /* Return the size in bytes of the buffer substring in the current
145 buffer from START to END */
146
147 void (*copy_buffer_substring)(emacs_env *env,
148 emacs_value start,
149 emacs_value end,
150 char *buffer,
151 size_t* length_inout);
152 /* Copy buffer string from current buffer, BEG to END (integers or
153 markers), to BUFFER. On call, LENGTH_INOUT is the size in bytes
154 of BUFFER; on return, it is the size in bytes of the copied
155 string.
156
157 If BUFFER is too small, signals an error. Use buffer_byte_length
158 to ensure BUFFER is not too small. */
159
160 emacs_value (*make_string)(emacs_env *env,
161 const char *contents);
162
163 /*
164 * miscellaneous
165 */
166
167 void (*message)(emacs_env *env,
168 emacs_value msg);
169 /* msg must be already formatted */
170
171 emacs_value (*symbol_value)(emacs_env *env,
172 emacs_value symbol);
173};
174
175#endif /* EMACS_MODULE_H */
diff --git a/src/lisp.h b/src/lisp.h
index 198f116fe02..577105bf322 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4050,6 +4050,8 @@ Lisp_Object backtrace_top_function (void);
4050extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); 4050extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
4051extern bool let_shadows_global_binding_p (Lisp_Object symbol); 4051extern bool let_shadows_global_binding_p (Lisp_Object symbol);
4052 4052
4053/* Defined in module.c. */
4054void syms_of_module (void);
4053 4055
4054/* Defined in editfns.c. */ 4056/* Defined in editfns.c. */
4055extern void insert1 (Lisp_Object); 4057extern void insert1 (Lisp_Object);
diff --git a/src/module.c b/src/module.c
new file mode 100644
index 00000000000..d69a4b585e4
--- /dev/null
+++ b/src/module.c
@@ -0,0 +1,435 @@
1/*
2 module.c - Module loading and runtime implementation
3 Copyright (C) 2015 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19*/
20
21#include <config.h>
22#include "lisp.h"
23#include "character.h"
24#include "buffer.h"
25
26/* see comment in emacs_module.h at emacs_value for this define */
27#define EMACS_VALUE_TYPE EMACS_INT
28#include "emacs_module.h"
29
30#include <ltdl.h>
31
32/* internal functions */
33void syms_of_module (void);
34static struct emacs_runtime* module_get_runtime (void);
35static emacs_env* module_get_environment (struct emacs_runtime *ert);
36
37/* emacs_module.h emacs_env_* functions; same order as there */
38/* FIXME: make_global_reference */
39/* FIXME: free_global_reference */
40/* FIXME: error_check */
41/* FIXME: clear_error */
42/* FIXME: get_error */
43static void module_signal_error (emacs_env *env,
44 const char* msg,
45 emacs_value error_data);
46static emacs_value module_make_function (emacs_env *env,
47 int min_arity,
48 int max_arity,
49 emacs_subr subr);
50static emacs_value module_funcall (emacs_env *env,
51 emacs_value fun,
52 int nargs,
53 emacs_value args[]);
54static emacs_value module_intern (emacs_env *env,
55 const char *name);
56static emacs_value module_intern_soft (emacs_env *env,
57 const char *name);
58static void module_bind_function (emacs_env *env,
59 const char *name,
60 emacs_value definition);
61/* FIXME: type_of */
62static int64_t module_fixnum_to_int (emacs_env *env,
63 emacs_value n);
64static emacs_value module_make_fixnum (emacs_env *env,
65 int64_t n);
66/* FIXME: float_to_c_double */
67/* FIXME: make_float */
68/* FIXME: copy_string_contents */
69static size_t module_buffer_byte_length (emacs_env *env,
70 emacs_value start,
71 emacs_value end);
72
73static void module_copy_buffer_substring (emacs_env *env,
74 emacs_value start,
75 emacs_value end,
76 char *buffer,
77 size_t *length_inout);
78static emacs_value module_make_string (emacs_env *env,
79 const char *contents);
80static void module_message (emacs_env *env,
81 emacs_value msg);
82static emacs_value module_symbol_value (emacs_env *env,
83 emacs_value symbol);
84
85
86static struct emacs_runtime* module_get_runtime (void)
87{
88 /* FIXME: why do we need module_get_runtime, as opposed to just module_get_environment? */
89 struct emacs_runtime *ert = xzalloc (sizeof *ert);
90
91 ert->size = sizeof *ert;
92 ert->get_environment = module_get_environment;
93
94 return ert;
95}
96
97static emacs_env* module_get_environment (struct emacs_runtime *ert)
98{
99 /* FIXME: error if not on main emacs thread? */
100
101 emacs_env *env = xzalloc (sizeof *env);
102
103 env->size = sizeof *env;
104 env->Qt_value = (emacs_value) Qt;
105 env->Qnil_value = (emacs_value) Qnil;
106 /* FIXME: make_global_reference */
107 /* FIXME: free_global_reference */
108 /* FIXME: error_check */
109 /* FIXME: clear_error */
110 /* FIXME: get_error */
111 env->signal_error = module_signal_error;
112 env->make_function = module_make_function;
113 env->funcall = module_funcall;
114 env->intern = module_intern;
115 env->intern_soft = module_intern_soft;
116 env->bind_function = module_bind_function;
117 env->fixnum_to_int = module_fixnum_to_int;
118 env->make_fixnum = module_make_fixnum;
119 /* FIXME: copy_string_contents */
120 env->buffer_byte_length = module_buffer_byte_length;
121 env->copy_buffer_substring = module_copy_buffer_substring;
122 env->make_string = module_make_string;
123 env->message = module_message;
124 env->symbol_value = module_symbol_value;
125
126 return env;
127}
128
129static emacs_value module_make_fixnum (emacs_env *env, int64_t n)
130{
131 return (emacs_value) make_number (n);
132}
133
134static int64_t module_fixnum_to_int (emacs_env *env, emacs_value n)
135{
136 return (int64_t) XINT ((Lisp_Object) n);
137}
138
139static emacs_value module_intern (emacs_env *env, const char *name)
140{
141 return (emacs_value) intern (name);
142}
143
144static emacs_value module_intern_soft (emacs_env *env, const char *name)
145{
146 register ptrdiff_t len = strlen (name);
147 register Lisp_Object tem = oblookup (Vobarray, name, len, len);
148
149 if (INTEGERP (tem))
150 return (emacs_value) Qnil;
151 else
152 return (emacs_value) tem;
153}
154
155static void module_bind_function (emacs_env *env,
156 const char *name,
157 emacs_value definition)
158{
159 Lisp_Object symbol = intern (name);
160 set_symbol_function (symbol, (Lisp_Object) definition);
161}
162
163static void module_signal_error (emacs_env *env,
164 const char* msg,
165 emacs_value error_data)
166{
167 signal_error (msg, (Lisp_Object) (error_data));
168}
169
170static emacs_value module_make_function (emacs_env *env,
171 int min_arity,
172 int max_arity,
173 emacs_subr subr)
174{
175 /*
176 (function
177 (lambda
178 (&rest arglist)
179 (module-call
180 envptr
181 subrptr
182 arglist)))
183 */
184 /* FIXME: allow for doc string and interactive */
185 Lisp_Object Qrest = intern ("&rest");
186 Lisp_Object Qarglist = intern ("arglist");
187 Lisp_Object Qmodule_call = intern ("module-call");
188 Lisp_Object envptr = make_save_ptr ((void*) env);
189 Lisp_Object subrptr = make_save_ptr ((void*) subr);
190
191 Lisp_Object form = list2 (Qfunction,
192 list3 (Qlambda,
193 list2 (Qrest, Qarglist),
194 list4 (Qmodule_call,
195 envptr,
196 subrptr,
197 Qarglist)));
198
199 struct gcpro gcpro1;
200 GCPRO1 (Qform);
201 Lisp_Object ret = Feval (form, Qnil);
202 UNGCPRO;
203
204 return (emacs_value) ret;
205}
206
207static emacs_value module_funcall (emacs_env *env,
208 emacs_value fun,
209 int nargs,
210 emacs_value args[])
211{
212 /*
213 * Make a new Lisp_Object array starting with the function as the
214 * first arg, because that's what Ffuncall takes
215 */
216 int i;
217 Lisp_Object *newargs = xmalloc ((nargs+1) * sizeof (*newargs));
218
219 newargs[0] = (Lisp_Object) fun;
220 for (i = 0; i < nargs; i++)
221 newargs[1 + i] = (Lisp_Object) args[i];
222
223 struct gcpro gcpro1;
224 GCPRO1 (newargs[0]);
225 Lisp_Object ret = Ffuncall (nargs+1, newargs);
226 UNGCPRO;
227
228 xfree (newargs);
229 return (emacs_value) ret;
230}
231
232static size_t module_buffer_byte_length (emacs_env *env,
233 emacs_value start,
234 emacs_value end)
235{
236 Lisp_Object start_1 = (Lisp_Object)start;
237 Lisp_Object end_1 = (Lisp_Object)end;
238
239 validate_region (&start_1, &end_1);
240
241 {
242 ptrdiff_t start_byte = CHAR_TO_BYTE (XINT (start_1));
243 ptrdiff_t end_byte = CHAR_TO_BYTE (XINT (end_1));
244
245 return (size_t) end_byte - start_byte;
246 }
247}
248
249static void module_copy_buffer_substring (emacs_env *env,
250 emacs_value start,
251 emacs_value end,
252 char *buffer,
253 size_t *length_inout)
254{
255 /* Copied from editfns.c "buffer-substring-no-properties" and make_buffer_string_both */
256 Lisp_Object start_1 = (Lisp_Object)start;
257 Lisp_Object end_1 = (Lisp_Object)end;
258
259 validate_region (&start_1, &end_1);
260
261 {
262 ptrdiff_t start = XINT (start_1);
263 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
264 ptrdiff_t end = XINT (end_1);
265 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
266 ptrdiff_t beg0, end0, beg1, end1;
267 size_t size;
268
269 if (end_byte - start_byte > *length_inout)
270 {
271 /* buffer too small */
272 /* FIXME: could copy less than requested, but that's
273 complicated for multi-byte characters */
274 signal_error ("module_copy_buffer_substring: buffer too small", Qnil);
275 }
276
277 if (start_byte < GPT_BYTE && GPT_BYTE < end_byte)
278 {
279 /* Two regions, before and after the gap. */
280 beg0 = start_byte;
281 end0 = GPT_BYTE;
282 beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE;
283 end1 = end_byte + GAP_SIZE - BEG_BYTE;
284 }
285 else
286 {
287 /* One region, before the gap. */
288 beg0 = start_byte;
289 end0 = end_byte;
290 beg1 = -1;
291 end1 = -1;
292 }
293
294 size = end0 - beg0;
295
296 /* FIXME: need to decode? See external process stuff. */
297
298 /* BYTE_POS_ADDR handles one region after the gap */
299 memcpy (buffer, BYTE_POS_ADDR (beg0), size);
300 if (beg1 != -1)
301 memcpy (buffer + size, BEG_ADDR + beg1, end1 - beg1);
302 }
303}
304
305static emacs_value module_make_string (emacs_env *env, const char *contents)
306{
307 return (emacs_value) make_string (contents, strlen (contents));
308}
309
310static void module_message (emacs_env *env,
311 emacs_value msg)
312{
313 message3 ((Lisp_Object) msg);
314}
315
316static emacs_value module_symbol_value (emacs_env *env,
317 emacs_value symbol)
318{
319 Lisp_Object val= find_symbol_value ((Lisp_Object) symbol);
320 if (!EQ (val, Qunbound))
321 return (emacs_value) val;
322
323 xsignal1 (Qvoid_variable, (Lisp_Object) symbol);
324}
325
326DEFUN ("module-call", Fmodule_call, Smodule_call, 3, 3, 0,
327 doc: "Call a module function")
328 (Lisp_Object envptr, Lisp_Object subrptr, Lisp_Object arglist)
329{
330 int len = XINT (Flength (arglist));
331 emacs_value *args = xzalloc (len * sizeof (*args));
332 int i;
333
334 for (i = 0; i < len; i++)
335 {
336 args[i] = (emacs_value) XCAR (arglist);
337 arglist = XCDR (arglist);
338 }
339
340 emacs_env *env = (emacs_env*) XSAVE_POINTER (envptr, 0);
341 emacs_subr subr = (emacs_subr) XSAVE_POINTER (subrptr, 0);
342 emacs_value ret = subr (env, len, args);
343 return (Lisp_Object) ret;
344}
345
346static int lt_init_done = 0;
347
348EXFUN (Fmodule_load, 1);
349DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
350 doc: /* Load module FILE. */)
351 (Lisp_Object file)
352{
353 lt_dlhandle handle;
354 emacs_init_function module_init;
355 void *gpl_sym;
356 Lisp_Object doc_name, args[2];
357
358 /* init libtool once per emacs process */
359 if (!lt_init_done)
360 {
361 int ret = lt_dlinit ();
362 if (ret)
363 {
364 const char* s = lt_dlerror ();
365 error ("ltdl init fail: %s", s);
366 }
367 lt_init_done = 1;
368 }
369
370 /* FIXME: check for libltdl, load it if available; don't require
371 --with-ltdl at configure time. See image.c for example. */
372
373 CHECK_STRING (file);
374 handle = lt_dlopen (SDATA (file));
375 if (!handle)
376 error ("Cannot load file %s : %s", SDATA (file), lt_dlerror());
377
378 gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible");
379 if (!gpl_sym)
380 error ("Module %s is not GPL compatible", SDATA (file));
381
382 module_init = (emacs_init_function) lt_dlsym (handle, "emacs_module_init");
383 if (!module_init)
384 error ("Module %s does not have an init function.", SDATA (file));
385
386
387 int r = module_init (module_get_runtime ());
388
389 /* Errors are reported by calling env->signal_error. FIXME: so why does module_init return anything? */
390 return Qt;
391}
392
393EXFUN (Fmodule_unsafe_unload, 1);
394DEFUN ("module-unsafe-unload", Fmodule_unsafe_unload, Smodule_unsafe_unload, 1, 1, 0,
395 doc: /* Unload module FILE; does not undefine any functions defined by the module.
396This permits re-compiling and re-loading while developing the module,
397but is otherwise not recommended. */)
398 (Lisp_Object file)
399{
400 lt_dlhandle handle;
401
402 if (!lt_init_done)
403 {
404 error ("no module loaded");
405 }
406
407 CHECK_STRING (file);
408 handle = lt_dlopen (SDATA (file));
409 if (!handle)
410 error ("file not loaded %s : %s", SDATA (file), lt_dlerror());
411
412 if (lt_dlclose (handle))
413 error ("Module %s not unloaded: %s", SDATA (file), lt_dlerror());
414
415 return Qt;
416}
417
418EXFUN (Fmodule_emacs_value_type, 0);
419DEFUN ("module-emacs_value-type", Fmodule_emacs_value_type, Smodule_emacs_value_type, 0, 0, 0,
420 doc: /* Return a string specifying the type for emacs_value in emacs_modules.h. */)
421 ()
422{
423 if (sizeof (EMACS_INT) == 4) /* 4 bytes == 32 bits */
424 return make_string ("uint32_t", 8);
425 else
426 return make_string ("uint64_t", 8);
427}
428
429void syms_of_module (void)
430{
431 defsubr (&Smodule_call);
432 defsubr (&Smodule_load);
433 defsubr (&Smodule_unsafe_unload);
434 defsubr (&Smodule_emacs_value_type);
435}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-13 05:19:29 +0000