comparison src/emodules.c @ 996:25e260cb7994

[xemacs-hg @ 2002-09-10 15:27:02 by james] Enable unloading of dynamic modules. Create the first two internal XEmacs modules: LDAP and postgreSQL. Update the sample directory to contain a sample internal XEmacs module and a sample external XEmacs module. Improve support for autoloading modules. Make internal module code compile into the XEmacs binary if XEmacs is configured without module support. Make the internal module directories self-contained so that they can be distributed separately from XEmacs.
author james
date Tue, 10 Sep 2002 15:27:39 +0000
parents 804517e16990
children 20547bbdcf1e
comparison
equal deleted inserted replaced
995:4575a219af58 996:25e260cb7994
16 You should have received a copy of the GNU General Public License 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 17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 19 Boston, MA 02111-1307, USA. */
20 20
21 /* This gross hack is so that we can make DEFVAR_foo register with the
22 portable dumper in core, but not do so in modules. Since the hackery to do
23 that is in emodules.h, we have to turn it off for this file. */
24 #define EMODULES_DO_NOT_REDEFINE
21 #include "emodules.h" 25 #include "emodules.h"
22 #include "sysdll.h" 26 #include "sysdll.h"
23 27
24 #ifdef HAVE_SHLIB 28 #ifdef HAVE_SHLIB
25 29
27 Lisp_Object Vmodule_version; 31 Lisp_Object Vmodule_version;
28 32
29 /* Do we do our work quietly? */ 33 /* Do we do our work quietly? */
30 int load_modules_quietly; 34 int load_modules_quietly;
31 35
36 /* Set this while unloading a module. This should NOT be made set by users,
37 as it allows the unbinding of symbol-value-forward variables. */
38 int unloading_module;
39
32 /* Load path */ 40 /* Load path */
33 Lisp_Object Vmodule_load_path; 41 Lisp_Object Vmodule_load_path;
34
35 Lisp_Object Qdll_error; 42 Lisp_Object Qdll_error;
43 Lisp_Object Qmodule, Qunload_module, module_tag;
36 44
37 typedef struct _emodules_list 45 typedef struct _emodules_list
38 { 46 {
39 int used; /* Is this slot used? */ 47 int used; /* Is this slot used? */
40 char *soname; /* Name of the shared object loaded (full path) */ 48 char *soname; /* Name of the shared object loaded (full path) */
41 char *modname; /* The name of the module */ 49 char *modname; /* The name of the module */
42 char *modver; /* The version that the module is at */ 50 char *modver; /* The module version string */
43 char *modtitle; /* How the module announces itself */ 51 char *modtitle; /* How the module announces itself */
44 dll_handle dlhandle; /* Dynamic lib handle */ 52 void (*unload)(void); /* Module cleanup function to run before unloading */
53 dll_handle dlhandle; /* Dynamic lib handle */
45 } emodules_list; 54 } emodules_list;
46 55
47 static Lisp_Object Vmodule_extensions; 56 static Lisp_Object Vmodule_extensions;
48 57
49 static int emodules_depth; 58 static int emodules_depth;
50 static dll_handle dlhandle; 59 static dll_handle dlhandle;
51 static emodules_list *modules; 60 static emodules_list *modules;
52 static int modnum; 61 static int modnum;
53 62
54 static int find_make_module (const char *mod, const char *name, const char *ver, int make_or_find); 63 static int find_make_module (const char *mod, const char *name,
64 const char *ver, int make_or_find);
55 static Lisp_Object module_load_unwind (Lisp_Object); 65 static Lisp_Object module_load_unwind (Lisp_Object);
56 static void attempt_module_delete (int mod); 66 static void attempt_module_delete (int mod);
57 67
58 DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /* 68 DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /*
59 Load in a C Emacs Extension module named FILE. 69 Load in a C Emacs Extension module named FILE.
60 The optional NAME and VERSION are used to identify specific modules. 70 The optional NAME and VERSION are used to identify specific modules.
71
72 DO NOT USE THIS FUNCTION in your programs. Use `require' instead.
61 73
62 This function is similar in intent to `load' except that it loads in 74 This function is similar in intent to `load' except that it loads in
63 pre-compiled C or C++ code, using dynamic shared objects. If NAME is 75 pre-compiled C or C++ code, using dynamic shared objects. If NAME is
64 specified, then the module is only loaded if its internal name matches 76 specified, then the module is only loaded if its internal name matches
65 the NAME specified. If VERSION is specified, then the module is only 77 the NAME specified. If VERSION is specified, then the module is only
72 for this function to be successful. Any modules which the specified 84 for this function to be successful. Any modules which the specified
73 FILE depends on will be automatically loaded. You can determine which 85 FILE depends on will be automatically loaded. You can determine which
74 modules have been loaded as dynamic shared objects by examining the 86 modules have been loaded as dynamic shared objects by examining the
75 return value of the function `list-modules'. 87 return value of the function `list-modules'.
76 88
77 It is possible, although unwise, to unload modules using `unload-module'. 89 It is possible, although unwise, to unload modules using `unload-feature'.
78 The preferred mechanism for unloading or reloading modules is to quit 90 The preferred mechanism for unloading or reloading modules is to quit
79 XEmacs, and then reload those new or changed modules that are required. 91 XEmacs, and then reload those new or changed modules that are required.
80 92
81 Messages informing you of the progress of the load are displayed unless 93 Messages informing you of the progress of the load are displayed unless
82 the variable `load-modules-quietly' is non-NIL. 94 the variable `load-modules-quietly' is non-NIL.
106 unbind_to (speccount); 118 unbind_to (speccount);
107 119
108 return Qt; 120 return Qt;
109 } 121 }
110 122
111 #ifdef DANGEROUS_NASTY_SCARY_MONSTER 123 DEFUN ("unload-module", Funload_module, 1, 3, 0, /*
112
113 DEFUN ("unload-module", Fmodule_unload, 1, 3, 0, /*
114 Unload a module previously loaded with load-module. 124 Unload a module previously loaded with load-module.
125
126 DO NOT USE THIS FUNCTION in your programs. Use `unload-feature' instead.
115 127
116 As with load-module, this function requires at least the module FILE, and 128 As with load-module, this function requires at least the module FILE, and
117 optionally the module NAME and VERSION to unload. It may not be possible 129 optionally the module NAME and VERSION to unload. It may not be possible
118 for the module to be unloaded from memory, as there may be Lisp objects 130 for the module to be unloaded from memory, as there may be Lisp objects
119 referring to variables inside the module code. However, once you have 131 referring to variables inside the module code. However, once you have
122 */ 134 */
123 (file, name, version)) 135 (file, name, version))
124 { 136 {
125 int x; 137 int x;
126 char *mod, *mname, *mver; 138 char *mod, *mname, *mver;
139 Lisp_Object foundname = Qnil;
140 struct gcpro gcpro1;
127 141
128 CHECK_STRING(file); 142 CHECK_STRING(file);
129 143
130 mod = (char *)XSTRING_DATA (file); 144 GCPRO1 (foundname);
145 if (locate_file (Vmodule_load_path, file, Vmodule_extensions, &foundname, 0)
146 < 0)
147 return Qt;
148 mod = (char *)XSTRING_DATA (foundname);
149 UNGCPRO;
131 150
132 if (NILP (name)) 151 if (NILP (name))
133 mname = ""; 152 mname = "";
134 else 153 else
135 mname = (char *)XSTRING_DATA (name); 154 mname = (char *)XSTRING_DATA (name);
139 else 158 else
140 mver = (char *)XSTRING_DATA (version); 159 mver = (char *)XSTRING_DATA (version);
141 160
142 x = find_make_module (mod, mname, mver, 1); 161 x = find_make_module (mod, mname, mver, 1);
143 if (x != -1) 162 if (x != -1)
144 attempt_module_delete (x); 163 {
164 if (modules[x].unload != NULL)
165 modules[x].unload ();
166 attempt_module_delete (x);
167 }
145 return Qt; 168 return Qt;
146 } 169 }
147 #endif /* DANGEROUS_NASTY_SCARY_MONSTER */
148 170
149 DEFUN ("list-modules", Flist_modules, 0, 0, "", /* 171 DEFUN ("list-modules", Flist_modules, 0, 0, "", /*
150 Produce a list of loaded dynamic modules. 172 Produce a list of loaded dynamic modules.
151 173
152 This function will return a list of all the loaded dynamic modules. 174 This function will return a list of all the loaded dynamic modules.
306 * the cleaning up. 328 * the cleaning up.
307 */ 329 */
308 void 330 void
309 emodules_load(const char *module, const char *modname, const char *modver) 331 emodules_load(const char *module, const char *modname, const char *modver)
310 { 332 {
333 Lisp_Object old_load_list;
311 Lisp_Object filename; 334 Lisp_Object filename;
312 Lisp_Object foundname; 335 Lisp_Object foundname, lisp_modname;
313 int fd, x, mpx; 336 int x, mpx;
314 char *soname, *tmod; 337 char *soname;
315 const char **f; 338 const char **f;
316 const long *ellcc_rev; 339 const long *ellcc_rev;
317 char *mver, *mname, *mtitle, *symname; 340 char *mver, *mname, *mtitle, *symname;
318 void (*modload)(void) = 0; 341 void (*modload)(void) = 0;
319 void (*modsyms)(void) = 0; 342 void (*modsyms)(void) = 0;
320 void (*modvars)(void) = 0; 343 void (*modvars)(void) = 0;
321 void (*moddocs)(void) = 0; 344 void (*moddocs)(void) = 0;
345 void (*modunld)(void) = 0;
322 emodules_list *mp; 346 emodules_list *mp;
323 struct gcpro gcpro1,gcpro2; 347 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
324 348
325 filename = Qnil; 349 filename = Qnil;
326 foundname = Qnil; 350 foundname = Qnil;
327 351
328 emodules_depth++; 352 emodules_depth++;
329 dlhandle = 0; 353 dlhandle = 0;
330 354
331 if ((module == (const char *)0) || (module[0] == '\0')) 355 if ((module == (const char *)0) || (module[0] == '\0'))
332 invalid_argument ("Empty module name", Qunbound); 356 invalid_argument ("Empty module name", Qunbound);
333 357
334 /* This is to get around the fact that build_string() is not declared 358 GCPRO4(filename, foundname, old_load_list, lisp_modname);
335 as taking a const char * as an argument. I HATE compiler warnings. */ 359 filename = build_string (module);
336 tmod = (char *)ALLOCA (strlen (module) + 1); 360 if (locate_file (Vmodule_load_path, filename, Vmodule_extensions,
337 strcpy (tmod, module); 361 &foundname, 0) < 0)
338
339 GCPRO2(filename, foundname);
340 filename = build_string (tmod);
341 fd = locate_file (Vmodule_load_path, filename, Vmodule_extensions,
342 &foundname, -1);
343 UNGCPRO;
344
345 if (fd < 0)
346 signal_error (Qdll_error, "Cannot open dynamic module", filename); 362 signal_error (Qdll_error, "Cannot open dynamic module", filename);
347 363
348 soname = (char *)ALLOCA (XSTRING_LENGTH (foundname) + 1); 364 soname = (char *)ALLOCA (XSTRING_LENGTH (foundname) + 1);
349 strcpy (soname, (char *)XSTRING_DATA (foundname)); 365 strcpy (soname, (char *)XSTRING_DATA (foundname));
366 lisp_modname = call1 (Qfile_name_sans_extension,
367 Ffile_name_nondirectory (foundname));
350 368
351 dlhandle = dll_open (soname); 369 dlhandle = dll_open (soname);
352 if (dlhandle == (dll_handle)0) 370 if (dlhandle == (dll_handle)0)
353 { 371 {
354 Ibyte *dllerrint; 372 Ibyte *dllerrint;
416 strcpy (symname, "docs_of_"); 434 strcpy (symname, "docs_of_");
417 strcat (symname, mname); 435 strcat (symname, mname);
418 moddocs = (void (*)(void))dll_function (dlhandle, symname); 436 moddocs = (void (*)(void))dll_function (dlhandle, symname);
419 if (moddocs == (void (*)(void))0) 437 if (moddocs == (void (*)(void))0)
420 goto missing_symbol; 438 goto missing_symbol;
439
440 /* Now look for the optional unload function. */
441 strcpy (symname, "unload_");
442 strcat (symname, mname);
443 modunld = (void (*)(void))dll_function (dlhandle, symname);
421 444
422 if (modname && modname[0] && strcmp (modname, mname)) 445 if (modname && modname[0] && strcmp (modname, mname))
423 signal_error (Qdll_error, "Module name mismatch", Qunbound); 446 signal_error (Qdll_error, "Module name mismatch", Qunbound);
424 447
425 if (modver && modver[0] && strcmp (modver, mver)) 448 if (modver && modver[0] && strcmp (modver, mver))
452 mp->soname = xstrdup (soname); 475 mp->soname = xstrdup (soname);
453 mp->modname = xstrdup (mname); 476 mp->modname = xstrdup (mname);
454 mp->modver = xstrdup (mver); 477 mp->modver = xstrdup (mver);
455 mp->modtitle = xstrdup (mtitle); 478 mp->modtitle = xstrdup (mtitle);
456 mp->dlhandle = dlhandle; 479 mp->dlhandle = dlhandle;
480 mp->unload = modunld;
457 dlhandle = 0; 481 dlhandle = 0;
482
483 old_load_list = Vcurrent_load_list;
484 Vcurrent_load_list = Qnil;
485 LOADHIST_ATTACH (lisp_modname);
486 LOADHIST_ATTACH (module_tag);
458 487
459 /* 488 /*
460 * Now we need to call the module init function and perform the various 489 * Now we need to call the module init function and perform the various
461 * startup tasks. 490 * startup tasks.
462 */ 491 */
472 (*moddocs)(); 501 (*moddocs)();
473 502
474 if (!load_modules_quietly) 503 if (!load_modules_quietly)
475 message ("Loaded module %s v%s (%s)", mname, mver, mtitle); 504 message ("Loaded module %s v%s (%s)", mname, mver, mtitle);
476 505
506 Vload_history = Fcons (Fnreverse (Vcurrent_load_list), Vload_history);
507 Vcurrent_load_list = old_load_list;
508 UNGCPRO;
477 509
478 emodules_depth--; 510 emodules_depth--;
479 if (emodules_depth == 0) 511 if (emodules_depth == 0)
480 { 512 {
481 /* 513 /*
529 561
530 void 562 void
531 syms_of_module (void) 563 syms_of_module (void)
532 { 564 {
533 DEFERROR_STANDARD (Qdll_error, Qerror); 565 DEFERROR_STANDARD (Qdll_error, Qerror);
566 DEFSYMBOL (Qmodule);
567 DEFSYMBOL (Qunload_module);
534 DEFSUBR(Fload_module); 568 DEFSUBR(Fload_module);
535 DEFSUBR(Flist_modules); 569 DEFSUBR(Flist_modules);
536 #ifdef DANGEROUS_NASTY_SCARY_MONSTER
537 DEFSUBR(Funload_module); 570 DEFSUBR(Funload_module);
538 #endif 571 module_tag = Fcons (Qmodule, Qnil);
572 staticpro (&module_tag);
573 Fput (Qunload_module, Qdisabled, Qt);
539 } 574 }
540 575
541 void 576 void
542 reinit_vars_of_module (void) 577 reinit_vars_of_module (void)
543 { 578 {
591 are similar enough to each other that XEmacs will be unable to determine 626 are similar enough to each other that XEmacs will be unable to determine
592 the correctness of a dynamic module, which can have unpredictable results 627 the correctness of a dynamic module, which can have unpredictable results
593 when a dynamic module is loaded. 628 when a dynamic module is loaded.
594 */); 629 */);
595 630
631 DEFVAR_BOOL ("unloading-module", &unloading_module /*
632 Used internally by `unload-feature'. Do not set this variable.
633 Danger, danger, Will Robinson!
634 */);
635
596 /* #### Export this to Lisp */ 636 /* #### Export this to Lisp */
597 Vmodule_extensions = build_string (":.ell:.so:.dll"); 637 Vmodule_extensions = list3 (build_string (".ell"),
638 build_string (".so"),
639 build_string (".dll"));
598 staticpro (&Vmodule_extensions); 640 staticpro (&Vmodule_extensions);
599 641
600 load_modules_quietly = 0; 642 load_modules_quietly = 0;
601 Vmodule_load_path = Qnil; 643 Vmodule_load_path = Qnil;
602 Fprovide (intern ("modules")); 644 Fprovide (intern ("modules"));
603 } 645 }
604 646
605 #endif /* HAVE_SHLIB */ 647 #endif /* HAVE_SHLIB */
606