Mercurial > hg > xemacs-beta

comparison src/emodules.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* emodules.c - Support routines for dynamic module loading
2 (C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include "emodules.h"
22 #include "sysdll.h"
23
24 #ifdef HAVE_SHLIB
25
26 /* CE-Emacs version number */
27 Lisp_Object Vmodule_version;
28
29 /* Do we do our work quietly? */
30 int load_modules_quietly;
31
32 /* Load path */
33 Lisp_Object Vmodule_load_path;
34
35 typedef struct _emodules_list
36 {
37 int used; /* Is this slot used? */
38 char *soname; /* Name of the shared object loaded (full path) */
39 char *modname; /* The name of the module */
40 char *modver; /* The version that the module is at */
41 char *modtitle; /* How the module announces itself */
42 dll_handle dlhandle; /* Dynamic lib handle */
43 } emodules_list;
44
45 static Lisp_Object Vmodule_extensions;
46
47 static int emodules_depth;
48 static dll_handle dlhandle;
49 static emodules_list *modules;
50 static int modnum;
51
52 static int find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int make_or_find);
53 static Lisp_Object module_load_unwind (Lisp_Object);
54 static void attempt_module_delete (int mod);
55
56 DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /*
57 Load in a C Emacs Extension module named FILE.
58 The optional NAME and VERSION are used to identify specific modules.
59
60 This function is similar in intent to `load' except that it loads in
61 pre-compiled C or C++ code, using dynamic shared objects. If NAME is
62 specified, then the module is only loaded if its internal name matches
63 the NAME specified. If VERSION is specified, then the module is only
64 loaded if it matches that VERSION. This function will check to make
65 sure that the same module is not loaded twice. Modules are searched
66 for in the same way as Lisp files, except that the valid file
67 extensions are `.so', `.dll' or `.ell'.
68
69 All symbols in the shared module must be completely resolved in order
70 for this function to be successful. Any modules which the specified
71 FILE depends on will be automatically loaded. You can determine which
72 modules have been loaded as dynamic shared objects by examining the
73 return value of the function `list-modules'.
74
75 It is possible, although unwise, to unload modules using `unload-module'.
76 The prefered mechanism for unloading or reloading modules is to quit
77 XEmacs, and then reload those new or changed modules that are required.
78
79 Messages informing you of the progress of the load are displayed unless
80 the variable `load-modules-quietly' is non-NIL.
81 */
82 (file,name,version))
83 {
84 char *mod, *mname, *mver;
85 int speccount = specpdl_depth();
86
87 CHECK_STRING(file);
88
89 mod = (char *)XSTRING_DATA (file);
90
91 if (NILP (name))
92 mname = "";
93 else
94 mname = (char *)XSTRING_DATA (name);
95
96 if (NILP (version))
97 mver = "";
98 else
99 mver = (char *)XSTRING_DATA (version);
100
101 dlhandle = 0;
102 record_unwind_protect (module_load_unwind, make_int(modnum));
103 emodules_load (mod, mname, mver);
104 unbind_to (speccount, Qnil);
105
106 return Qt;
107 }
108
109 #ifdef DANGEROUS_NASTY_SCARY_MONSTER
110
111 DEFUN ("unload-module", Fmodule_unload, 1, 3, 0, /*
112 Unload a module previously loaded with load-module.
113
114 As with load-module, this function requires at least the module FILE, and
115 optionally the module NAME and VERSION to unload. It may not be possible
116 for the module to be unloaded from memory, as there may be Lisp objects
117 refering to variables inside the module code. However, once you have
118 requested a module to be unloaded, it will be unloaded from memory as
119 soon as the last reference to symbols within the module is destroyed.
120 */
121 (file,name,version))
122 {
123 int x;
124 char *mod, *mname, *mver;
125
126 CHECK_STRING(file);
127
128 mod = (char *)XSTRING_DATA (file);
129
130 if (NILP (name))
131 mname = "";
132 else
133 mname = (char *)XSTRING_DATA (name);
134
135 if (NILP (version))
136 mver = "";
137 else
138 mver = (char *)XSTRING_DATA (version);
139
140 x = find_make_module (mod, mname, mver, 1);
141 if (x != -1)
142 attempt_module_delete (x);
143 return Qt;
144 }
145 #endif /* DANGEROUS_NASTY_SCARY_MONSTER */
146
147 DEFUN ("list-modules", Flist_modules, 0, 0, "", /*
148 Produce a list of loaded dynamic modules.
149
150 This function will return a list of all the loaded dynamic modules.
151 Each element in the list is a list in the form (SONAME NAME VER DESC),
152 where SONAME is the name of the shared object that was loaded, NAME
153 is the internal module name, VER is the version of the module, and DESC
154 is how the module describes itself.
155
156 This function returns a list, so you will need to assign the return value
157 to a variable and then examine the variable with `describe-variable'.
158 For example:
159
160 (setq mylist (list-modules))
161 (describe-variable 'mylist)
162
163
164 NOTE: It is possible for the same module to be loaded more than once,
165 at different versions. However, you should never see the same module,
166 with the same name and version, loaded more than once. If you do, this
167 is a bug, and you are encouraged to report it.
168 */
169 ())
170 {
171 Lisp_Object mlist = Qnil;
172 int i;
173
174 for (i = 0; i < modnum; i++)
175 {
176 if (modules[i].used == 1)
177 mlist = Fcons (list4 (build_string (modules[i].soname),
178 build_string (modules[i].modname),
179 build_string (modules[i].modver),
180 build_string (modules[i].modtitle)), mlist);
181 }
182
183 return mlist;
184 }
185
186 static int
187 find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int mof)
188 {
189 int i, fs = -1;
190
191 for (i = 0; i < modnum; i++)
192 {
193 if (fs == -1 && modules[i].used == 0)
194 fs = i;
195 if (strcmp (modules[i].soname, mod) == 0)
196 {
197 if (name && name[0] && strcmp (modules[i].modname, name))
198 continue;
199 if (ver && ver[0] && strcmp (modules[i].modver, ver))
200 continue;
201 return i; /* Found a match */
202 }
203 }
204
205 if (mof)
206 return fs;
207
208 if (fs != -1)
209 return fs; /* First free slot */
210
211 /*
212 * We only get here if we havent found a free slot and the module was
213 * not previously loaded.
214 */
215 if (modules == (emodules_list *)0)
216 modules = (emodules_list *)xmalloc (sizeof(emodules_list));
217 modnum++;
218 modules = (emodules_list *) xrealloc (modules, modnum * sizeof(emodules_list));
219
220 fs = modnum - 1;
221 memset (&modules[fs], 0, sizeof(emodules_list));
222 return fs;
223 }
224
225 static void
226 attempt_module_delete (int mod)
227 {
228 if (dll_close (modules[mod].dlhandle) == 0)
229 {
230 xfree (modules[mod].soname);
231 xfree (modules[mod].modname);
232 xfree (modules[mod].modver);
233 xfree (modules[mod].modtitle);
234 modules[mod].dlhandle = 0;
235 modules[mod].used = 0;
236 }
237 else if (modules[mod].used > 1)
238 modules[mod].used = 1; /* We couldn't delete it - it stays */
239 }
240
241 static Lisp_Object
242 module_load_unwind (Lisp_Object upto)
243 {
244 int x,l=0;
245
246 /*
247 * First close off the current handle if it is open.
248 */
249 if (dlhandle != 0)
250 dll_close (dlhandle);
251 dlhandle = 0;
252
253 if (CONSP (upto))
254 {
255 if (INTP (XCAR (upto)))
256 l = XINT (XCAR (upto));
257 free_cons (XCONS (upto));
258 }
259 else
260 l = XINT (upto);
261
262 /*
263 * Here we need to go through and dlclose() (IN REVERSE ORDER!) any
264 * modules that were loaded as part of this load chain. We only mark
265 * the slots as closed if the dlclose() succeeds.
266 */
267 for (x = modnum-1; x >= l; x--)
268 {
269 if (modules[x].used > 1)
270 attempt_module_delete (x);
271 }
272 emodules_depth = 0;
273
274 return Qnil;
275 }
276
277 /*
278 * Do the actual grunt-work of loading in a module. We first try and
279 * dlopen() the module. If that fails, we have an error and we bail
280 * out immediately. If the dlopen() succeeds, we need to check for the
281 * existance of certain special symbols.
282 *
283 * All modules will have complete access to the variables and functions
284 * defined within XEmacs itself. It is up to the module to declare any
285 * variables or functions it uses, however. Modules will also have access
286 * to other functions and variables in other loaded modules, unless they
287 * are defined as STATIC.
288 *
289 * We need to be very careful with how we load modules. If we encounter an
290 * error along the way, we need to back out completely to the point at
291 * which the user started. Since we can be called resursively, we need to
292 * take care with marking modules as loaded. When we first start loading
293 * modules, we set the counter to zero. As we enter the function each time,
294 * we incremement the counter, and before we leave we decrement it. When
295 * we get back down to 0, we know we are at the end of the chain and we
296 * can mark all the modules in the list as loaded.
297 *
298 * When we signal an error, we need to be sure to unwind all modules loaded
299 * thus far (but only for this module chain). It is assumed that if any
300 * modules in a chain fail, then they all do. This is logical, considering
301 * that the only time we recurse is when we have dependant modules. So in
302 * the error handler we take great care to close off the module chain before
303 * we call "error" and let the Fmodule_load unwind_protect() function handle
304 * the cleaning up.
305 */
306 void
307 emodules_load(CONST char *module, CONST char *modname, CONST char *modver)
308 {
309 Lisp_Object filename;
310 Lisp_Object foundname;
311 int fd, x, mpx;
312 char *soname, *tmod;
313 CONST char **f;
314 CONST long *ellcc_rev;
315 char *mver, *mname, *mtitle, *symname;
316 void (*modload)(void) = 0;
317 void (*modsyms)(void) = 0;
318 void (*modvars)(void) = 0;
319 void (*moddocs)(void) = 0;
320 emodules_list *mp;
321 struct gcpro gcpro1,gcpro2;
322
323 filename = Qnil;
324 foundname = Qnil;
325
326 emodules_depth++;
327 dlhandle = 0;
328
329 if ((module == (CONST char *)0) || (module[0] == '\0'))
330 error ("Empty module name");
331
332 /* This is to get around the fact that build_string() is not declared
333 as taking a const char * as an argument. I HATE compiler warnings. */
334 tmod = (char *)alloca (strlen (module) + 1);
335 strcpy (tmod, module);
336
337 GCPRO2(filename, foundname);
338 filename = build_string (tmod);
339 fd = locate_file(Vmodule_load_path, filename, Vmodule_extensions,
340 &foundname, -1);
341 UNGCPRO;
342
343 if (fd < 0)
344 signal_simple_error ("Cannot open dynamic module", filename);
345
346 soname = (char *)alloca (XSTRING_LENGTH (foundname) + 1);
347 strcpy (soname, (char *)XSTRING_DATA (foundname));
348
349 dlhandle = dll_open (soname);
350 if (dlhandle == (dll_handle)0)
351 error ("Opening dynamic module: %s", dll_error (dlhandle));
352
353 ellcc_rev = (CONST long *)dll_variable (dlhandle, "emodule_compiler");
354 if ((ellcc_rev == (CONST long *)0) || (*ellcc_rev <= 0))
355 error ("Missing symbol `emodule_compiler': Invalid dynamic module");
356 if (*ellcc_rev > EMODULES_REVISION)
357 error ("Unsupported version `%ld(%ld)': Invalid dynamic module",
358 *ellcc_rev, EMODULES_REVISION);
359
360 f = (CONST char **)dll_variable (dlhandle, "emodule_name");
361 if ((f == (CONST char **)0) || (*f == (CONST char *)0))
362 error ("Missing symbol `emodule_name': Invalid dynamic module");
363
364 mname = (char *)alloca (strlen (*f) + 1);
365 strcpy (mname, *f);
366 if (mname[0] == '\0')
367 error ("Empty value for `emodule_name': Invalid dynamic module");
368
369 f = (CONST char **)dll_variable (dlhandle, "emodule_version");
370 if ((f == (CONST char **)0) || (*f == (CONST char *)0))
371 error ("Missing symbol `emodule_version': Invalid dynamic module");
372
373 mver = (char *)alloca (strlen (*f) + 1);
374 strcpy (mver, *f);
375
376 f = (CONST char **)dll_variable (dlhandle, "emodule_title");
377 if ((f == (CONST char **)0) || (*f == (CONST char *)0))
378 error ("Missing symbol `emodule_title': Invalid dynamic module");
379
380 mtitle = (char *)alloca (strlen (*f) + 1);
381 strcpy (mtitle, *f);
382
383 symname = (char *)alloca (strlen (mname) + 15);
384
385 strcpy (symname, "modules_of_");
386 strcat (symname, mname);
387 modload = (void (*)(void))dll_function (dlhandle, symname);
388 /*
389 * modload is optional. If the module doesnt require other modules it can
390 * be left out.
391 */
392
393 strcpy (symname, "syms_of_");
394 strcat (symname, mname);
395 modsyms = (void (*)(void))dll_function (dlhandle, symname);
396 if (modsyms == (void (*)(void))0)
397 error ("Missing symbol `%s': Invalid dynamic module", symname);
398
399 strcpy (symname, "vars_of_");
400 strcat (symname, mname);
401 modvars = (void (*)(void))dll_function (dlhandle, symname);
402 if (modvars == (void (*)(void))0)
403 error ("Missing symbol `%s': Invalid dynamic module", symname);
404
405 strcpy (symname, "docs_of_");
406 strcat (symname, mname);
407 moddocs = (void (*)(void))dll_function (dlhandle, symname);
408 if (moddocs == (void (*)(void))0)
409 error ("Missing symbol `%s': Invalid dynamic module", symname);
410
411 if (modname && modname[0] && strcmp (modname, mname))
412 error ("Module name mismatch");
413
414 if (modver && modver[0] && strcmp (modver, mver))
415 error ("Module version mismatch");
416
417 /*
418 * Attempt to make a new slot for this module. If this really is the
419 * first time we are loading this module, the used member will be 0.
420 * If that is non-zero, we know that we have a previously loaded module
421 * of the same name and version, and we dont need to go any further.
422 */
423 mpx = find_make_module (soname, mname, mver, 0);
424 mp = &modules[mpx];
425 if (mp->used > 0)
426 {
427 emodules_depth--;
428 dll_close (dlhandle);
429 return;
430 }
431
432 if (!load_modules_quietly)
433 message ("Loading %s v%s (%s)", mname, mver, mtitle);
434
435 /*
436 * We have passed the basic initialization, and can now add this
437 * module to the list of modules.
438 */
439 mp->used = emodules_depth + 1;
440 mp->soname = xstrdup (soname);
441 mp->modname = xstrdup (mname);
442 mp->modver = xstrdup (mver);
443 mp->modtitle = xstrdup (mtitle);
444 mp->dlhandle = dlhandle;
445 dlhandle = 0;
446
447 /*
448 * Now we need to call the module init function and perform the various
449 * startup tasks.
450 */
451 if (modload != 0)
452 (*modload)();
453
454 /*
455 * Now we can get the module to initialize its symbols, and then its
456 * variables, and lastly the documentation strings.
457 */
458 (*modsyms)();
459 (*modvars)();
460 (*moddocs)();
461
462 if (!load_modules_quietly)
463 message ("Loaded module %s v%s (%s)", mname, mver, mtitle);
464
465
466 emodules_depth--;
467 if (emodules_depth == 0)
468 {
469 /*
470 * We have reached the end of the load chain. We now go through the
471 * list of loaded modules and mark all the valid modules as just
472 * that.
473 */
474 for (x = 0; x < modnum; x++)
475 if (modules[x].used > 1)
476 modules[x].used = 1;
477 }
478 }
479
480 void
481 emodules_doc_subr(CONST char *symname, CONST char *doc)
482 {
483 Bytecount len = strlen (symname);
484 Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len);
485 struct Lisp_Subr *subr;
486
487 if (SYMBOLP(sym))
488 {
489 subr = XSUBR( XSYMBOL(sym)->function);
490 subr->doc = xstrdup (doc);
491 }
492 /*
493 * FIXME: I wish there was some way to avoid the xstrdup(). Is it
494 * possible to just set a pointer to the string, or somehow create a
495 * symbol whose value we can point to the constant string? Can someone
496 * look into this?
497 */
498 }
499
500 void
501 emodules_doc_sym (CONST char *symname, CONST char *doc)
502 {
503 Bytecount len = strlen (symname);
504 Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len);
505 Lisp_Object docstr;
506 struct gcpro gcpro1;
507
508 if (SYMBOLP(sym))
509 {
510 docstr = build_string (doc);
511 GCPRO1(docstr);
512 Fput (sym, Qvariable_documentation, docstr);
513 UNGCPRO;
514 }
515 }
516
517
518 void
519 syms_of_module (void)
520 {
521 DEFSUBR(Fload_module);
522 DEFSUBR(Flist_modules);
523 #ifdef DANGEROUS_NASTY_SCARY_MONSTER
524 DEFSUBR(Funload_module);
525 #endif
526 }
527
528 void
529 reinit_vars_of_module (void)
530 {
531 emodules_depth = 0;
532 modules = (emodules_list *)0;
533 modnum = 0;
534 }
535
536 void
537 vars_of_module (void)
538 {
539 reinit_vars_of_module ();
540
541 DEFVAR_LISP ("module-version", &Vmodule_version /*
542 Emacs dynamic loading mechanism version, as a string.
543
544 This string is in the form XX.YY.ppp, where XX is the major version
545 number, YY is the minor version number, and ppp is the patch level.
546 This variable can be used to distinquish between different versions of
547 the dynamic loading technology used in Emacs, if required. It is not
548 a given that this value will be the same as the Emacs version number.
549 */ );
550 Vmodule_version = build_string (EMODULES_VERSION);
551
552 DEFVAR_BOOL ("load-modules-quietly", &load_modules_quietly /*
553 *Set to t if module loading is to be silent.
554
555 Normally, when loading dynamic modules, Emacs will inform you of its
556 progress, and will display the module name and version if the module
557 is loaded correctly. Setting this variable to `t' will suppress these
558 messages. This would normally only be done if `load-module' was being
559 called by a Lisp function.
560 */);
561
562 DEFVAR_LISP ("module-load-path", &Vmodule_load_path /*
563 *List of directories to search for dynamic modules to load.
564 Each element is a string (directory name) or nil (try default directory).
565
566 Note that elements of this list *may not* begin with "~", so you must
567 call `expland-file-name' on them before adding them to this list.
568
569 Initialized based on EMACSMODULEPATH environment variable, if any, otherwise
570 to default specified the file `paths.h' when XEmacs was built. If there
571 were no paths specified in `paths.h', then XEmacs chooses a default
572 value for this variable by looking around in the file-system near the
573 directory in which the XEmacs executable resides.
574
575 Due to the nature of dynamic modules, the path names should almost always
576 refer to architecture-dependant directories. It is unwise to attempt to
577 store dynamic modules in a hetrogenous environment. Some environments
578 are similar enough to each other that XEmacs will be unable to determine
579 the correctness of a dynamic module, which can have unpredictable results
580 when a dynamic module is loaded.
581 */);
582
583 /* #### Export this to Lisp */
584 Vmodule_extensions = build_string (":.ell:.so:.dll");
585 staticpro (&Vmodule_extensions);
586
587 load_modules_quietly = 0;
588 Vmodule_load_path = Qnil;
589 Fprovide (intern ("modules"));
590 }
591
592 #endif /* HAVE_SHLIB */
593