Mercurial > hg > xemacs-beta

comparison src/emodules.c @ 388:aabb7f5b1c81 r21-2-9

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