ext/DynaLoader/dl_aix.xs

   1 /* dl_aix.xs
   2  *
   3  * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com)
   4  *
   5  *  All I did was take Jens-Uwe Mager's libdl emulation library for
   6  *  AIX and merged it with the dl_dlopen.xs file to create a dynamic library
   7  *  package that works for AIX.
   8  *
   9  *  I did change all malloc's, free's, strdup's, calloc's to use the perl
  10  *  equilvant.  I also removed some stuff we will not need.  Call fini()
  11  *  on startup...   It can probably be trimmed more.
  12  */
  13
  14 #define PERLIO_NOT_STDIO 0
  15 #define PERL_EXT
  16 #define PERL_IN_DL_AIX_XS
  17
  18 /*
  19  * On AIX 4.3 and above the emulation layer is not needed any more, and
  20  * indeed if perl uses its emulation and perl is linked into apache
  21  * which is supposed to use the native dlopen conflicts arise.
  22  * Jens-Uwe Mager jum@helios.de
  23  */
  24 #ifdef USE_NATIVE_DLOPEN
  25
  26 #include "EXTERN.h"
  27 #include "perl.h"
  28 #include "XSUB.h"
  29 #include <dlfcn.h>
  30
  31 #include "dlutils.c"    /* SaveError() etc      */
  32
  33 #else
  34
  35 /*
  36  * @(#)dlfcn.c  1.5 revision of 93/02/14  20:14:17
  37  * This is an unpublished work copyright (c) 1992 Helios Software GmbH
  38  * 3000 Hannover 1, Germany
  39  */
  40 #include "EXTERN.h"
  41 #include "perl.h"
  42 #include "XSUB.h"
  43
  44 /* When building as a 64-bit binary on AIX, define this to get the
  45  * correct structure definitions.  Also determines the field-name
  46  * macros and gates some logic in readEntries().  -- Steven N. Hirsch
  47  * <hirschs@btv.ibm.com> */
  48 #ifdef USE_64_BIT_ALL
  49 #   define __XCOFF64__
  50 #   define __XCOFF32__
  51 #endif
  52
  53 #include <stdio.h>
  54 #include <errno.h>
  55 #include <string.h>
  56 #include <stdlib.h>
  57 #include <sys/types.h>
  58 #include <sys/ldr.h>
  59 #include <a.out.h>
  60 #undef FREAD
  61 #undef FWRITE
  62 #include <ldfcn.h>
  63
  64 #ifdef USE_64_BIT_ALL
  65 #   define AIX_SCNHDR SCNHDR_64
  66 #   define AIX_LDHDR LDHDR_64
  67 #   define AIX_LDSYM LDSYM_64
  68 #   define AIX_LDHDRSZ LDHDRSZ_64
  69 #else
  70 #   define AIX_SCNHDR SCNHDR
  71 #   define AIX_LDHDR LDHDR
  72 #   define AIX_LDSYM LDSYM
  73 #   define AIX_LDHDRSZ LDHDRSZ
  74 #endif
  75
  76 /* When using Perl extensions written in C++ the longer versions
  77  * of load() and unload() from libC and libC_r need to be used,
  78  * otherwise statics in the extensions won't get initialized right.
  79  * -- Stephanie Beals <bealzy@us.ibm.com> */
  80
  81 /* Older AIX C compilers cannot deal with C++ double-slash comments in
  82    the ibmcxx and/or xlC includes.  Since we only need a single file,
  83    be more fine-grained about what's included <hirschs@btv.ibm.com> */
  84
  85 #ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */
  86 #   define LOAD   loadAndInit
  87 #   define UNLOAD terminateAndUnload
  88 #   if defined(USE_vacpp_load_h)
  89 #       include "/usr/vacpp/include/load.h"
  90 #   elif defined(USE_ibmcxx_load_h)
  91 #       include "/usr/ibmcxx/include/load.h"
  92 #   elif defined(USE_xlC_load_h)
  93 #       include "/usr/lpp/xlC/include/load.h"
  94 #   elif defined(USE_load_h)
  95 #       include "/usr/include/load.h"
  96 #   endif
  97 #else
  98 #   define LOAD   load
  99 #   define UNLOAD unload
 100 #endif
 101
 102 /*
 103  * AIX 4.3 does remove some useful definitions from ldfcn.h. Define
 104  * these here to compensate for that lossage.
 105  */
 106 #ifndef BEGINNING
 107 # define BEGINNING SEEK_SET
 108 #endif
 109 #ifndef FSEEK
 110 # define FSEEK(ldptr,o,p)       fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p)
 111 #endif
 112 #ifndef FREAD
 113 # define FREAD(p,s,n,ldptr)     fread(p,s,n,IOPTR(ldptr))
 114 #endif
 115
 116 #ifndef RTLD_LAZY
 117 # define RTLD_LAZY 0
 118 #endif
 119 #ifndef RTLD_GLOBAL
 120 # define RTLD_GLOBAL 0
 121 #endif
 122
 123 /*
 124  * We simulate dlopen() et al. through a call to load. Because AIX has
 125  * no call to find an exported symbol we read the loader section of the
 126  * loaded module and build a list of exported symbols and their virtual
 127  * address.
 128  */
 129
 130 typedef struct {
 131         char            *name;          /* the symbols's name */
 132         void            *addr;          /* its relocated virtual address */
 133 } Export, *ExportPtr;
 134
 135 /*
 136  * The void * handle returned from dlopen is actually a ModulePtr.
 137  */
 138 typedef struct Module {
 139         struct Module   *next;
 140         char            *name;          /* module name for refcounting */
 141         int             refCnt;         /* the number of references */
 142         void            *entry;         /* entry point from load */
 143         int             nExports;       /* the number of exports found */
 144         ExportPtr       exports;        /* the array of exports */
 145 } Module, *ModulePtr;
 146
 147 typedef struct {
 148     /*
 149      * We keep a list of all loaded modules to be able to reference count
 150      * duplicate dlopen's.
 151      */
 152     ModulePtr   x_modList;
 153
 154     /*
 155      * The last error from one of the dl* routines is kept in static
 156      * variables here. Each error is returned only once to the caller.
 157      */
 158     char        x_errbuf[BUFSIZ];
 159     int         x_errvalid;
 160     void *      x_mainModule;
 161 } my_cxtx_t;            /* this *must* be named my_cxtx_t */
 162
 163 #define DL_CXT_EXTRA    /* ask for dl_cxtx to be defined in dlutils.c */
 164 #include "dlutils.c"    /* SaveError() etc      */
 165
 166 #define dl_modList      (dl_cxtx.x_modList)
 167 #define dl_errbuf       (dl_cxtx.x_errbuf)
 168 #define dl_errvalid     (dl_cxtx.x_errvalid)
 169 #define dl_mainModule   (dl_cxtx.x_mainModule)
 170
 171 static void caterr(char *);
 172 static int readExports(ModulePtr);
 173 static void *findMain(void);
 174
 175 /* these statics are ok because they're constants */
 176 static char *strerror_failed   = "(strerror failed)";
 177 static char *strerror_r_failed = "(strerror_r failed)";
 178
 179 char *strerrorcat(char *str, int err) {
 180     int strsiz = strlen(str);
 181     int msgsiz;
 182     char *msg;
 183
 184     dTHX;
 185
 186     if ((msg = strerror(err)) == 0)
 187       msg = strerror_failed;
 188     msgsiz = strlen(msg);               /* Note msg = buf and free() above. */
 189     if (strsiz + msgsiz < BUFSIZ)       /* Do not move this after #endif. */
 190       strcat(str, msg);
 191
 192     return str;
 193 }
 194
 195 char *strerrorcpy(char *str, int err) {
 196     int msgsiz;
 197     char *msg;
 198
 199     dTHX;
 200
 201     if ((msg = strerror(err)) == 0)
 202       msg = strerror_failed;
 203     msgsiz = strlen(msg);       /* Note msg = buf and free() above. */
 204     if (msgsiz < BUFSIZ)        /* Do not move this after #endif. */
 205       strcpy(str, msg);
 206
 207     return str;
 208 }
 209
 210 /* ARGSUSED */
 211 void *dlopen(char *path, int mode)
 212 {
 213         dTHX;
 214         dMY_CXT;
 215         ModulePtr mp;
 216
 217         /*
 218          * Upon the first call register a terminate handler that will
 219          * close all libraries.
 220          */
 221         if (dl_mainModule == NULL) {
 222                 if ((dl_mainModule = findMain()) == NULL)
 223                         return NULL;
 224         }
 225         /*
 226          * Scan the list of modules if have the module already loaded.
 227          */
 228         for (mp = dl_modList; mp; mp = mp->next)
 229                 if (strcmp(mp->name, path) == 0) {
 230                         mp->refCnt++;
 231                         return mp;
 232                 }
 233         Newxz(mp,1,Module);
 234         if (mp == NULL) {
 235                 dl_errvalid++;
 236                 strcpy(dl_errbuf, "Newz: ");
 237                 strerrorcat(dl_errbuf, errno);
 238                 return NULL;
 239         }
 240
 241         if ((mp->name = savepv(path)) == NULL) {
 242                 dl_errvalid++;
 243                 strcpy(dl_errbuf, "savepv: ");
 244                 strerrorcat(dl_errbuf, errno);
 245                 safefree(mp);
 246                 return NULL;
 247         }
 248
 249         /*
 250          * load should be declared load(const char *...). Thus we
 251          * cast the path to a normal char *. Ugly.
 252          */
 253         if ((mp->entry = (void *)LOAD((char *)path,
 254 #ifdef L_LIBPATH_EXEC
 255                                       L_LIBPATH_EXEC |
 256 #endif
 257                                       L_NOAUTODEFER,
 258                                       NULL)) == NULL) {
 259                 int saverrno = errno;
 260
 261                 safefree(mp->name);
 262                 safefree(mp);
 263                 dl_errvalid++;
 264                 strcpy(dl_errbuf, "dlopen: ");
 265                 strcat(dl_errbuf, path);
 266                 strcat(dl_errbuf, ": ");
 267                 /*
 268                  * If AIX says the file is not executable, the error
 269                  * can be further described by querying the loader about
 270                  * the last error.
 271                  */
 272                 if (saverrno == ENOEXEC) {
 273                         char *moreinfo[BUFSIZ/sizeof(char *)];
 274                         if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1)
 275                                 strerrorcpy(dl_errbuf, saverrno);
 276                         else {
 277                                 char **p;
 278                                 for (p = moreinfo; *p; p++)
 279                                         caterr(*p);
 280                         }
 281                 } else
 282                         strerrorcat(dl_errbuf, saverrno);
 283                 return NULL;
 284         }
 285         mp->refCnt = 1;
 286         mp->next = dl_modList;
 287         dl_modList = mp;
 288         /*
 289          * Assume anonymous exports come from the module this dlopen
 290          * is linked into, that holds true as long as dlopen and all
 291          * of the perl core are in the same shared object. Also bind
 292          * against the main part, in the case a perl is not the main
 293          * part, e.g mod_perl as DSO in Apache so perl modules can
 294          * also reference Apache symbols.
 295          */
 296         if (loadbind(0, (void *)dlopen, mp->entry) == -1 ||
 297             loadbind(0, dl_mainModule, mp->entry)) {
 298                 int saverrno = errno;
 299
 300                 dlclose(mp);
 301                 dl_errvalid++;
 302                 strcpy(dl_errbuf, "loadbind: ");
 303                 strerrorcat(dl_errbuf, saverrno);
 304                 return NULL;
 305         }
 306         if (readExports(mp) == -1) {
 307                 dlclose(mp);
 308                 return NULL;
 309         }
 310         return mp;
 311 }
 312
 313 /*
 314  * Attempt to decipher an AIX loader error message and append it
 315  * to our static error message buffer.
 316  */
 317 static void caterr(char *s)
 318 {
 319         dTHX;
 320         dMY_CXT;
 321         char *p = s;
 322
 323         while (*p >= '0' && *p <= '9')
 324                 p++;
 325         switch(atoi(s)) {
 326         case L_ERROR_TOOMANY:
 327                 strcat(dl_errbuf, "too many errors");
 328                 break;
 329         case L_ERROR_NOLIB:
 330                 strcat(dl_errbuf, "can't load library");
 331                 strcat(dl_errbuf, p);
 332                 break;
 333         case L_ERROR_UNDEF:
 334                 strcat(dl_errbuf, "can't find symbol");
 335                 strcat(dl_errbuf, p);
 336                 break;
 337         case L_ERROR_RLDBAD:
 338                 strcat(dl_errbuf, "bad RLD");
 339                 strcat(dl_errbuf, p);
 340                 break;
 341         case L_ERROR_FORMAT:
 342                 strcat(dl_errbuf, "bad exec format in");
 343                 strcat(dl_errbuf, p);
 344                 break;
 345         case L_ERROR_ERRNO:
 346                 strerrorcat(dl_errbuf, atoi(++p));
 347                 break;
 348         default:
 349                 strcat(dl_errbuf, s);
 350                 break;
 351         }
 352 }
 353
 354 void *dlsym(void *handle, const char *symbol)
 355 {
 356         dTHX;
 357         dMY_CXT;
 358         ModulePtr mp = (ModulePtr)handle;
 359         ExportPtr ep;
 360         int i;
 361
 362         /*
 363          * Could speed up search, but I assume that one assigns
 364          * the result to function pointers anyways.
 365          */
 366         for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 367                 if (strcmp(ep->name, symbol) == 0)
 368                         return ep->addr;
 369         dl_errvalid++;
 370         strcpy(dl_errbuf, "dlsym: undefined symbol ");
 371         strcat(dl_errbuf, symbol);
 372         return NULL;
 373 }
 374
 375 char *dlerror(void)
 376 {
 377         dTHX;
 378         dMY_CXT;
 379         if (dl_errvalid) {
 380                 dl_errvalid = 0;
 381                 return dl_errbuf;
 382         }
 383         return NULL;
 384 }
 385
 386 int dlclose(void *handle)
 387 {
 388         dTHX;
 389         dMY_CXT;
 390         ModulePtr mp = (ModulePtr)handle;
 391         int result;
 392         ModulePtr mp1;
 393
 394         if (--mp->refCnt > 0)
 395                 return 0;
 396         result = UNLOAD(mp->entry);
 397         if (result == -1) {
 398                 dl_errvalid++;
 399                 strerrorcpy(dl_errbuf, errno);
 400         }
 401         if (mp->exports) {
 402                 ExportPtr ep;
 403                 int i;
 404                 for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 405                         if (ep->name)
 406                                 safefree(ep->name);
 407                 safefree(mp->exports);
 408         }
 409         if (mp == dl_modList)
 410                 dl_modList = mp->next;
 411         else {
 412                 for (mp1 = dl_modList; mp1; mp1 = mp1->next)
 413                         if (mp1->next == mp) {
 414                                 mp1->next = mp->next;
 415                                 break;
 416                         }
 417         }
 418         safefree(mp->name);
 419         safefree(mp);
 420         return result;
 421 }
 422
 423 /* Added by Wayne Scott
 424  * This is needed because the ldopen system call calls
 425  * calloc to allocated a block of date.  The ldclose call calls free.
 426  * Without this we get this system calloc and perl's free, resulting
 427  * in a "Bad free" message.  This way we always use perl's malloc.
 428  */
 429 void *calloc(size_t ne, size_t sz)
 430 {
 431   void *out;
 432
 433   out = (void *) safemalloc(ne*sz);
 434   memzero(out, ne*sz);
 435   return(out);
 436 }
 437
 438 /*
 439  * Build the export table from the XCOFF .loader section.
 440  */
 441 static int readExports(ModulePtr mp)
 442 {
 443         dTHX;
 444         dMY_CXT;
 445         LDFILE *ldp = NULL;
 446         AIX_SCNHDR sh;
 447         AIX_LDHDR *lhp;
 448         char *ldbuf;
 449         AIX_LDSYM *ls;
 450         int i;
 451         ExportPtr ep;
 452
 453         if ((ldp = ldopen(mp->name, ldp)) == NULL) {
 454                 struct ld_info *lp;
 455                 char *buf;
 456                 int size = 4*1024;
 457                 if (errno != ENOENT) {
 458                         dl_errvalid++;
 459                         strcpy(dl_errbuf, "readExports: ");
 460                         strerrorcat(dl_errbuf, errno);
 461                         return -1;
 462                 }
 463                 /*
 464                  * The module might be loaded due to the LIBPATH
 465                  * environment variable. Search for the loaded
 466                  * module using L_GETINFO.
 467                  */
 468                 if ((buf = safemalloc(size)) == NULL) {
 469                         dl_errvalid++;
 470                         strcpy(dl_errbuf, "readExports: ");
 471                         strerrorcat(dl_errbuf, errno);
 472                         return -1;
 473                 }
 474                 while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 475                         safefree(buf);
 476                         size += 4*1024;
 477                         if ((buf = safemalloc(size)) == NULL) {
 478                                 dl_errvalid++;
 479                                 strcpy(dl_errbuf, "readExports: ");
 480                                 strerrorcat(dl_errbuf, errno);
 481                                 return -1;
 482                         }
 483                 }
 484                 if (i == -1) {
 485                         dl_errvalid++;
 486                         strcpy(dl_errbuf, "readExports: ");
 487                         strerrorcat(dl_errbuf, errno);
 488                         safefree(buf);
 489                         return -1;
 490                 }
 491                 /*
 492                  * Traverse the list of loaded modules. The entry point
 493                  * returned by LOAD() does actually point to the data
 494                  * segment origin.
 495                  */
 496                 lp = (struct ld_info *)buf;
 497                 while (lp) {
 498                         if (lp->ldinfo_dataorg == mp->entry) {
 499                                 ldp = ldopen(lp->ldinfo_filename, ldp);
 500                                 break;
 501                         }
 502                         if (lp->ldinfo_next == 0)
 503                                 lp = NULL;
 504                         else
 505                                 lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
 506                 }
 507                 safefree(buf);
 508                 if (!ldp) {
 509                         dl_errvalid++;
 510                         strcpy(dl_errbuf, "readExports: ");
 511                         strerrorcat(dl_errbuf, errno);
 512                         return -1;
 513                 }
 514         }
 515 #ifdef USE_64_BIT_ALL
 516         if (TYPE(ldp) != U803XTOCMAGIC) {
 517 #else
 518         if (TYPE(ldp) != U802TOCMAGIC) {
 519 #endif
 520                 dl_errvalid++;
 521                 strcpy(dl_errbuf, "readExports: bad magic");
 522                 while(ldclose(ldp) == FAILURE)
 523                         ;
 524                 return -1;
 525         }
 526         if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
 527                 dl_errvalid++;
 528                 strcpy(dl_errbuf, "readExports: cannot read loader section header");
 529                 while(ldclose(ldp) == FAILURE)
 530                         ;
 531                 return -1;
 532         }
 533         /*
 534          * We read the complete loader section in one chunk, this makes
 535          * finding long symbol names residing in the string table easier.
 536          */
 537         if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
 538                 dl_errvalid++;
 539                 strcpy(dl_errbuf, "readExports: ");
 540                 strerrorcat(dl_errbuf, errno);
 541                 while(ldclose(ldp) == FAILURE)
 542                         ;
 543                 return -1;
 544         }
 545         if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
 546                 dl_errvalid++;
 547                 strcpy(dl_errbuf, "readExports: cannot seek to loader section");
 548                 safefree(ldbuf);
 549                 while(ldclose(ldp) == FAILURE)
 550                         ;
 551                 return -1;
 552         }
 553 /* This first case is a hack, since it assumes that the 3rd parameter to
 554    FREAD is 1. See the redefinition of FREAD above to see how this works. */
 555         if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
 556                 dl_errvalid++;
 557                 strcpy(dl_errbuf, "readExports: cannot read loader section");
 558                 safefree(ldbuf);
 559                 while(ldclose(ldp) == FAILURE)
 560                         ;
 561                 return -1;
 562         }
 563         lhp = (AIX_LDHDR *)ldbuf;
 564         ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 565         /*
 566          * Count the number of exports to include in our export table.
 567          */
 568         for (i = lhp->l_nsyms; i; i--, ls++) {
 569                 if (!LDR_EXPORT(*ls))
 570                         continue;
 571                 mp->nExports++;
 572         }
 573         Newxz(mp->exports, mp->nExports, Export);
 574         if (mp->exports == NULL) {
 575                 dl_errvalid++;
 576                 strcpy(dl_errbuf, "readExports: ");
 577                 strerrorcat(dl_errbuf, errno);
 578                 safefree(ldbuf);
 579                 while(ldclose(ldp) == FAILURE)
 580                         ;
 581                 return -1;
 582         }
 583         /*
 584          * Fill in the export table. All entries are relative to
 585          * the entry point we got from load.
 586          */
 587         ep = mp->exports;
 588         ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 589         for (i = lhp->l_nsyms; i; i--, ls++) {
 590                 char *symname;
 591                 if (!LDR_EXPORT(*ls))
 592                         continue;
 593 #ifndef USE_64_BIT_ALL
 594                 if (ls->l_zeroes == 0)
 595 #endif
 596                         symname = ls->l_offset+lhp->l_stoff+ldbuf;
 597 #ifndef USE_64_BIT_ALL
 598                 else
 599                         symname = ls->l_name;
 600 #endif
 601                 ep->name = savepv(symname);
 602                 ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
 603                 ep++;
 604         }
 605         safefree(ldbuf);
 606         while(ldclose(ldp) == FAILURE)
 607                 ;
 608         return 0;
 609 }
 610
 611 /*
 612  * Find the main modules entry point. This is used as export pointer
 613  * for loadbind() to be able to resolve references to the main part.
 614  */
 615 static void * findMain(void)
 616 {
 617         dTHX;
 618         dMY_CXT;
 619         struct ld_info *lp;
 620         char *buf;
 621         int size = 4*1024;
 622         int i;
 623         void *ret;
 624
 625         if ((buf = safemalloc(size)) == NULL) {
 626                 dl_errvalid++;
 627                 strcpy(dl_errbuf, "findMain: ");
 628                 strerrorcat(dl_errbuf, errno);
 629                 return NULL;
 630         }
 631         while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 632                 safefree(buf);
 633                 size += 4*1024;
 634                 if ((buf = safemalloc(size)) == NULL) {
 635                         dl_errvalid++;
 636                         strcpy(dl_errbuf, "findMain: ");
 637                         strerrorcat(dl_errbuf, errno);
 638                         return NULL;
 639                 }
 640         }
 641         if (i == -1) {
 642                 dl_errvalid++;
 643                 strcpy(dl_errbuf, "findMain: ");
 644                 strerrorcat(dl_errbuf, errno);
 645                 safefree(buf);
 646                 return NULL;
 647         }
 648         /*
 649          * The first entry is the main module. The entry point
 650          * returned by load() does actually point to the data
 651          * segment origin.
 652          */
 653         lp = (struct ld_info *)buf;
 654         ret = lp->ldinfo_dataorg;
 655         safefree(buf);
 656         return ret;
 657 }
 658 #endif /* USE_NATIVE_DLOPEN */
 659
 660 /* dl_dlopen.xs
 661  *
 662  * Platform:    SunOS/Solaris, possibly others which use dlopen.
 663  * Author:      Paul Marquess (Paul.Marquess@btinternet.com)
 664  * Created:     10th July 1994
 665  *
 666  * Modified:
 667  * 15th July 1994   - Added code to explicitly save any error messages.
 668  * 3rd August 1994  - Upgraded to v3 spec.
 669  * 9th August 1994  - Changed to use IV
 670  * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
 671  *                    basic FreeBSD support, removed ClearError
 672  *
 673  */
 674
 675 /* Porting notes:
 676
 677         see dl_dlopen.xs
 678
 679 */
 680
 681 static void
 682 dl_private_init(pTHX)
 683 {
 684     (void)dl_generic_private_init(aTHX);
 685 }
 686
 687 MODULE = DynaLoader     PACKAGE = DynaLoader
 688
 689 BOOT:
 690     (void)dl_private_init(aTHX);
 691
 692
 693 void
 694 dl_load_file(filename, flags=0)
 695         char *  filename
 696         int     flags
 697         PREINIT:
 698         void *retv;
 699         PPCODE:
 700         DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
 701         if (flags & 0x01)
 702             Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 703         retv = dlopen(filename, RTLD_GLOBAL|RTLD_LAZY) ;
 704         DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", retv));
 705         ST(0) = sv_newmortal() ;
 706         if (retv == NULL)
 707             SaveError(aTHX_ "%s",dlerror()) ;
 708         else
 709             sv_setiv( ST(0), PTR2IV(retv) );
 710         XSRETURN(1);
 711
 712 int
 713 dl_unload_file(libref)
 714     void *      libref
 715   CODE:
 716     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
 717     RETVAL = (dlclose(libref) == 0 ? 1 : 0);
 718     if (!RETVAL)
 719         SaveError(aTHX_ "%s", dlerror()) ;
 720     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
 721   OUTPUT:
 722     RETVAL
 723
 724 void
 725 dl_find_symbol(libhandle, symbolname, ign_err=0)
 726         void *          libhandle
 727         char *          symbolname
 728         int             ign_err
 729         PREINIT:
 730         void *retv;
 731         CODE:
 732         DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
 733                 libhandle, symbolname));
 734         retv = dlsym(libhandle, symbolname);
 735         DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", retv));
 736         ST(0) = sv_newmortal();
 737         if (retv == NULL) {
 738             if (!ign_err)
 739                 SaveError(aTHX_ "%s", dlerror());
 740         } else
 741             sv_setiv( ST(0), PTR2IV(retv));
 742
 743
 744 void
 745 dl_undef_symbols()
 746         CODE:
 747
 748
 749
 750 # These functions should not need changing on any platform:
 751
 752 void
 753 dl_install_xsub(perl_name, symref, filename="$Package")
 754     char *      perl_name
 755     void *      symref
 756     const char *        filename
 757     CODE:
 758     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
 759         perl_name, symref));
 760     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
 761                                               (void(*)(pTHX_ CV *))symref,
 762                                               filename, NULL,
 763                                               XS_DYNAMIC_FILENAME)));
 764
 765
 766 SV *
 767 dl_error()
 768     CODE:
 769     dMY_CXT;
 770     RETVAL = newSVsv(MY_CXT.x_dl_last_error);
 771     OUTPUT:
 772     RETVAL
 773
 774 #if defined(USE_ITHREADS)
 775
 776 void
 777 CLONE(...)
 778     CODE:
 779     MY_CXT_CLONE;
 780
 781     PERL_UNUSED_VAR(items);
 782
 783     /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
 784      * using Perl variables that belong to another thread, we create our
 785      * own for this thread.
 786      */
 787     MY_CXT.x_dl_last_error = newSVpvs("");
 788
 789 #endif
 790
 791 # end.