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