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