src/emodules.c

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