Mercurial > hg > xemacs-beta
annotate src/emodules.c @ 5313:5ed261fd2bd9
Unrool a load-time loop at macro expansion time, cl-macs.el
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 29 Dec 2010 23:43:10 +0000 |
parents | 63f247c5da0a |
children | b9167d522a9a |
rev | line source |
---|---|
428 | 1 /* emodules.c - Support routines for dynamic module loading |
2 (C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
3 (C) Copyright 2010 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
22 /* This file has been Mule-ized, Ben Wing, 1-26-10. */ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
23 |
428 | 24 #include "emodules.h" |
25 #include "sysdll.h" | |
2078 | 26 #ifdef HAVE_LTDL |
27 #include <ltdl.h> | |
28 #endif | |
428 | 29 |
1750 | 30 /* Load path */ |
31 static Lisp_Object Vmodule_load_path; | |
32 | |
33 /* Module lFile extensions */ | |
34 static Lisp_Object Vmodule_extensions; | |
35 | |
428 | 36 #ifdef HAVE_SHLIB |
37 | |
38 /* CE-Emacs version number */ | |
39 Lisp_Object Vmodule_version; | |
40 | |
41 /* Do we do our work quietly? */ | |
42 int load_modules_quietly; | |
43 | |
996 | 44 /* Set this while unloading a module. This should NOT be made set by users, |
45 as it allows the unbinding of symbol-value-forward variables. */ | |
46 int unloading_module; | |
47 | |
564 | 48 Lisp_Object Qdll_error; |
996 | 49 Lisp_Object Qmodule, Qunload_module, module_tag; |
564 | 50 |
428 | 51 typedef struct _emodules_list |
52 { | |
996 | 53 int used; /* Is this slot used? */ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
54 Ibyte *soname; /* Name of the shared object loaded (full path) */ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
55 Ibyte *modname; /* The name of the module */ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
56 Ibyte *modver; /* The module version string */ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
57 Ibyte *modtitle; /* How the module announces itself */ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
58 void (*unload) (void);/* Module cleanup function to run before unloading */ |
996 | 59 dll_handle dlhandle; /* Dynamic lib handle */ |
428 | 60 } emodules_list; |
61 | |
62 static int emodules_depth; | |
63 static dll_handle dlhandle; | |
64 static emodules_list *modules; | |
65 static int modnum; | |
66 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
67 static int find_make_module (Lisp_Object mod, const Ibyte *name, |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
68 const Ibyte *ver, int make_or_find); |
428 | 69 static Lisp_Object module_load_unwind (Lisp_Object); |
70 static void attempt_module_delete (int mod); | |
71 | |
72 DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /* | |
73 Load in a C Emacs Extension module named FILE. | |
74 The optional NAME and VERSION are used to identify specific modules. | |
75 | |
996 | 76 DO NOT USE THIS FUNCTION in your programs. Use `require' instead. |
77 | |
428 | 78 This function is similar in intent to `load' except that it loads in |
79 pre-compiled C or C++ code, using dynamic shared objects. If NAME is | |
80 specified, then the module is only loaded if its internal name matches | |
81 the NAME specified. If VERSION is specified, then the module is only | |
82 loaded if it matches that VERSION. This function will check to make | |
83 sure that the same module is not loaded twice. Modules are searched | |
84 for in the same way as Lisp files, except that the valid file | |
1632 | 85 extensions are `.so', `.dll', `.ell', or `.dylib'. |
428 | 86 |
87 All symbols in the shared module must be completely resolved in order | |
88 for this function to be successful. Any modules which the specified | |
89 FILE depends on will be automatically loaded. You can determine which | |
90 modules have been loaded as dynamic shared objects by examining the | |
91 return value of the function `list-modules'. | |
92 | |
996 | 93 It is possible, although unwise, to unload modules using `unload-feature'. |
442 | 94 The preferred mechanism for unloading or reloading modules is to quit |
428 | 95 XEmacs, and then reload those new or changed modules that are required. |
96 | |
97 Messages informing you of the progress of the load are displayed unless | |
98 the variable `load-modules-quietly' is non-NIL. | |
99 */ | |
444 | 100 (file, name, version)) |
428 | 101 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
102 const Ibyte *mod, *mname, *mver; |
428 | 103 int speccount = specpdl_depth(); |
104 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
105 CHECK_STRING (file); |
428 | 106 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
107 mod = XSTRING_DATA (file); |
428 | 108 |
109 if (NILP (name)) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
110 mname = (const Ibyte *) ""; |
428 | 111 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
112 mname = XSTRING_DATA (name); |
428 | 113 |
114 if (NILP (version)) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
115 mver = (const Ibyte *) ""; |
428 | 116 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
117 mver = XSTRING_DATA (version); |
428 | 118 |
119 dlhandle = 0; | |
120 record_unwind_protect (module_load_unwind, make_int(modnum)); | |
121 emodules_load (mod, mname, mver); | |
771 | 122 unbind_to (speccount); |
428 | 123 |
124 return Qt; | |
125 } | |
126 | |
996 | 127 DEFUN ("unload-module", Funload_module, 1, 3, 0, /* |
128 Unload a module previously loaded with load-module. | |
428 | 129 |
996 | 130 DO NOT USE THIS FUNCTION in your programs. Use `unload-feature' instead. |
428 | 131 |
132 As with load-module, this function requires at least the module FILE, and | |
133 optionally the module NAME and VERSION to unload. It may not be possible | |
134 for the module to be unloaded from memory, as there may be Lisp objects | |
442 | 135 referring to variables inside the module code. However, once you have |
428 | 136 requested a module to be unloaded, it will be unloaded from memory as |
137 soon as the last reference to symbols within the module is destroyed. | |
138 */ | |
444 | 139 (file, name, version)) |
428 | 140 { |
141 int x; | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
142 const Ibyte *mname, *mver; |
996 | 143 Lisp_Object foundname = Qnil; |
144 struct gcpro gcpro1; | |
428 | 145 |
146 CHECK_STRING(file); | |
147 | |
996 | 148 GCPRO1 (foundname); |
149 if (locate_file (Vmodule_load_path, file, Vmodule_extensions, &foundname, 0) | |
150 < 0) | |
151 return Qt; | |
152 UNGCPRO; | |
428 | 153 |
154 if (NILP (name)) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
155 mname = (const Ibyte *) ""; |
428 | 156 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
157 mname = XSTRING_DATA (name); |
428 | 158 |
159 if (NILP (version)) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
160 mver = (const Ibyte *) ""; |
428 | 161 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
162 mver = XSTRING_DATA (version); |
428 | 163 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
164 x = find_make_module (foundname, mname, mver, 1); |
428 | 165 if (x != -1) |
996 | 166 { |
167 if (modules[x].unload != NULL) | |
168 modules[x].unload (); | |
169 attempt_module_delete (x); | |
170 } | |
428 | 171 return Qt; |
172 } | |
173 | |
174 DEFUN ("list-modules", Flist_modules, 0, 0, "", /* | |
175 Produce a list of loaded dynamic modules. | |
176 | |
177 This function will return a list of all the loaded dynamic modules. | |
178 Each element in the list is a list in the form (SONAME NAME VER DESC), | |
179 where SONAME is the name of the shared object that was loaded, NAME | |
180 is the internal module name, VER is the version of the module, and DESC | |
181 is how the module describes itself. | |
182 | |
183 This function returns a list, so you will need to assign the return value | |
184 to a variable and then examine the variable with `describe-variable'. | |
185 For example: | |
186 | |
187 (setq mylist (list-modules)) | |
188 (describe-variable 'mylist) | |
189 | |
190 | |
191 NOTE: It is possible for the same module to be loaded more than once, | |
192 at different versions. However, you should never see the same module, | |
193 with the same name and version, loaded more than once. If you do, this | |
194 is a bug, and you are encouraged to report it. | |
195 */ | |
196 ()) | |
197 { | |
198 Lisp_Object mlist = Qnil; | |
199 int i; | |
200 | |
201 for (i = 0; i < modnum; i++) | |
202 { | |
203 if (modules[i].used == 1) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
204 mlist = Fcons (list4 (build_istring (modules[i].soname), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
205 build_istring (modules[i].modname), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
206 build_istring (modules[i].modver), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
207 build_istring (modules[i].modtitle)), mlist); |
428 | 208 } |
209 | |
210 return mlist; | |
211 } | |
212 | |
213 static int | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
214 find_make_module (Lisp_Object mod, const Ibyte *name, const Ibyte *ver, |
1706 | 215 int mof) |
428 | 216 { |
217 int i, fs = -1; | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
218 Ibyte *modstr = XSTRING_DATA (mod); |
428 | 219 |
220 for (i = 0; i < modnum; i++) | |
221 { | |
222 if (fs == -1 && modules[i].used == 0) | |
223 fs = i; | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
224 if (qxestrcmp (modules[i].soname, modstr) == 0) |
428 | 225 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
226 if (name && name[0] && qxestrcmp (modules[i].modname, name)) |
428 | 227 continue; |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
228 if (ver && ver[0] && qxestrcmp (modules[i].modver, ver)) |
428 | 229 continue; |
230 return i; /* Found a match */ | |
231 } | |
232 } | |
233 | |
234 if (mof) | |
235 return fs; | |
236 | |
237 if (fs != -1) | |
238 return fs; /* First free slot */ | |
239 | |
240 /* | |
442 | 241 * We only get here if we haven't found a free slot and the module was |
428 | 242 * not previously loaded. |
243 */ | |
1706 | 244 if (modules == NULL) |
2367 | 245 modules = xnew (emodules_list); |
428 | 246 modnum++; |
2367 | 247 XREALLOC_ARRAY (modules, emodules_list, modnum); |
428 | 248 |
249 fs = modnum - 1; | |
2367 | 250 memset (&modules[fs], 0, sizeof (emodules_list)); |
428 | 251 return fs; |
252 } | |
253 | |
254 static void | |
255 attempt_module_delete (int mod) | |
256 { | |
257 if (dll_close (modules[mod].dlhandle) == 0) | |
258 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4956
diff
changeset
|
259 xfree (modules[mod].soname); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
260 modules[mod].soname = 0; |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4956
diff
changeset
|
261 xfree (modules[mod].modname); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
262 modules[mod].modname = 0; |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4956
diff
changeset
|
263 xfree (modules[mod].modver); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
264 modules[mod].modver = 0; |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4956
diff
changeset
|
265 xfree (modules[mod].modtitle); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
266 modules[mod].modtitle = 0; |
428 | 267 modules[mod].dlhandle = 0; |
268 modules[mod].used = 0; | |
269 } | |
270 else if (modules[mod].used > 1) | |
271 modules[mod].used = 1; /* We couldn't delete it - it stays */ | |
272 } | |
273 | |
274 static Lisp_Object | |
275 module_load_unwind (Lisp_Object upto) | |
276 { | |
277 int x,l=0; | |
278 | |
279 /* | |
280 * First close off the current handle if it is open. | |
281 */ | |
282 if (dlhandle != 0) | |
283 dll_close (dlhandle); | |
284 dlhandle = 0; | |
285 | |
286 if (CONSP (upto)) | |
287 { | |
288 if (INTP (XCAR (upto))) | |
289 l = XINT (XCAR (upto)); | |
853 | 290 free_cons (upto); |
428 | 291 } |
292 else | |
293 l = XINT (upto); | |
294 | |
295 /* | |
296 * Here we need to go through and dlclose() (IN REVERSE ORDER!) any | |
297 * modules that were loaded as part of this load chain. We only mark | |
298 * the slots as closed if the dlclose() succeeds. | |
299 */ | |
300 for (x = modnum-1; x >= l; x--) | |
301 { | |
302 if (modules[x].used > 1) | |
303 attempt_module_delete (x); | |
304 } | |
305 emodules_depth = 0; | |
306 | |
307 return Qnil; | |
308 } | |
309 | |
310 /* | |
311 * Do the actual grunt-work of loading in a module. We first try and | |
312 * dlopen() the module. If that fails, we have an error and we bail | |
313 * out immediately. If the dlopen() succeeds, we need to check for the | |
442 | 314 * existence of certain special symbols. |
428 | 315 * |
316 * All modules will have complete access to the variables and functions | |
317 * defined within XEmacs itself. It is up to the module to declare any | |
318 * variables or functions it uses, however. Modules will also have access | |
319 * to other functions and variables in other loaded modules, unless they | |
320 * are defined as STATIC. | |
321 * | |
322 * We need to be very careful with how we load modules. If we encounter an | |
323 * error along the way, we need to back out completely to the point at | |
442 | 324 * which the user started. Since we can be called recursively, we need to |
428 | 325 * take care with marking modules as loaded. When we first start loading |
326 * modules, we set the counter to zero. As we enter the function each time, | |
442 | 327 * we increment the counter, and before we leave we decrement it. When |
428 | 328 * we get back down to 0, we know we are at the end of the chain and we |
329 * can mark all the modules in the list as loaded. | |
330 * | |
331 * When we signal an error, we need to be sure to unwind all modules loaded | |
332 * thus far (but only for this module chain). It is assumed that if any | |
333 * modules in a chain fail, then they all do. This is logical, considering | |
442 | 334 * that the only time we recurse is when we have dependent modules. So in |
428 | 335 * the error handler we take great care to close off the module chain before |
336 * we call "error" and let the Fmodule_load unwind_protect() function handle | |
337 * the cleaning up. | |
338 */ | |
339 void | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
340 emodules_load (const Ibyte *module, const Ibyte *modname, |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
341 const Ibyte *modver) |
428 | 342 { |
996 | 343 Lisp_Object old_load_list; |
428 | 344 Lisp_Object filename; |
996 | 345 Lisp_Object foundname, lisp_modname; |
346 int x, mpx; | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
347 const Extbyte **f; |
442 | 348 const long *ellcc_rev; |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
349 Ibyte *mver, *mname, *mtitle, *symname; |
428 | 350 void (*modload)(void) = 0; |
351 void (*modsyms)(void) = 0; | |
352 void (*modvars)(void) = 0; | |
353 void (*moddocs)(void) = 0; | |
996 | 354 void (*modunld)(void) = 0; |
428 | 355 emodules_list *mp; |
996 | 356 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
428 | 357 |
358 filename = Qnil; | |
359 foundname = Qnil; | |
360 | |
361 emodules_depth++; | |
362 dlhandle = 0; | |
363 | |
1706 | 364 if (module == NULL || module[0] == '\0') |
563 | 365 invalid_argument ("Empty module name", Qunbound); |
428 | 366 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
367 GCPRO4 (filename, foundname, old_load_list, lisp_modname); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
368 filename = build_istring (module); |
996 | 369 if (locate_file (Vmodule_load_path, filename, Vmodule_extensions, |
370 &foundname, 0) < 0) | |
563 | 371 signal_error (Qdll_error, "Cannot open dynamic module", filename); |
428 | 372 |
996 | 373 lisp_modname = call1 (Qfile_name_sans_extension, |
374 Ffile_name_nondirectory (foundname)); | |
428 | 375 |
1706 | 376 dlhandle = dll_open (foundname); |
377 if (dlhandle == NULL) | |
563 | 378 { |
1811 | 379 signal_error (Qdll_error, "Opening dynamic module", dll_error ()); |
563 | 380 } |
428 | 381 |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
382 ellcc_rev = (const long *) dll_variable (dlhandle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
383 (const Ibyte *) "emodule_compiler"); |
1706 | 384 if (ellcc_rev == NULL || *ellcc_rev <= 0L) |
563 | 385 signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_compiler'", Qunbound); |
428 | 386 if (*ellcc_rev > EMODULES_REVISION) |
563 | 387 signal_ferror (Qdll_error, "Invalid dynamic module: Unsupported version `%ld(%ld)'", *ellcc_rev, EMODULES_REVISION); |
428 | 388 |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
389 f = (const Extbyte **) dll_variable (dlhandle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
390 (const Ibyte *) "emodule_name"); |
1706 | 391 if (f == NULL || *f == NULL) |
563 | 392 signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_name'", Qunbound); |
5293
63f247c5da0a
In emodules_load(), dereference f = dll_variable() once more.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5169
diff
changeset
|
393 mname = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
394 |
428 | 395 if (mname[0] == '\0') |
563 | 396 signal_error (Qdll_error, "Invalid dynamic module: Empty value for `emodule_name'", Qunbound); |
428 | 397 |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
398 f = (const Extbyte **) dll_variable (dlhandle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
399 (const Ibyte *) "emodule_version"); |
1706 | 400 if (f == NULL || *f == NULL) |
563 | 401 signal_error (Qdll_error, "Missing symbol `emodule_version': Invalid dynamic module", Qunbound); |
5293
63f247c5da0a
In emodules_load(), dereference f = dll_variable() once more.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5169
diff
changeset
|
402 mver = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); |
428 | 403 |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
404 f = (const Extbyte **) dll_variable (dlhandle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
405 (const Ibyte *) "emodule_title"); |
1706 | 406 if (f == NULL || *f == NULL) |
563 | 407 signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_title'", Qunbound); |
5293
63f247c5da0a
In emodules_load(), dereference f = dll_variable() once more.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5169
diff
changeset
|
408 mtitle = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); |
428 | 409 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
410 symname = alloca_ibytes (qxestrlen (mname) + 15); |
428 | 411 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
412 qxestrcpy_ascii (symname, "modules_of_"); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
413 qxestrcat (symname, mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
414 modload = (void (*)(void)) dll_function (dlhandle, symname); |
428 | 415 /* |
442 | 416 * modload is optional. If the module doesn't require other modules it can |
428 | 417 * be left out. |
418 */ | |
419 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
420 qxestrcpy_ascii (symname, "syms_of_"); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
421 qxestrcat (symname, mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
422 modsyms = (void (*)(void)) dll_function (dlhandle, symname); |
1706 | 423 if (modsyms == NULL) |
563 | 424 { |
425 missing_symbol: | |
426 signal_error (Qdll_error, "Invalid dynamic module: Missing symbol", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
427 build_istring (symname)); |
563 | 428 } |
428 | 429 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
430 qxestrcpy_ascii (symname, "vars_of_"); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
431 qxestrcat (symname, mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
432 modvars = (void (*)(void)) dll_function (dlhandle, symname); |
1706 | 433 if (modvars == NULL) |
563 | 434 goto missing_symbol; |
428 | 435 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
436 qxestrcpy_ascii (symname, "docs_of_"); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
437 qxestrcat (symname, mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
438 moddocs = (void (*)(void)) dll_function (dlhandle, symname); |
1706 | 439 if (moddocs == NULL) |
563 | 440 goto missing_symbol; |
428 | 441 |
996 | 442 /* Now look for the optional unload function. */ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
443 qxestrcpy_ascii (symname, "unload_"); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
444 qxestrcat (symname, mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
445 modunld = (void (*)(void)) dll_function (dlhandle, symname); |
996 | 446 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
447 if (modname && modname[0] && qxestrcmp (modname, mname)) |
563 | 448 signal_error (Qdll_error, "Module name mismatch", Qunbound); |
428 | 449 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
450 if (modver && modver[0] && qxestrcmp (modver, mver)) |
563 | 451 signal_error (Qdll_error, "Module version mismatch", Qunbound); |
428 | 452 |
453 /* | |
454 * Attempt to make a new slot for this module. If this really is the | |
455 * first time we are loading this module, the used member will be 0. | |
456 * If that is non-zero, we know that we have a previously loaded module | |
442 | 457 * of the same name and version, and we don't need to go any further. |
428 | 458 */ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
459 mpx = find_make_module (foundname, mname, mver, 0); |
428 | 460 mp = &modules[mpx]; |
461 if (mp->used > 0) | |
462 { | |
463 emodules_depth--; | |
464 dll_close (dlhandle); | |
806 | 465 dlhandle = 0; /* Zero this out before module_load_unwind runs */ |
428 | 466 return; |
467 } | |
468 | |
469 if (!load_modules_quietly) | |
470 message ("Loading %s v%s (%s)", mname, mver, mtitle); | |
471 | |
472 /* | |
473 * We have passed the basic initialization, and can now add this | |
474 * module to the list of modules. | |
475 */ | |
476 mp->used = emodules_depth + 1; | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
477 mp->soname = qxestrdup (XSTRING_DATA (foundname)); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
478 mp->modname = qxestrdup (mname); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
479 mp->modver = qxestrdup (mver); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
480 mp->modtitle = qxestrdup (mtitle); |
428 | 481 mp->dlhandle = dlhandle; |
996 | 482 mp->unload = modunld; |
428 | 483 dlhandle = 0; |
484 | |
996 | 485 old_load_list = Vcurrent_load_list; |
486 Vcurrent_load_list = Qnil; | |
487 LOADHIST_ATTACH (lisp_modname); | |
488 LOADHIST_ATTACH (module_tag); | |
489 | |
428 | 490 /* |
491 * Now we need to call the module init function and perform the various | |
492 * startup tasks. | |
493 */ | |
494 if (modload != 0) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
495 (*modload) (); |
428 | 496 |
497 /* | |
498 * Now we can get the module to initialize its symbols, and then its | |
499 * variables, and lastly the documentation strings. | |
500 */ | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
501 (*modsyms) (); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
502 (*modvars) (); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
503 (*moddocs) (); |
428 | 504 |
505 if (!load_modules_quietly) | |
506 message ("Loaded module %s v%s (%s)", mname, mver, mtitle); | |
507 | |
996 | 508 Vload_history = Fcons (Fnreverse (Vcurrent_load_list), Vload_history); |
509 Vcurrent_load_list = old_load_list; | |
510 UNGCPRO; | |
428 | 511 |
512 emodules_depth--; | |
513 if (emodules_depth == 0) | |
514 { | |
515 /* | |
516 * We have reached the end of the load chain. We now go through the | |
517 * list of loaded modules and mark all the valid modules as just | |
518 * that. | |
519 */ | |
520 for (x = 0; x < modnum; x++) | |
521 if (modules[x].used > 1) | |
522 modules[x].used = 1; | |
523 } | |
524 } | |
525 | |
526 void | |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
527 emodules_doc_subr (const Ascbyte *symname, const Ascbyte *doc) |
428 | 528 { |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
529 Bytecount len; |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
530 Lisp_Object sym; |
440 | 531 Lisp_Subr *subr; |
428 | 532 |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
533 ASSERT_ASCTEXT_ASCII (symname); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
534 len = strlen (symname); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
535 sym = oblookup (Vobarray, (const Ibyte *) symname, len); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
536 |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
537 /* We do this assert to avoid the possibility of externally formatted |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
538 text ending up in the doc string, where it could cause crashes. |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
539 It you need to have a non-ASCII doc string, create another version |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
540 emodules_doc_subr_istring() that accepts an Ibyte * and doesn't |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
541 assert, or create an emodules_doc_subr_extstring() that takes |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
542 an externally_formatted string and a coding system name. */ |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
543 ASSERT_ASCTEXT_ASCII (doc); |
1632 | 544 /* Skip autoload cookies */ |
545 if (SYMBOLP (sym) && SUBRP (XSYMBOL (sym)->function)) | |
428 | 546 { |
1632 | 547 subr = XSUBR (XSYMBOL (sym)->function); |
428 | 548 subr->doc = xstrdup (doc); |
549 } | |
550 /* | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
551 * #### FIXME: I wish there was some way to avoid the xstrdup(). Is it |
428 | 552 * possible to just set a pointer to the string, or somehow create a |
553 * symbol whose value we can point to the constant string? Can someone | |
554 * look into this? | |
555 */ | |
556 } | |
557 | |
558 void | |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
559 emodules_doc_sym (const Ascbyte *symname, const Ascbyte *doc) |
428 | 560 { |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
561 Bytecount len; |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
562 Lisp_Object sym; |
428 | 563 Lisp_Object docstr; |
564 struct gcpro gcpro1; | |
565 | |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
566 ASSERT_ASCTEXT_ASCII (symname); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
567 len = strlen (symname); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
568 sym = oblookup (Vobarray, (const Ibyte *) symname, len); |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
569 |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
570 /* See comments above in emodules_doc_subr() about why we assert like |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
571 this. */ |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
572 ASSERT_ASCTEXT_ASCII (doc); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
573 if (SYMBOLP (sym)) |
428 | 574 { |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
575 docstr = build_ascstring (doc); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
576 GCPRO1 (docstr); |
428 | 577 Fput (sym, Qvariable_documentation, docstr); |
578 UNGCPRO; | |
579 } | |
580 } | |
581 | |
582 | |
583 void | |
584 syms_of_module (void) | |
585 { | |
564 | 586 DEFERROR_STANDARD (Qdll_error, Qerror); |
996 | 587 DEFSYMBOL (Qmodule); |
588 DEFSYMBOL (Qunload_module); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
589 DEFSUBR (Fload_module); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
590 DEFSUBR (Flist_modules); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
591 DEFSUBR (Funload_module); |
996 | 592 module_tag = Fcons (Qmodule, Qnil); |
593 staticpro (&module_tag); | |
594 Fput (Qunload_module, Qdisabled, Qt); | |
428 | 595 } |
596 | |
597 void | |
598 reinit_vars_of_module (void) | |
599 { | |
600 emodules_depth = 0; | |
1706 | 601 modules = NULL; |
428 | 602 modnum = 0; |
603 } | |
604 | |
1750 | 605 #endif /* HAVE_SHLIB */ |
606 | |
428 | 607 void |
608 vars_of_module (void) | |
609 { | |
1750 | 610 #ifdef HAVE_SHLIB |
611 Fprovide (intern ("modules")); | |
612 | |
2078 | 613 #ifdef HAVE_LTDL |
614 lt_dlinit (); | |
615 lt_dlmalloc = (lt_ptr (*) (size_t)) xmalloc; | |
616 lt_dlrealloc = (lt_ptr (*) (lt_ptr, size_t)) xrealloc; | |
617 lt_dlfree = (void (*) (lt_ptr)) xfree_1; | |
618 #endif | |
619 | |
428 | 620 DEFVAR_LISP ("module-version", &Vmodule_version /* |
621 Emacs dynamic loading mechanism version, as a string. | |
622 | |
623 This string is in the form XX.YY.ppp, where XX is the major version | |
624 number, YY is the minor version number, and ppp is the patch level. | |
442 | 625 This variable can be used to distinguish between different versions of |
428 | 626 the dynamic loading technology used in Emacs, if required. It is not |
627 a given that this value will be the same as the Emacs version number. | |
628 */ ); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
629 Vmodule_version = build_cistring (EMODULES_VERSION); |
428 | 630 |
631 DEFVAR_BOOL ("load-modules-quietly", &load_modules_quietly /* | |
632 *Set to t if module loading is to be silent. | |
633 | |
634 Normally, when loading dynamic modules, Emacs will inform you of its | |
635 progress, and will display the module name and version if the module | |
636 is loaded correctly. Setting this variable to `t' will suppress these | |
637 messages. This would normally only be done if `load-module' was being | |
638 called by a Lisp function. | |
639 */); | |
1733 | 640 load_modules_quietly = 0; |
428 | 641 |
1750 | 642 DEFVAR_BOOL ("unloading-module", &unloading_module /* |
643 Used internally by `unload-feature'. Do not set this variable. | |
644 Danger, danger, Will Robinson! | |
645 */); | |
646 unloading_module = 0; | |
647 | |
648 #endif /* HAVE_SHLIB */ | |
649 | |
428 | 650 DEFVAR_LISP ("module-load-path", &Vmodule_load_path /* |
651 *List of directories to search for dynamic modules to load. | |
652 Each element is a string (directory name) or nil (try default directory). | |
653 | |
654 Note that elements of this list *may not* begin with "~", so you must | |
442 | 655 call `expand-file-name' on them before adding them to this list. |
428 | 656 |
657 Initialized based on EMACSMODULEPATH environment variable, if any, otherwise | |
658 to default specified the file `paths.h' when XEmacs was built. If there | |
659 were no paths specified in `paths.h', then XEmacs chooses a default | |
660 value for this variable by looking around in the file-system near the | |
661 directory in which the XEmacs executable resides. | |
662 | |
663 Due to the nature of dynamic modules, the path names should almost always | |
442 | 664 refer to architecture-dependent directories. It is unwise to attempt to |
665 store dynamic modules in a heterogenous environment. Some environments | |
428 | 666 are similar enough to each other that XEmacs will be unable to determine |
667 the correctness of a dynamic module, which can have unpredictable results | |
668 when a dynamic module is loaded. | |
669 */); | |
1733 | 670 Vmodule_load_path = Qnil; |
428 | 671 |
1733 | 672 DEFVAR_LISP ("module-extensions", &Vmodule_extensions /* |
673 *List of filename extensions to use when searching for dynamic modules. | |
674 */); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
675 Vmodule_extensions = list5 (build_ascstring (".ell"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
676 build_ascstring (".so"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
677 build_ascstring (".dll"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
678 build_ascstring (".dylib"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4528
diff
changeset
|
679 build_ascstring ("")); |
428 | 680 } |