Mercurial > hg > xemacs-beta
diff src/emodules.c @ 388:aabb7f5b1c81 r21-2-9
Import from CVS: tag r21-2-9
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:09:42 +0200 |
parents | |
children | 74fd4e045ea6 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/emodules.c Mon Aug 13 11:09:42 2007 +0200 @@ -0,0 +1,579 @@ +/* emodules.c - Support routines for dynamic module loading +(C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "emodules.h" +#include "sysdll.h" + +#ifdef HAVE_SHLIB + +/* CE-Emacs version number */ +Lisp_Object Vmodule_version; + +/* Do we do our work quietly? */ +int load_modules_quietly; + +/* Load path */ +Lisp_Object Vmodule_load_path; + +typedef struct _emodules_list +{ + int used; /* Is this slot used? */ + char *soname; /* Name of the shared object loaded (full path) */ + char *modname; /* The name of the module */ + char *modver; /* The version that the module is at */ + char *modtitle; /* How the module announces itself */ + dll_handle dlhandle; /* Dynamic lib handle */ +} emodules_list; + +static int emodules_depth; +static dll_handle dlhandle; +static emodules_list *modules; +static int modnum; + +static int find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int make_or_find); +static Lisp_Object module_load_unwind (Lisp_Object); +static void attempt_module_delete (int mod); + +DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /* +Load in a C Emacs Extension module named FILE. +The optional NAME and VERSION are used to identify specific modules. + +This function is similar in intent to `load' except that it loads in +pre-compiled C or C++ code, using dynamic shared objects. If NAME is +specified, then the module is only loaded if its internal name matches +the NAME specified. If VERSION is specified, then the module is only +loaded if it matches that VERSION. This function will check to make +sure that the same module is not loaded twice. Modules are searched +for in the same way as Lisp files, except that the valid file +extensions are `.so', `.dll' or `.ell'. + +All symbols in the shared module must be completely resolved in order +for this function to be successful. Any modules which the specified +FILE depends on will be automatically loaded. You can determine which +modules have been loaded as dynamic shared objects by examining the +return value of the function `list-modules'. + +It is possible, although unwise, to unload modules using `unload-module'. +The prefered mechanism for unloading or reloading modules is to quit +XEmacs, and then reload those new or changed modules that are required. + +Messages informing you of the progress of the load are displayed unless +the variable `load-modules-quietly' is non-NIL. +*/ + (file,name,version)) +{ + char *mod, *mname, *mver; + int speccount = specpdl_depth(); + + CHECK_STRING(file); + + mod = (char *)XSTRING_DATA (file); + + if (NILP (name)) + mname = ""; + else + mname = (char *)XSTRING_DATA (name); + + if (NILP (version)) + mver = ""; + else + mver = (char *)XSTRING_DATA (version); + + dlhandle = 0; + record_unwind_protect (module_load_unwind, make_int(modnum)); + emodules_load (mod, mname, mver); + unbind_to (speccount, Qnil); + + return Qt; +} + +#ifdef DANGEROUS_NASTY_SCARY_MONSTER + +DEFUN ("unload-module", Fmodule_unload, 1, 3, 0, /* +Unload a module previously loaded with load-module. + +As with load-module, this function requires at least the module FILE, and +optionally the module NAME and VERSION to unload. It may not be possible +for the module to be unloaded from memory, as there may be Lisp objects +refering to variables inside the module code. However, once you have +requested a module to be unloaded, it will be unloaded from memory as +soon as the last reference to symbols within the module is destroyed. +*/ + (file,name,version)) +{ + int x; + char *mod, *mname, *mver; + + CHECK_STRING(file); + + mod = (char *)XSTRING_DATA (file); + + if (NILP (name)) + mname = ""; + else + mname = (char *)XSTRING_DATA (name); + + if (NILP (version)) + mver = ""; + else + mver = (char *)XSTRING_DATA (version); + + x = find_make_module (mod, mname, mver, 1); + if (x != -1) + attempt_module_delete (x); + return Qt; +} +#endif /* DANGEROUS_NASTY_SCARY_MONSTER */ + +DEFUN ("list-modules", Flist_modules, 0, 0, "", /* +Produce a list of loaded dynamic modules. + +This function will return a list of all the loaded dynamic modules. +Each element in the list is a list in the form (SONAME NAME VER DESC), +where SONAME is the name of the shared object that was loaded, NAME +is the internal module name, VER is the version of the module, and DESC +is how the module describes itself. + +This function returns a list, so you will need to assign the return value +to a variable and then examine the variable with `describe-variable'. +For example: + + (setq mylist (list-modules)) + (describe-variable 'mylist) + + +NOTE: It is possible for the same module to be loaded more than once, +at different versions. However, you should never see the same module, +with the same name and version, loaded more than once. If you do, this +is a bug, and you are encouraged to report it. +*/ + ()) +{ + Lisp_Object mlist = Qnil; + int i; + + for (i = 0; i < modnum; i++) + { + if (modules[i].used == 1) + mlist = Fcons (list4 (build_string (modules[i].soname), + build_string (modules[i].modname), + build_string (modules[i].modver), + build_string (modules[i].modtitle)), mlist); + } + + return mlist; +} + +static int +find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int mof) +{ + int i, fs = -1; + + for (i = 0; i < modnum; i++) + { + if (fs == -1 && modules[i].used == 0) + fs = i; + if (strcmp (modules[i].soname, mod) == 0) + { + if (name && name[0] && strcmp (modules[i].modname, name)) + continue; + if (ver && ver[0] && strcmp (modules[i].modver, ver)) + continue; + return i; /* Found a match */ + } + } + + if (mof) + return fs; + + if (fs != -1) + return fs; /* First free slot */ + + /* + * We only get here if we havent found a free slot and the module was + * not previously loaded. + */ + if (modules == (emodules_list *)0) + modules = (emodules_list *)xmalloc (sizeof(emodules_list)); + modnum++; + modules = xrealloc (modules, modnum * sizeof(emodules_list)); + + fs = modnum - 1; + memset (&modules[fs], 0, sizeof(emodules_list)); + return fs; +} + +static void +attempt_module_delete (int mod) +{ + if (dll_close (modules[mod].dlhandle) == 0) + { + xfree (modules[mod].soname); + xfree (modules[mod].modname); + xfree (modules[mod].modver); + xfree (modules[mod].modtitle); + modules[mod].dlhandle = 0; + modules[mod].used = 0; + } + else if (modules[mod].used > 1) + modules[mod].used = 1; /* We couldn't delete it - it stays */ +} + +static Lisp_Object +module_load_unwind (Lisp_Object upto) +{ + int x,l=0; + + /* + * First close off the current handle if it is open. + */ + if (dlhandle != 0) + dll_close (dlhandle); + dlhandle = 0; + + if (CONSP (upto)) + { + if (INTP (XCAR (upto))) + l = XINT (XCAR (upto)); + free_cons (XCONS (upto)); + } + else + l = XINT (upto); + + /* + * Here we need to go through and dlclose() (IN REVERSE ORDER!) any + * modules that were loaded as part of this load chain. We only mark + * the slots as closed if the dlclose() succeeds. + */ + for (x = modnum-1; x >= l; x--) + { + if (modules[x].used > 1) + attempt_module_delete (x); + } + emodules_depth = 0; + + return Qnil; +} + +/* + * Do the actual grunt-work of loading in a module. We first try and + * dlopen() the module. If that fails, we have an error and we bail + * out immediately. If the dlopen() succeeds, we need to check for the + * existance of certain special symbols. + * + * All modules will have complete access to the variables and functions + * defined within XEmacs itself. It is up to the module to declare any + * variables or functions it uses, however. Modules will also have access + * to other functions and variables in other loaded modules, unless they + * are defined as STATIC. + * + * We need to be very careful with how we load modules. If we encounter an + * error along the way, we need to back out completely to the point at + * which the user started. Since we can be called resursively, we need to + * take care with marking modules as loaded. When we first start loading + * modules, we set the counter to zero. As we enter the function each time, + * we incremement the counter, and before we leave we decrement it. When + * we get back down to 0, we know we are at the end of the chain and we + * can mark all the modules in the list as loaded. + * + * When we signal an error, we need to be sure to unwind all modules loaded + * thus far (but only for this module chain). It is assumed that if any + * modules in a chain fail, then they all do. This is logical, considering + * that the only time we recurse is when we have dependant modules. So in + * the error handler we take great care to close off the module chain before + * we call "error" and let the Fmodule_load unwind_protect() function handle + * the cleaning up. + */ +void +emodules_load(CONST char *module, CONST char *modname, CONST char *modver) +{ + Lisp_Object filename; + Lisp_Object foundname; + int fd, x, mpx; + char *soname, *tmod; + CONST char **f; + CONST long *ellcc_rev; + char *mver, *mname, *mtitle, *symname; + void (*modload)(void) = 0; + void (*modsyms)(void) = 0; + void (*modvars)(void) = 0; + void (*moddocs)(void) = 0; + emodules_list *mp; + struct gcpro gcpro1,gcpro2; + + filename = Qnil; + foundname = Qnil; + + emodules_depth++; + dlhandle = 0; + + if ((module == (CONST char *)0) || (module[0] == '\0')) + error ("Empty module name"); + + /* This is to get around the fact that build_string() is not declared + as taking a const char * as an argument. I HATE compiler warnings. */ + tmod = (char *)alloca (strlen (module) + 1); + strcpy (tmod, module); + + GCPRO2(filename, foundname); + filename = build_string (tmod); + fd = locate_file(Vmodule_load_path, filename, ":.ell:.so:.dll", &foundname, -1); + UNGCPRO; + + if (fd < 0) + signal_simple_error ("Cannot open dynamic module", filename); + + soname = (char *)alloca (XSTRING_LENGTH (foundname) + 1); + strcpy (soname, (char *)XSTRING_DATA (foundname)); + + dlhandle = dll_open (soname); + if (dlhandle == (dll_handle)0) + error ("Opening dynamic module: %s", dll_error (dlhandle)); + + ellcc_rev = (CONST long *)dll_variable (dlhandle, "emodule_compiler"); + if ((ellcc_rev == (CONST long *)0) || (*ellcc_rev <= 0)) + error ("Missing symbol `emodule_compiler': Invalid dynamic module"); + if (*ellcc_rev > EMODULES_REVISION) + error ("Unsupported version `%ld(%ld)': Invalid dynamic module", + *ellcc_rev, EMODULES_REVISION); + + f = (CONST char **)dll_variable (dlhandle, "emodule_name"); + if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + error ("Missing symbol `emodule_name': Invalid dynamic module"); + + mname = (char *)alloca (strlen (*f) + 1); + strcpy (mname, *f); + if (mname[0] == '\0') + error ("Empty value for `emodule_name': Invalid dynamic module"); + + f = (CONST char **)dll_variable (dlhandle, "emodule_version"); + if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + error ("Missing symbol `emodule_version': Invalid dynamic module"); + + mver = (char *)alloca (strlen (*f) + 1); + strcpy (mver, *f); + + f = (CONST char **)dll_variable (dlhandle, "emodule_title"); + if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + error ("Missing symbol `emodule_title': Invalid dynamic module"); + + mtitle = (char *)alloca (strlen (*f) + 1); + strcpy (mtitle, *f); + + symname = (char *)alloca (strlen (mname) + 15); + + strcpy (symname, "modules_of_"); + strcat (symname, mname); + modload = (void (*)(void))dll_function (dlhandle, symname); + /* + * modload is optional. If the module doesnt require other modules it can + * be left out. + */ + + strcpy (symname, "syms_of_"); + strcat (symname, mname); + modsyms = (void (*)(void))dll_function (dlhandle, symname); + if (modsyms == (void (*)(void))0) + error ("Missing symbol `%s': Invalid dynamic module", symname); + + strcpy (symname, "vars_of_"); + strcat (symname, mname); + modvars = (void (*)(void))dll_function (dlhandle, symname); + if (modvars == (void (*)(void))0) + error ("Missing symbol `%s': Invalid dynamic module", symname); + + strcpy (symname, "docs_of_"); + strcat (symname, mname); + moddocs = (void (*)(void))dll_function (dlhandle, symname); + if (moddocs == (void (*)(void))0) + error ("Missing symbol `%s': Invalid dynamic module", symname); + + if (modname && modname[0] && strcmp (modname, mname)) + error ("Module name mismatch"); + + if (modver && modver[0] && strcmp (modver, mver)) + error ("Module version mismatch"); + + /* + * Attempt to make a new slot for this module. If this really is the + * first time we are loading this module, the used member will be 0. + * If that is non-zero, we know that we have a previously loaded module + * of the same name and version, and we dont need to go any further. + */ + mpx = find_make_module (soname, mname, mver, 0); + mp = &modules[mpx]; + if (mp->used > 0) + { + emodules_depth--; + dll_close (dlhandle); + return; + } + + if (!load_modules_quietly) + message ("Loading %s v%s (%s)", mname, mver, mtitle); + + /* + * We have passed the basic initialization, and can now add this + * module to the list of modules. + */ + mp->used = emodules_depth + 1; + mp->soname = xstrdup (soname); + mp->modname = xstrdup (mname); + mp->modver = xstrdup (mver); + mp->modtitle = xstrdup (mtitle); + mp->dlhandle = dlhandle; + dlhandle = 0; + + /* + * Now we need to call the module init function and perform the various + * startup tasks. + */ + if (modload != 0) + (*modload)(); + + /* + * Now we can get the module to initialize its symbols, and then its + * variables, and lastly the documentation strings. + */ + (*modsyms)(); + (*modvars)(); + (*moddocs)(); + + if (!load_modules_quietly) + message ("Loaded module %s v%s (%s)", mname, mver, mtitle); + + + emodules_depth--; + if (emodules_depth == 0) + { + /* + * We have reached the end of the load chain. We now go through the + * list of loaded modules and mark all the valid modules as just + * that. + */ + for (x = 0; x < modnum; x++) + if (modules[x].used > 1) + modules[x].used = 1; + } +} + +void +emodules_doc_subr(CONST char *symname, CONST char *doc) +{ + Bytecount len = strlen (symname); + Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); + struct Lisp_Subr *subr; + + if (SYMBOLP(sym)) + { + subr = XSUBR( XSYMBOL(sym)->function); + subr->doc = xstrdup (doc); + } + /* + * FIXME: I wish there was some way to avoid the xstrdup(). Is it + * possible to just set a pointer to the string, or somehow create a + * symbol whose value we can point to the constant string? Can someone + * look into this? + */ +} + +void +emodules_doc_sym (CONST char *symname, CONST char *doc) +{ + Bytecount len = strlen (symname); + Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); + Lisp_Object docstr; + struct gcpro gcpro1; + + if (SYMBOLP(sym)) + { + docstr = build_string (doc); + GCPRO1(docstr); + Fput (sym, Qvariable_documentation, docstr); + UNGCPRO; + } +} + + +void +syms_of_module (void) +{ + DEFSUBR(Fload_module); + DEFSUBR(Flist_modules); +#ifdef DANGEROUS_NASTY_SCARY_MONSTER + DEFSUBR(Funload_module); +#endif +} + +void +vars_of_module (void) +{ + DEFVAR_LISP ("module-version", &Vmodule_version /* +Emacs dynamic loading mechanism version, as a string. + +This string is in the form XX.YY.ppp, where XX is the major version +number, YY is the minor version number, and ppp is the patch level. +This variable can be used to distinquish between different versions of +the dynamic loading technology used in Emacs, if required. It is not +a given that this value will be the same as the Emacs version number. +*/ ); + Vmodule_version = Fpurecopy (build_string (EMODULES_VERSION)); + + DEFVAR_BOOL ("load-modules-quietly", &load_modules_quietly /* +*Set to t if module loading is to be silent. + +Normally, when loading dynamic modules, Emacs will inform you of its +progress, and will display the module name and version if the module +is loaded correctly. Setting this variable to `t' will suppress these +messages. This would normally only be done if `load-module' was being +called by a Lisp function. +*/); + + DEFVAR_LISP ("module-load-path", &Vmodule_load_path /* +*List of directories to search for dynamic modules to load. +Each element is a string (directory name) or nil (try default directory). + +Note that elements of this list *may not* begin with "~", so you must +call `expland-file-name' on them before adding them to this list. + +Initialized based on EMACSMODULEPATH environment variable, if any, otherwise +to default specified the file `paths.h' when XEmacs was built. If there +were no paths specified in `paths.h', then XEmacs chooses a default +value for this variable by looking around in the file-system near the +directory in which the XEmacs executable resides. + +Due to the nature of dynamic modules, the path names should almost always +refer to architecture-dependant directories. It is unwise to attempt to +store dynamic modules in a hetrogenous environment. Some environments +are similar enough to each other that XEmacs will be unable to determine +the correctness of a dynamic module, which can have unpredictable results +when a dynamic module is loaded. +*/); + + load_modules_quietly = 0; + emodules_depth = 0; + modules = (emodules_list *)0; + modnum = 0; + Vmodule_load_path = Qnil; + Fprovide (intern ("modules")); +} + +#endif /* HAVE_SHLIB */ +