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