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