cgit.sxemacs.org Git - sxemacs/blob - src/emodules-ng.c

   1 /*** emodules-ng.c -- Dynamic Loader routines (via ltdl)
   2  *
   3  * Copyright (C) 2007 Sebastian Freundt
   4  *
   5  * Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6  *
   7  * This file is part of SXEmacs.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  16  * 2. Redistributions in binary form must reproduce the above copyright
  17  *    notice, this list of conditions and the following disclaimer in the
  18  *    documentation and/or other materials provided with the distribution.
  19  *
  20  * 3. Neither the name of the author nor the names of any contributors
  21  *    may be used to endorse or promote products derived from this
  22  *    software without specific prior written permission.
  23  *
  24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27  * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34  * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35  *
  36  ***/
  37
  38 #include "config.h"
  39 #include <stdbool.h>
  40 #include "lisp.h"
  41 #include "sysdep.h"
  42 #include "emodules-ng.h"
  43 #include "dynacat.h"
  44
  45 #if defined HAVE_SYS_STAT_H
  46 # include <sys/stat.h>
  47 #endif
  48
  49 #if defined HAVE_LTDL_H  /* go ltdl */
  50 # include <ltdl.h>
  51 #else
  52 # error "Bugger! No code to dlopen() things"
  53 #endif
  54
  55 #define EMODNG_INIT             "init"
  56 #define EMODNG_REINIT           "reinit"
  57 #define EMODNG_DEINIT           "deinit"
  58
  59 /* this is internal administration */
  60 static lt_dlhandle meself = NULL;
  61 static emodng_t emods = NULL;
  62
  63 typedef struct emod_epcell_s /* endpoint cell */ *emod_epcell_t;
  64 static emod_epcell_t emod_endpoints = NULL;
  65
  66 struct emod_epcell_s {
  67         emodng_t emod;
  68         emod_epcell_t next;
  69 };
  70
  71 /* Do we do our work quietly? */
  72 int load_modules_quietly;
  73
  74 /* Load path */
  75 Lisp_Object Vmodule_load_path, Vmodule_extensions;
  76
  77 /* lt_dlsym() violates ISO C, so confide the breakage into this function to
  78  * avoid warnings. */
  79 typedef void(*emodng_f)(void);
  80
  81 struct emodng_lby_s {
  82         lt_dlhandle loaded_by;
  83         struct emodng_lby_s *next;
  84 };
  85
  86 struct emodng_s {
  87         const char *name;
  88         const char *truename;
  89         const char *filename;
  90         lt_dlhandle dl;
  91
  92         struct emodng_lby_s *lby;
  93
  94         emodng_init_f initf;
  95         emodng_deinit_f deinitf;
  96         emodng_reinit_f reinitf;
  97         emodng_docs_f docsf;
  98
  99         emodng_t *deps;
 100         size_t ndeps;
 101
 102         bool openedp;
 103         bool initialisedp;
 104         bool docsloadedp;
 105
 106         /* navigation info */
 107         emodng_t next;
 108 };
 109
 110 static Lisp_Object emodng_load_unwind(Lisp_Object unwind_ptr);
 111 static Lisp_Object emodng_unload_unwind(Lisp_Object unwind_ptr);
 112 static emodng_t emodng_load(const char *name, lt_dlhandle);
 113 static bool emodng_unload(const char *name);
 114 static void _emodng_open(emodng_t emod);
 115 static void _emodng_close(emodng_t emod);
 116 static void _emodng_init(emodng_t emod);
 117 static void _emodng_deinit(emodng_t emod);
 118 static void _emodng_docs(emodng_t emod);
 119 static inline emodng_t _emodng_open_dep(emodng_t emod, const char *dep)
 120         __attribute__((always_inline));
 121 static inline void _emodng_close_dep(emodng_t emod, emodng_t dep)
 122         __attribute__((always_inline));
 123
 124 \f
 125 /* some inlines and helper funs */
 126 static inline emodng_f
 127 lt_dlfun(lt_dlhandle handle, const char *symbol)
 128         __attribute__((always_inline));
 129 static inline emodng_f
 130 lt_dlfun(lt_dlhandle handle, const char *symbol)
 131 {
 132         void *tmp = lt_dlsym(handle, symbol);
 133         return (emodng_f)(long int)tmp;
 134 }
 135
 136 #if defined HAVE_STAT || 1
 137 static inline bool
 138 __file_exists_p(const char *filename)
 139 {
 140         struct stat _stbuf;
 141         return stat(filename, &_stbuf) == 0;
 142 }
 143 #endif  /* HAVE_STAT */
 144
 145 static lt_dlhandle
 146 __emodng_open_append_exts(const char *filename)
 147 {
 148         /* append all specified extensions */
 149         size_t nname = strlen(filename);
 150         char name[nname + /*length of longest extension:*/24];
 151         /* note to myself: better check that length! */
 152         char *p = xstpncpy(name, filename, nname+1);
 153
 154         for (Lisp_Object ext = Vmodule_extensions;
 155              CONSP(ext); ext = XCDR(ext)) {
 156                 if (UNLIKELY(!STRINGP(XCAR(ext)))) {
 157                         continue;
 158                 }
 159
 160                 strncpy(p, (const char*)XSTRING_DATA(XCAR(ext)),
 161                         (size_t)XSTRING_LENGTH(XCAR(ext))+1);
 162
 163                 if (__file_exists_p(name)) {
 164                         EMOD_DEBUG_LOADER("trying %s\n", name);
 165                         return lt_dlopen(name);
 166                 }
 167         }
 168         return NULL;
 169 }
 170
 171 static lt_dlhandle
 172 __emodng_open_prepend_paths(const char *filename)
 173 {
 174         /* append all specified extensions */
 175         size_t nfilename = strlen(filename);
 176
 177         /* we used to use Vmodule_load_path here */
 178         for (Lisp_Object path = Vload_path;
 179              CONSP(path); path = XCDR(path)) {
 180                 if (LIKELY((STRINGP(XCAR(path))))) {
 181                         char name[(size_t)XSTRING_LENGTH(XCAR(path))
 182                                   + 1 /*for the slash*/
 183                                   + nfilename /*for the module's actual name*/
 184                                   + 1 /*for the terminating \0 char*/];
 185                         /* note that we assume here that filename already
 186                          * carries the correct extension
 187                          * see __emodng_open_prepend_paths_append_exts for
 188                          * cope with all the combinations */
 189                         char *p;
 190                         p = xstpncpy(name,
 191                                      (const char*)XSTRING_DATA(XCAR(path)),
 192                                      (size_t)XSTRING_LENGTH(XCAR(path)));
 193                         *p++ = '/';
 194                         strncpy(p, filename, nfilename+1);
 195
 196                         if (__file_exists_p(name)) {
 197                                 EMOD_DEBUG_LOADER("trying %s\n", name);
 198                                 return lt_dlopen(name);
 199                         }
 200                 }
 201         }
 202         return NULL;
 203 }
 204
 205 static lt_dlhandle
 206 __emodng_open_prepend_paths_append_exts(const char *filename)
 207 {
 208         /* append all specified extensions */
 209         size_t nfilename = strlen(filename);
 210
 211         /* we used to use Vmodule_load_path here */
 212         for (Lisp_Object path = Vload_path;
 213              CONSP(path); path = XCDR(path)) {
 214                 if (LIKELY((STRINGP(XCAR(path))))) {
 215                         char name[(size_t)XSTRING_LENGTH(XCAR(path))
 216                                   + 1 /*for the slash*/
 217                                   + nfilename /*for the module's actual name*/
 218                                   + 24 /* for the length of the extension
 219                                         * BETTER CHECK THAT */
 220                                   + 1 /*for the terminating \0 char*/];
 221                         /* note that we assume here that filename already
 222                          * carries the correct extension
 223                          * see __emodng_open_prepend_paths_append_exts for
 224                          * cope with all the combinations */
 225                         char *p = xstpncpy(
 226                                 name,
 227                                 (const char*)XSTRING_DATA(XCAR(path)),
 228                                 (size_t)XSTRING_LENGTH(XCAR(path)));
 229                         if (*(p-1) != '/') {
 230                                 *p++ = '/';
 231                         }
 232                         p = xstpncpy(p, filename, nfilename);
 233
 234                         /* append all extensions now */
 235                         for (Lisp_Object ext = Vmodule_extensions;
 236                              CONSP(ext); ext = XCDR(ext)) {
 237                                 if (UNLIKELY(!STRINGP(XCAR(ext)))) {
 238                                         continue;
 239                                 }
 240
 241                                 strncpy(p,
 242                                         (const char*)XSTRING_DATA(XCAR(ext)),
 243                                         (size_t)XSTRING_LENGTH(XCAR(ext))+1);
 244
 245                                 if (__file_exists_p(name)) {
 246                                         EMOD_DEBUG_LOADER("trying \"%s\"\n",
 247                                                           name);
 248                                         return lt_dlopen(name);
 249                                 }
 250                         }
 251                 }
 252         }
 253         return NULL;
 254 }
 255
 256 static void
 257 __emodng_open(emodng_t emod)
 258 {
 259         /* obtain some info to massage the name of the emod */
 260         /* determine if emod->name is an absolute filename */
 261         bool abso_path_p = emod->name[0] == '/';
 262         /* determine if emod->name is a relative filename */
 263         bool rel_path_p =
 264                 strncmp(emod->name, "./", 2) == 0 ||
 265                 strncmp(emod->name, "../", 3) == 0;
 266         /* determine if emod->name carries an extension already
 267          * we search backward to an occurrence of '.' and forward for a '/'
 268          * to make sure it really belongs to the last path component */
 269         char *ext_compo = strrchr(emod->name, '.');
 270         bool has_ext_p = ext_compo != NULL && strchr(ext_compo, '/') == NULL;
 271
 272         if (LIKELY(!abso_path_p && !rel_path_p && !has_ext_p)) {
 273                 /* append both extension and paths */
 274                 emod->dl = __emodng_open_prepend_paths_append_exts(emod->name);
 275         } else if (!abso_path_p && !rel_path_p) {
 276                 /* just append paths */
 277                 emod->dl = __emodng_open_prepend_paths(emod->name);
 278         } else if (has_ext_p) {
 279                 /* fully featured file name, just dlopen() it */
 280                 emod->dl = lt_dlopen(emod->name);
 281         } else if (!has_ext_p) {
 282                 /* file name with path but sans extension */
 283                 emod->dl = __emodng_open_append_exts(emod->name);
 284         }
 285         /* actually we should cater with those relative file names
 286          * more thoroughly, I'm not sure what './' means in libltdl speak */
 287         return;
 288 }
 289
 290 static emodng_t
 291 __emodng_find_or_create(emodng_t in)
 292 {
 293 /* try to find the emodule specified by in or create one
 294  * if it cannot be found */
 295         const lt_dlinfo *info;
 296         emodng_t new;
 297
 298         /* get module info */
 299         info = lt_dlgetinfo(in->dl);
 300
 301         EMOD_DEBUG_LOADER("modinfo %s %s %d\n",
 302                           info->filename, info->name, info->ref_count);
 303
 304         for (emodng_t e = emods; e; e = e->next) {
 305                 if (info->name &&
 306                     strcmp(info->name, e->truename) == 0) {
 307                         /* bingo */
 308                         return e;
 309                 }
 310         }
 311
 312         /* otherwise we have to create this */
 313         new = xnew(struct emodng_s);
 314
 315         new->truename = xstrdup(info->name);
 316         new->filename = xstrdup(info->filename);
 317         new->name = xstrdup(in->name);
 318         new->dl = in->dl;
 319         new->openedp =  new->initialisedp = new->docsloadedp = false;
 320
 321         new->deps = in->deps;
 322         new->ndeps = in->ndeps;
 323
 324         new->next = emods;
 325         return emods = new;
 326 }
 327
 328 static emodng_t
 329 __emodng_find(const char *name)
 330 {
 331 /* try to find the emodule named `name', return its pointer or NULL */
 332         const lt_dlinfo *info;
 333         emodng_t e;
 334
 335         for (e = emods; e; e = e->next) {
 336                 if (strcmp(name, e->truename) == 0) {
 337                         /* bingo */
 338                         break;
 339                 }
 340         }
 341
 342         if (e == NULL) {
 343                 return NULL;
 344         }
 345
 346         /* get module info */
 347         info = lt_dlgetinfo(e->dl);
 348
 349         EMOD_DEBUG_LOADER("modinfo %s %s %d\n",
 350                           info->filename, info->name, info->ref_count);
 351
 352         return e;
 353 }
 354
 355 static void
 356 __emodng_remove(emodng_t emod)
 357 {
 358         /* dehorstify this ... */
 359         if (UNLIKELY(emod == NULL)) {
 360                 return;
 361         }
 362
 363         /* if emod was the top of the list, just kick it */
 364         if (emods && emod == emods) {
 365                 emods = emod->next;
 366                 return;
 367         }
 368
 369         for (emodng_t e = emods; e; e = e->next) {
 370                 if (e->next && e->next->dl == emod->dl) {
 371                         e->next = emod->next;
 372                         return;
 373                 }
 374         }
 375         return;
 376 }
 377
 378 static inline bool
 379 emod_endpoint_p(emodng_t emod)
 380 {
 381         /* a VERY sloppy approach */
 382         for (emod_epcell_t ee = emod_endpoints; ee; ee = ee->next) {
 383                 if (ee->emod == emod) {
 384                         return true;
 385                 }
 386         }
 387         return false;
 388 }
 389
 390 static inline void
 391 _register_endpoint(emodng_t emod)
 392 {
 393         emod_epcell_t new = xnew(struct emod_epcell_s);
 394
 395         new->emod = emod;
 396         new->next = emod_endpoints;
 397         emod_endpoints = new;
 398         return;
 399 }
 400
 401 static inline void
 402 _unregister_endpoint(emodng_t emod)
 403 {
 404         /* very unlikely, but dehorstify anyway */
 405         if (UNLIKELY(emod == NULL)) {
 406                 return;
 407         }
 408
 409         /* maybe we're lucky today and deal with the topmost entry ... */
 410         if (emod_endpoints && emod_endpoints->emod == emod) {
 411                 emod_epcell_t free_me = emod_endpoints;
 412                 emod_endpoints = emod_endpoints->next;
 413                 xfree(free_me);
 414                 return;
 415         }
 416
 417         /* ... gah, what a fooking mess, traverse the list */
 418         for (emod_epcell_t e = emod_endpoints; e && e->next; e = e->next) {
 419                 if (e->next->emod == emod) {
 420                         emod_epcell_t free_me = e->next;
 421                         e->next = e->next->next;
 422                         xfree(free_me);
 423                         return;
 424                 }
 425         }
 426         return;
 427 }
 428
 429 static inline void
 430 free_emodng(emodng_t emod)
 431 {
 432         xfree(emod->truename);
 433         xfree(emod->filename);
 434         xfree(emod->name);
 435         if (emod->deps) {
 436                 xfree(emod->deps);
 437         }
 438         xfree(emod);
 439 }
 440
 441 \f
 442 /* we divide the load phase into two actual phases, open and init
 443  * similarly unload is actually deinit and close (yes, in that order, horst)
 444  * it is just because we make sure about dependencies and things */
 445 static emodng_t
 446 emodng_load(const char *name, lt_dlhandle caller)
 447 {
 448 /* this is the loader chain which opens->inits->imports docs */
 449         struct emodng_s _emod = {.name = name};
 450         emodng_t emod;
 451
 452         lt_dlinit();
 453         _emodng_open(&_emod);
 454         if (UNLIKELY(_emod.dl == NULL)) {
 455                 return NULL;
 456         }
 457
 458         /* set up a real emodng_t object and put it into our global emod list */
 459         emod = __emodng_find_or_create(&_emod);
 460         emod->openedp = true;
 461
 462         _emodng_init(emod);
 463         _emodng_docs(emod);
 464
 465         return emod;
 466 }
 467
 468 static void
 469 _emodng_open(emodng_t emod)
 470 {
 471         const char **emoddeps;
 472
 473         EMOD_DEBUG_LOADER("loading %s\n", emod->name);
 474         __emodng_open(emod);
 475
 476         /* check that we're really using a valid handle */
 477         if (UNLIKELY(emod->dl == NULL)) {
 478                 error("Opening dynamic module \"%s\": %s",
 479                       emod->name, lt_dlerror());
 480         }
 481
 482         emod->deps = NULL;
 483         emod->ndeps = 0;
 484
 485         /* checking dependencies */
 486         if (LIKELY((emoddeps =
 487                     (const char**)lt_dlsym(emod->dl, "dependencies")) ||
 488                    (emoddeps =
 489                     (const char**)lt_dlsym(emod->dl, "deps")))) {
 490                 emodng_t *ed;
 491                 size_t ndeps = 0;
 492
 493                 /* count the deps manually */
 494                 for (const char **deps = emoddeps, *dep = *deps;
 495                      dep; dep = *++deps, ndeps++);
 496
 497                 if (ndeps == 0) {
 498                         return;
 499                 }
 500
 501                 /* create a big array of deps */
 502                 EMOD_DEBUG_LOADER("found %lu deps\n",
 503                                   (long unsigned int)ndeps);
 504                 ed = emod->deps = xnew_array(emodng_t, emod->ndeps = ndeps);
 505
 506                 /* load the other modules (deps) first */
 507                 for (const char **deps = emoddeps, *dep = *deps;
 508                      dep; dep = *++deps) {
 509                         *ed++ = _emodng_open_dep(emod, dep);
 510                 }
 511         } else {
 512                 EMOD_DEBUG_LOADER("no deps found ... "
 513                                   "hope this is right\n");
 514         }
 515         return;
 516 }
 517
 518 static void
 519 _emodng_init(emodng_t emod)
 520 {
 521 /* calls initialiser code in the module */
 522         if (emod->initialisedp) {
 523                 EMOD_DEBUG_LOADER("already initialised\n");
 524                 return;
 525         }
 526
 527         EMOD_DEBUG_LOADER("initialising %s\n", emod->truename);
 528         if (LIKELY((emod->initf =
 529                     (emodng_init_f)lt_dlfun(emod->dl, "init")) != NULL)) {
 530                 EMOD_DEBUG_LOADER("found init() ... calling now\n");
 531                 (*emod->initf)(emod);
 532         } else {
 533                 EMOD_DEBUG_LOADER("no init() function found ... "
 534                                   "hope this is right\n");
 535         }
 536         emod->initialisedp = true;
 537         return;
 538 }
 539
 540 static void
 541 _emodng_docs(emodng_t emod)
 542 {
 543 /* because we're lisp, we have to care for documentation strings of our loaded
 544    stuff, thus call a function docs() if present */
 545         if (emod->docsloadedp) {
 546                 EMOD_DEBUG_LOADER("already loaded doc strings\n");
 547                 return;
 548         }
 549
 550         EMOD_DEBUG_LOADER("loading docs from %s\n", emod->name);
 551         if (LIKELY((emod->docsf =
 552                     (emodng_docs_f)lt_dlfun(emod->dl, "docs")) != NULL)) {
 553                 EMOD_DEBUG_LOADER("found docs() ... calling now\n");
 554                 (*emod->docsf)(emod);
 555         } else {
 556                 EMOD_DEBUG_LOADER("no docs() function found ... "
 557                                   "hope this is right\n");
 558         }
 559         emod->docsloadedp = true;
 560         return;
 561 }
 562
 563 static inline emodng_t
 564 _emodng_open_dep(emodng_t emod, const char *dep)
 565 {
 566         EMOD_DEBUG_LOADER("module \"%s\" depends upon \"%s\", "
 567                           "hence loading \"%s\"\n",
 568                           emod->name, dep, dep);
 569         return emodng_load(dep, emod->dl);
 570 }
 571
 572 /* unloader code */
 573 static bool
 574 emodng_unload(const char *name)
 575 {
 576         emodng_t e = __emodng_find(name);
 577
 578         if (e == NULL) {
 579                 return false;
 580         } else if (!emod_endpoint_p(e)) {
 581                 error("Module %s is referenced by other modules\n",
 582                       e->truename);
 583                 return false;
 584         }
 585
 586         _unregister_endpoint(e);
 587         _emodng_deinit(e);
 588         _emodng_close(e);
 589         lt_dlexit();
 590         return true;
 591 }
 592
 593 static void
 594 _emodng_close(emodng_t emod)
 595 {
 596         const lt_dlinfo *info;
 597
 598         /* get module info */
 599         info = lt_dlgetinfo(emod->dl);
 600
 601         EMOD_DEBUG_LOADER("trying to unload %s (%d)\n",
 602                           emod->name, info->ref_count);
 603
 604         lt_dlclose(emod->dl);
 605
 606         /* close all the dep modules too */
 607         for (size_t i = 0; i < emod->ndeps; i++) {
 608                 _emodng_close_dep(emod, emod->deps[i]);
 609         }
 610
 611         if (info->ref_count == 0) {
 612                 EMOD_DEBUG_LOADER("kicking %s from the list of loaded mods\n",
 613                                   emod->name);
 614                 __emodng_remove(emod);
 615                 free_emodng(emod);
 616         }
 617         return;
 618 }
 619
 620 static void
 621 _emodng_deinit(emodng_t emod)
 622 {
 623 /* calls deinitialiser code in the module */
 624         EMOD_DEBUG_LOADER("deinitialising %s\n", emod->truename);
 625         if (LIKELY((emod->deinitf =
 626                     (emodng_init_f)lt_dlfun(emod->dl, "deinit")) != NULL)) {
 627                 EMOD_DEBUG_LOADER("found deinit() ... calling now\n");
 628                 (*emod->deinitf)(emod);
 629         } else {
 630                 EMOD_DEBUG_LOADER("no deinit() function found ... "
 631                                   "hope this is right\n");
 632         }
 633         emod->initialisedp = false;
 634         return;
 635 }
 636
 637 static inline void
 638 _emodng_close_dep(emodng_t emod, emodng_t dep)
 639 {
 640         if (UNLIKELY(dep == NULL)) {
 641                 return;
 642         }
 643
 644         EMOD_DEBUG_LOADER("module \"%s\" depended upon \"%s\", "
 645                           "hence unloading \"%s\"\n",
 646                           emod->name, dep->name, dep->truename);
 647         _emodng_close(dep);
 648         return;
 649 }
 650
 651
 652 /* unwind code in case something's wrong */
 653 static Lisp_Object
 654 emodng_load_unwind(Lisp_Object unw)
 655 {
 656         lt_dlhandle mod_handle = get_dynacat(unw);
 657
 658         /* if the handle's still vivid, drown him */
 659         if (mod_handle) {
 660                 lt_dlclose(mod_handle);
 661         }
 662         return Qnil;
 663 }
 664
 665 static Lisp_Object
 666 emodng_unload_unwind(Lisp_Object unw)
 667 {
 668         lt_dlhandle UNUSED(mod_handle) = get_dynacat(unw);
 669
 670         /* if the handle's still vivid, drown him */
 671         return Qnil;
 672 }
 673
 674 \f
 675 DEFUN("load-module-file", Fload_module_file, 1, 3, "FLoad dynamic module: ", /*
 676 Load in a C Emacs Extension module named FILE.
 677 The optional NAME and VERSION are used to identify specific modules.
 678
 679 This function is similar in intent to `load-file' except that it loads
 680 in pre-compiled C or C++ code, using dynamic shared objects.  If NAME
 681 is specified, then the module is only loaded if its internal name
 682 matches the NAME specified.  If VERSION is specified, then the module
 683 is only loaded if it matches that VERSION.  This function will check
 684 to make sure that the same module is not loaded twice.  Modules are
 685 searched for in the same way as Lisp files, except for the file
 686 extension.  For a list of valid extensions, see: `module-extensions'
 687
 688 All symbols in the shared module must be completely resolved in order
 689 for this function to be successful.  Any modules which the specified
 690 FILE depends on will be automatically loaded.  You can determine which
 691 modules have been loaded as dynamic shared objects by examining the
 692 return value of the function `list-modules'.
 693
 694 It is possible, although unwise, to unload modules using `unload-module'.
 695 The preferred mechanism for unloading or reloading modules is to quit
 696 SXEmacs, and then reload those new or changed modules that are required.
 697
 698 Messages informing you of the progress of the load are displayed unless
 699 the variable `load-modules-quietly' is non-NIL.
 700 */
 701       (file, unused1, unused2))
 702 {
 703 /* not mt-safe */
 704         const char *mod_name;
 705         int speccount = specpdl_depth();
 706         struct dynacat_s unw = {.ptr = NULL};
 707         Lisp_Object lunw = (Lisp_Object)(long)&unw;
 708         emodng_t result;
 709
 710         CHECK_STRING(file);
 711         set_lheader_implementation(&unw.lheader, &lrecord_dynacat);
 712         file = Fexpand_file_name(file, Qnil);
 713         mod_name = (const char*)XSTRING_DATA(file);
 714
 715         record_unwind_protect(emodng_load_unwind, lunw);
 716         result = emodng_load(mod_name, meself);
 717         unbind_to(speccount, Qnil);
 718
 719         if (result) {
 720                 _register_endpoint(result);
 721                 return Qt;
 722         }
 723         return Qnil;
 724 }
 725
 726 DEFUN("unload-module", Funload_module, 1, 1, 0, /*
 727 BAD JU-JU! Attempt to unload the emodule named FOO.
 728
 729 This is a dangerous operation and you should think twice before doing
 730 it.  Unloading an emodule can often result in a non-responsive,
 731 non-working, or just plain dead SXEmacs session.  It is simply not
 732 worth the risk.  Save your buffers and restart SXEmacs, it really is
 733 the safest way.
 734
 735 One last little gotcha... FOO is the _internal_ name of the emodule.
 736 The internal name is listed in `list-modules'.
 737 */
 738       (foo))
 739 {
 740 /* not mt-safe */
 741         const char *mod_name;
 742         int speccount = specpdl_depth();
 743         struct dynacat_s unw = {.ptr = NULL};
 744         Lisp_Object lunw = (Lisp_Object)(long)&unw;
 745         bool result;
 746
 747         CHECK_STRING(foo);
 748         set_lheader_implementation(&unw.lheader, &lrecord_dynacat);
 749         mod_name = (const char*)XSTRING_DATA(foo);
 750
 751         record_unwind_protect(emodng_unload_unwind, lunw);
 752         result = emodng_unload(mod_name);
 753         unbind_to(speccount, Qnil);
 754
 755         return result ? Qt : Qnil;
 756 }
 757
 758 DEFUN("list-loaded-modules", Flist_loaded_modules, 0, 0, 0,     /*
 759 Return a list of loaded modules.
 760 */
 761       ())
 762 {
 763         Lisp_Object mlist = Qnil;
 764
 765         for (emodng_t e = emods; e; e = e->next) {
 766                 mlist = Fcons(build_string(e->truename), mlist);
 767         }
 768         return mlist;
 769 }
 770
 771 void
 772 emodng_doc_subr(const char *symname, const char *doc)
 773 {
 774         Bytecount len = xstrlen(symname);
 775         Lisp_Object sym = oblookup(Vobarray, (const Bufbyte *)symname, len);
 776         Lisp_Subr *subr;
 777
 778         if (SYMBOLP(sym) && SUBRP(XSYMBOL(sym)->function)) {
 779                 EMOD_DEBUG_LOADER("trying to install docs for #'%s\n", symname);
 780                 subr = XSUBR(XSYMBOL(sym)->function);
 781 #if 1
 782                 subr->doc = xstrdup(doc);
 783 #else
 784                 subr->doc = doc;
 785 #endif
 786         } else if (!SUBRP(sym)) {
 787                 EMOD_CRITICAL("Bollocks! #'%s is not a subr\n", symname);
 788         } else if (!SYMBOLP(sym)) {
 789                 EMOD_CRITICAL("Bloody 'ell, #'%s is not even a symbol\n",
 790                               symname);
 791         }
 792         /*
 793          * FIXME: I wish there was some way to avoid the xstrdup(). Is it
 794          * possible to just set a pointer to the string, or somehow create a
 795          * symbol whose value we can point to the constant string? Can someone
 796          * look into this?
 797          */
 798         return;
 799 }
 800
 801 void
 802 emodng_doc_sym(const char *symname, const char *doc)
 803 {
 804         Bytecount len = xstrlen(symname);
 805         Lisp_Object sym = oblookup(Vobarray, (const Bufbyte *)symname, len);
 806         Lisp_Object docstr;
 807         struct gcpro gcpro1;
 808
 809         EMOD_DEBUG_LOADER("trying to install docs for '%s\n", symname);
 810
 811         if (SYMBOLP(sym)) {
 812                 docstr = build_string(doc);
 813                 GCPRO1(docstr);
 814                 Fput(sym, Qvariable_documentation, docstr);
 815                 UNGCPRO;
 816         } else if (!SYMBOLP(sym)) {
 817                 EMOD_CRITICAL("wrong doc specification\n");
 818         }
 819         return;
 820 }
 821
 822 #if defined USE_LTDL_SEARCHPATH
 823 static int
 824 _adapt_load_path(Lisp_Object sym, Lisp_Object *val,
 825                  Lisp_Object in_object, int flags)
 826 {
 827         Lisp_Object ls;
 828         size_t len = 0;
 829
 830         /* traverse once to obtain the overall length */
 831         for (len = 0, ls = *val; CONSP(ls); ls = XCDR(ls)) {
 832                 if (LIKELY((STRINGP(XCAR(ls))))) {
 833                         len += XSTRING_LENGTH(XCAR(ls)) + /*for colon*/1;
 834                 }
 835         }
 836         /* C99 we need ya! traverse to fill the searchpath */
 837         if (LIKELY(len > 0)) {
 838                 char sp[len], *p = sp;
 839
 840                 for (ls = *val; CONSP(ls); ls = XCDR(ls)) {
 841                         Lisp_Object lse = XCAR(ls);
 842                         if (LIKELY((STRINGP(lse)))) {
 843                                 p = xstpncpy(p,
 844                                              (const char*)XSTRING_DATA(lse),
 845                                              XSTRING_LENGTH(lse));
 846                                 *p++ = ':';
 847                         }
 848                 }
 849                 *--p = '\0';
 850                 lt_dlsetsearchpath(sp);
 851         } else {
 852                 lt_dlsetsearchpath(NULL);
 853         }
 854         EMOD_DEBUG_LOADER("load path %s\n", lt_dlgetsearchpath());
 855         return 0;
 856 }
 857 #endif
 858 \f
 859 void
 860 syms_of_emodng(void)
 861 {
 862         DEFSUBR(Fload_module_file);
 863         DEFSUBR(Funload_module);
 864         DEFSUBR(Flist_loaded_modules);
 865 }
 866
 867 void
 868 reinit_vars_of_emodng(void)
 869 {
 870 #if 0
 871         meself = lt_dlopen(NULL);
 872
 873         EMOD_DEBUG_LOADER("load path %s\n", lt_dlgetsearchpath());
 874 #ifdef LTDL_SYSSEARCHPATH
 875         EMOD_DEBUG_LOADER("sys path %s\n", LTDL_SYSSEARCHPATH);
 876 #endif
 877 #endif
 878 }
 879
 880 void
 881 vars_of_emodng(void)
 882 {
 883         DEFVAR_BOOL("load-modules-quietly", &load_modules_quietly       /*
 884 *Set to t if module loading is to be silent.
 885
 886 Normally, when loading dynamic modules, Emacs will inform you of its
 887 progress, and will display the module name and version if the module
 888 is loaded correctly.  Setting this variable to `t' will suppress these
 889 messages.  This would normally only be done if `load-module' was being
 890 called by a Lisp function.
 891                                                                          */ );
 892         load_modules_quietly = 0;
 893
 894 #if defined USE_LTDL_SEARCHPATH
 895         DEFVAR_LISP_MAGIC("module-load-path", &Vmodule_load_path        /*
 896 *List of directories to search for dynamic modules to load.
 897 Each element is a string (directory name) or nil (try default directory).
 898
 899 Note that elements of this list *may not* begin with "~", so you must
 900 call `expand-file-name' on them before adding them to this list.
 901
 902 Initialized based on EMACSMODULEPATH environment variable, if any, otherwise
 903 to default specified the file `paths.h' when SXEmacs was built.  If there
 904 were no paths specified in `paths.h', then SXEmacs chooses a default
 905 value for this variable by looking around in the file-system near the
 906 directory in which the SXEmacs executable resides.
 907
 908 Due to the nature of dynamic modules, the path names should almost always
 909 refer to architecture-dependent directories.  It is unwise to attempt to
 910 store dynamic modules in a heterogenous environment.  Some environments
 911 are similar enough to each other that SXEmacs will be unable to determine
 912 the correctness of a dynamic module, which can have unpredictable results
 913 when a dynamic module is loaded.
 914                                                                 */,
 915                 _adapt_load_path);
 916 #else  /* !USE_LTDL_SEARCHPATH */
 917         DEFVAR_LISP("module-load-path", &Vmodule_load_path      /*
 918 *List of directories to search for dynamic modules to load.
 919 Each element is a string (directory name) or nil (try default directory).
 920
 921 Note that elements of this list *may not* begin with "~", so you must
 922 call `expand-file-name' on them before adding them to this list.
 923
 924 Initialized based on EMACSMODULEPATH environment variable, if any, otherwise
 925 to default specified the file `paths.h' when SXEmacs was built.  If there
 926 were no paths specified in `paths.h', then SXEmacs chooses a default
 927 value for this variable by looking around in the file-system near the
 928 directory in which the SXEmacs executable resides.
 929
 930 Due to the nature of dynamic modules, the path names should almost always
 931 refer to architecture-dependent directories.  It is unwise to attempt to
 932 store dynamic modules in a heterogenous environment.  Some environments
 933 are similar enough to each other that SXEmacs will be unable to determine
 934 the correctness of a dynamic module, which can have unpredictable results
 935 when a dynamic module is loaded.
 936                                                                 */ );
 937 #endif
 938         Vmodule_load_path = Qnil;
 939
 940         DEFVAR_LISP("module-extensions", &Vmodule_extensions /*
 941 *List of filename extensions to use when searching for dynamic modules.
 942 */);
 943         Vmodule_extensions =
 944                 list5(build_string(".la"),
 945                       build_string(".so"),
 946                       build_string(".ell"),
 947                       build_string(".dll"),
 948                       build_string(".dylib"));
 949
 950         Fprovide(intern("modules"));
 951
 952         reinit_vars_of_emodng();
 953 }
 954
 955 /* emodules-ng.c ends here */