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 #ifdef USE_5005THREADS
 183     char *buf = malloc(BUFSIZ);
 184
 185     if (buf == 0)
 186       return 0;
 187     if (strerror_r(err, buf, BUFSIZ) == 0)
 188       msg = buf;
 189     else
 190       msg = strerror_r_failed;
 191     msgsiz = strlen(msg);
 192     if (strsiz + msgsiz < BUFSIZ)
 193       strcat(str, msg);
 194     free(buf);
 195 #else
 196     dTHX;
 197
 198     if ((msg = strerror(err)) == 0)
 199       msg = strerror_failed;
 200     msgsiz = strlen(msg);               /* Note msg = buf and free() above. */
 201     if (strsiz + msgsiz < BUFSIZ)       /* Do not move this after #endif. */
 202       strcat(str, msg);
 203 #endif
 204
 205     return str;
 206 }
 207
 208 char *strerrorcpy(char *str, int err) {
 209     int msgsiz;
 210     char *msg;
 211
 212 #ifdef USE_5005THREADS
 213     char *buf = malloc(BUFSIZ);
 214
 215     if (buf == 0)
 216       return 0;
 217     if (strerror_r(err, buf, BUFSIZ) == 0)
 218       msg = buf;
 219     else
 220       msg = strerror_r_failed;
 221     msgsiz = strlen(msg);
 222     if (msgsiz < BUFSIZ)
 223       strcpy(str, msg);
 224     free(buf);
 225 #else
 226     dTHX;
 227
 228     if ((msg = strerror(err)) == 0)
 229       msg = strerror_failed;
 230     msgsiz = strlen(msg);       /* Note msg = buf and free() above. */
 231     if (msgsiz < BUFSIZ)        /* Do not move this after #endif. */
 232       strcpy(str, msg);
 233 #endif
 234
 235     return str;
 236 }
 237
 238 /* ARGSUSED */
 239 void *dlopen(char *path, int mode)
 240 {
 241         dTHX;
 242         dMY_CXT;
 243         register ModulePtr mp;
 244
 245         /*
 246          * Upon the first call register a terminate handler that will
 247          * close all libraries.
 248          */
 249         if (dl_mainModule == NULL) {
 250                 if ((dl_mainModule = findMain()) == NULL)
 251                         return NULL;
 252         }
 253         /*
 254          * Scan the list of modules if have the module already loaded.
 255          */
 256         for (mp = dl_modList; mp; mp = mp->next)
 257                 if (strcmp(mp->name, path) == 0) {
 258                         mp->refCnt++;
 259                         return mp;
 260                 }
 261         Newz(1000,mp,1,Module);
 262         if (mp == NULL) {
 263                 dl_errvalid++;
 264                 strcpy(dl_errbuf, "Newz: ");
 265                 strerrorcat(dl_errbuf, errno);
 266                 return NULL;
 267         }
 268
 269         if ((mp->name = savepv(path)) == NULL) {
 270                 dl_errvalid++;
 271                 strcpy(dl_errbuf, "savepv: ");
 272                 strerrorcat(dl_errbuf, errno);
 273                 safefree(mp);
 274                 return NULL;
 275         }
 276
 277         /*
 278          * load should be declared load(const char *...). Thus we
 279          * cast the path to a normal char *. Ugly.
 280          */
 281         if ((mp->entry = (void *)LOAD((char *)path,
 282 #ifdef L_LIBPATH_EXEC
 283                                       L_LIBPATH_EXEC |
 284 #endif
 285                                       L_NOAUTODEFER,
 286                                       NULL)) == NULL) {
 287                 int saverrno = errno;
 288
 289                 safefree(mp->name);
 290                 safefree(mp);
 291                 dl_errvalid++;
 292                 strcpy(dl_errbuf, "dlopen: ");
 293                 strcat(dl_errbuf, path);
 294                 strcat(dl_errbuf, ": ");
 295                 /*
 296                  * If AIX says the file is not executable, the error
 297                  * can be further described by querying the loader about
 298                  * the last error.
 299                  */
 300                 if (saverrno == ENOEXEC) {
 301                         char *moreinfo[BUFSIZ/sizeof(char *)];
 302                         if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1)
 303                                 strerrorcpy(dl_errbuf, saverrno);
 304                         else {
 305                                 char **p;
 306                                 for (p = moreinfo; *p; p++)
 307                                         caterr(*p);
 308                         }
 309                 } else
 310                         strerrorcat(dl_errbuf, saverrno);
 311                 return NULL;
 312         }
 313         mp->refCnt = 1;
 314         mp->next = dl_modList;
 315         dl_modList = mp;
 316         /*
 317          * Assume anonymous exports come from the module this dlopen
 318          * is linked into, that holds true as long as dlopen and all
 319          * of the perl core are in the same shared object. Also bind
 320          * against the main part, in the case a perl is not the main
 321          * part, e.g mod_perl as DSO in Apache so perl modules can
 322          * also reference Apache symbols.
 323          */
 324         if (loadbind(0, (void *)dlopen, mp->entry) == -1 ||
 325             loadbind(0, dl_mainModule, mp->entry)) {
 326                 int saverrno = errno;
 327
 328                 dlclose(mp);
 329                 dl_errvalid++;
 330                 strcpy(dl_errbuf, "loadbind: ");
 331                 strerrorcat(dl_errbuf, saverrno);
 332                 return NULL;
 333         }
 334         if (readExports(mp) == -1) {
 335                 dlclose(mp);
 336                 return NULL;
 337         }
 338         return mp;
 339 }
 340
 341 /*
 342  * Attempt to decipher an AIX loader error message and append it
 343  * to our static error message buffer.
 344  */
 345 static void caterr(char *s)
 346 {
 347         dTHX;
 348         dMY_CXT;
 349         register char *p = s;
 350
 351         while (*p >= '0' && *p <= '9')
 352                 p++;
 353         switch(atoi(s)) {
 354         case L_ERROR_TOOMANY:
 355                 strcat(dl_errbuf, "too many errors");
 356                 break;
 357         case L_ERROR_NOLIB:
 358                 strcat(dl_errbuf, "can't load library");
 359                 strcat(dl_errbuf, p);
 360                 break;
 361         case L_ERROR_UNDEF:
 362                 strcat(dl_errbuf, "can't find symbol");
 363                 strcat(dl_errbuf, p);
 364                 break;
 365         case L_ERROR_RLDBAD:
 366                 strcat(dl_errbuf, "bad RLD");
 367                 strcat(dl_errbuf, p);
 368                 break;
 369         case L_ERROR_FORMAT:
 370                 strcat(dl_errbuf, "bad exec format in");
 371                 strcat(dl_errbuf, p);
 372                 break;
 373         case L_ERROR_ERRNO:
 374                 strerrorcat(dl_errbuf, atoi(++p));
 375                 break;
 376         default:
 377                 strcat(dl_errbuf, s);
 378                 break;
 379         }
 380 }
 381
 382 void *dlsym(void *handle, const char *symbol)
 383 {
 384         dTHX;
 385         dMY_CXT;
 386         register ModulePtr mp = (ModulePtr)handle;
 387         register ExportPtr ep;
 388         register int i;
 389
 390         /*
 391          * Could speed up search, but I assume that one assigns
 392          * the result to function pointers anyways.
 393          */
 394         for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 395                 if (strcmp(ep->name, symbol) == 0)
 396                         return ep->addr;
 397         dl_errvalid++;
 398         strcpy(dl_errbuf, "dlsym: undefined symbol ");
 399         strcat(dl_errbuf, symbol);
 400         return NULL;
 401 }
 402
 403 char *dlerror(void)
 404 {
 405         dTHX;
 406         dMY_CXT;
 407         if (dl_errvalid) {
 408                 dl_errvalid = 0;
 409                 return dl_errbuf;
 410         }
 411         return NULL;
 412 }
 413
 414 int dlclose(void *handle)
 415 {
 416         dTHX;
 417         dMY_CXT;
 418         register ModulePtr mp = (ModulePtr)handle;
 419         int result;
 420         register ModulePtr mp1;
 421
 422         if (--mp->refCnt > 0)
 423                 return 0;
 424         result = UNLOAD(mp->entry);
 425         if (result == -1) {
 426                 dl_errvalid++;
 427                 strerrorcpy(dl_errbuf, errno);
 428         }
 429         if (mp->exports) {
 430                 register ExportPtr ep;
 431                 register int i;
 432                 for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
 433                         if (ep->name)
 434                                 safefree(ep->name);
 435                 safefree(mp->exports);
 436         }
 437         if (mp == dl_modList)
 438                 dl_modList = mp->next;
 439         else {
 440                 for (mp1 = dl_modList; mp1; mp1 = mp1->next)
 441                         if (mp1->next == mp) {
 442                                 mp1->next = mp->next;
 443                                 break;
 444                         }
 445         }
 446         safefree(mp->name);
 447         safefree(mp);
 448         return result;
 449 }
 450
 451 /* Added by Wayne Scott
 452  * This is needed because the ldopen system call calls
 453  * calloc to allocated a block of date.  The ldclose call calls free.
 454  * Without this we get this system calloc and perl's free, resulting
 455  * in a "Bad free" message.  This way we always use perl's malloc.
 456  */
 457 void *calloc(size_t ne, size_t sz)
 458 {
 459   void *out;
 460
 461   out = (void *) safemalloc(ne*sz);
 462   memzero(out, ne*sz);
 463   return(out);
 464 }
 465
 466 /*
 467  * Build the export table from the XCOFF .loader section.
 468  */
 469 static int readExports(ModulePtr mp)
 470 {
 471         dTHX;
 472         dMY_CXT;
 473         LDFILE *ldp = NULL;
 474         AIX_SCNHDR sh;
 475         AIX_LDHDR *lhp;
 476         char *ldbuf;
 477         AIX_LDSYM *ls;
 478         int i;
 479         ExportPtr ep;
 480
 481         if ((ldp = ldopen(mp->name, ldp)) == NULL) {
 482                 struct ld_info *lp;
 483                 char *buf;
 484                 int size = 4*1024;
 485                 if (errno != ENOENT) {
 486                         dl_errvalid++;
 487                         strcpy(dl_errbuf, "readExports: ");
 488                         strerrorcat(dl_errbuf, errno);
 489                         return -1;
 490                 }
 491                 /*
 492                  * The module might be loaded due to the LIBPATH
 493                  * environment variable. Search for the loaded
 494                  * module using L_GETINFO.
 495                  */
 496                 if ((buf = safemalloc(size)) == NULL) {
 497                         dl_errvalid++;
 498                         strcpy(dl_errbuf, "readExports: ");
 499                         strerrorcat(dl_errbuf, errno);
 500                         return -1;
 501                 }
 502                 while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 503                         safefree(buf);
 504                         size += 4*1024;
 505                         if ((buf = safemalloc(size)) == NULL) {
 506                                 dl_errvalid++;
 507                                 strcpy(dl_errbuf, "readExports: ");
 508                                 strerrorcat(dl_errbuf, errno);
 509                                 return -1;
 510                         }
 511                 }
 512                 if (i == -1) {
 513                         dl_errvalid++;
 514                         strcpy(dl_errbuf, "readExports: ");
 515                         strerrorcat(dl_errbuf, errno);
 516                         safefree(buf);
 517                         return -1;
 518                 }
 519                 /*
 520                  * Traverse the list of loaded modules. The entry point
 521                  * returned by LOAD() does actually point to the data
 522                  * segment origin.
 523                  */
 524                 lp = (struct ld_info *)buf;
 525                 while (lp) {
 526                         if (lp->ldinfo_dataorg == mp->entry) {
 527                                 ldp = ldopen(lp->ldinfo_filename, ldp);
 528                                 break;
 529                         }
 530                         if (lp->ldinfo_next == 0)
 531                                 lp = NULL;
 532                         else
 533                                 lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
 534                 }
 535                 safefree(buf);
 536                 if (!ldp) {
 537                         dl_errvalid++;
 538                         strcpy(dl_errbuf, "readExports: ");
 539                         strerrorcat(dl_errbuf, errno);
 540                         return -1;
 541                 }
 542         }
 543 #ifdef USE_64_BIT_ALL
 544         if (TYPE(ldp) != U803XTOCMAGIC) {
 545 #else
 546         if (TYPE(ldp) != U802TOCMAGIC) {
 547 #endif
 548                 dl_errvalid++;
 549                 strcpy(dl_errbuf, "readExports: bad magic");
 550                 while(ldclose(ldp) == FAILURE)
 551                         ;
 552                 return -1;
 553         }
 554         if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
 555                 dl_errvalid++;
 556                 strcpy(dl_errbuf, "readExports: cannot read loader section header");
 557                 while(ldclose(ldp) == FAILURE)
 558                         ;
 559                 return -1;
 560         }
 561         /*
 562          * We read the complete loader section in one chunk, this makes
 563          * finding long symbol names residing in the string table easier.
 564          */
 565         if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
 566                 dl_errvalid++;
 567                 strcpy(dl_errbuf, "readExports: ");
 568                 strerrorcat(dl_errbuf, errno);
 569                 while(ldclose(ldp) == FAILURE)
 570                         ;
 571                 return -1;
 572         }
 573         if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
 574                 dl_errvalid++;
 575                 strcpy(dl_errbuf, "readExports: cannot seek to loader section");
 576                 safefree(ldbuf);
 577                 while(ldclose(ldp) == FAILURE)
 578                         ;
 579                 return -1;
 580         }
 581 /* This first case is a hack, since it assumes that the 3rd parameter to
 582    FREAD is 1. See the redefinition of FREAD above to see how this works. */
 583         if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
 584                 dl_errvalid++;
 585                 strcpy(dl_errbuf, "readExports: cannot read loader section");
 586                 safefree(ldbuf);
 587                 while(ldclose(ldp) == FAILURE)
 588                         ;
 589                 return -1;
 590         }
 591         lhp = (AIX_LDHDR *)ldbuf;
 592         ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 593         /*
 594          * Count the number of exports to include in our export table.
 595          */
 596         for (i = lhp->l_nsyms; i; i--, ls++) {
 597                 if (!LDR_EXPORT(*ls))
 598                         continue;
 599                 mp->nExports++;
 600         }
 601         Newz(1001, mp->exports, mp->nExports, Export);
 602         if (mp->exports == NULL) {
 603                 dl_errvalid++;
 604                 strcpy(dl_errbuf, "readExports: ");
 605                 strerrorcat(dl_errbuf, errno);
 606                 safefree(ldbuf);
 607                 while(ldclose(ldp) == FAILURE)
 608                         ;
 609                 return -1;
 610         }
 611         /*
 612          * Fill in the export table. All entries are relative to
 613          * the entry point we got from load.
 614          */
 615         ep = mp->exports;
 616         ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
 617         for (i = lhp->l_nsyms; i; i--, ls++) {
 618                 char *symname;
 619                 if (!LDR_EXPORT(*ls))
 620                         continue;
 621 #ifndef USE_64_BIT_ALL
 622                 if (ls->l_zeroes == 0)
 623 #endif
 624                         symname = ls->l_offset+lhp->l_stoff+ldbuf;
 625 #ifndef USE_64_BIT_ALL
 626                 else
 627                         symname = ls->l_name;
 628 #endif
 629                 ep->name = savepv(symname);
 630                 ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
 631                 ep++;
 632         }
 633         safefree(ldbuf);
 634         while(ldclose(ldp) == FAILURE)
 635                 ;
 636         return 0;
 637 }
 638
 639 /*
 640  * Find the main modules entry point. This is used as export pointer
 641  * for loadbind() to be able to resolve references to the main part.
 642  */
 643 static void * findMain(void)
 644 {
 645         dTHX;
 646         dMY_CXT;
 647         struct ld_info *lp;
 648         char *buf;
 649         int size = 4*1024;
 650         int i;
 651         void *ret;
 652
 653         if ((buf = safemalloc(size)) == NULL) {
 654                 dl_errvalid++;
 655                 strcpy(dl_errbuf, "findMain: ");
 656                 strerrorcat(dl_errbuf, errno);
 657                 return NULL;
 658         }
 659         while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
 660                 safefree(buf);
 661                 size += 4*1024;
 662                 if ((buf = safemalloc(size)) == NULL) {
 663                         dl_errvalid++;
 664                         strcpy(dl_errbuf, "findMain: ");
 665                         strerrorcat(dl_errbuf, errno);
 666                         return NULL;
 667                 }
 668         }
 669         if (i == -1) {
 670                 dl_errvalid++;
 671                 strcpy(dl_errbuf, "findMain: ");
 672                 strerrorcat(dl_errbuf, errno);
 673                 safefree(buf);
 674                 return NULL;
 675         }
 676         /*
 677          * The first entry is the main module. The entry point
 678          * returned by load() does actually point to the data
 679          * segment origin.
 680          */
 681         lp = (struct ld_info *)buf;
 682         ret = lp->ldinfo_dataorg;
 683         safefree(buf);
 684         return ret;
 685 }
 686 #endif /* USE_NATIVE_DLOPEN */
 687
 688 /* dl_dlopen.xs
 689  *
 690  * Platform:    SunOS/Solaris, possibly others which use dlopen.
 691  * Author:      Paul Marquess (Paul.Marquess@btinternet.com)
 692  * Created:     10th July 1994
 693  *
 694  * Modified:
 695  * 15th July 1994   - Added code to explicitly save any error messages.
 696  * 3rd August 1994  - Upgraded to v3 spec.
 697  * 9th August 1994  - Changed to use IV
 698  * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
 699  *                    basic FreeBSD support, removed ClearError
 700  *
 701  */
 702
 703 /* Porting notes:
 704
 705         see dl_dlopen.xs
 706
 707 */
 708
 709 static void
 710 dl_private_init(pTHX)
 711 {
 712     (void)dl_generic_private_init(aTHX);
 713 }
 714
 715 MODULE = DynaLoader     PACKAGE = DynaLoader
 716
 717 BOOT:
 718     (void)dl_private_init(aTHX);
 719
 720
 721 void *
 722 dl_load_file(filename, flags=0)
 723         char *  filename
 724         int     flags
 725         CODE:
 726         DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
 727         if (flags & 0x01)
 728             Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 729         RETVAL = dlopen(filename, RTLD_GLOBAL|RTLD_LAZY) ;
 730         DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
 731         ST(0) = sv_newmortal() ;
 732         if (RETVAL == NULL)
 733             SaveError(aTHX_ "%s",dlerror()) ;
 734         else
 735             sv_setiv( ST(0), PTR2IV(RETVAL) );
 736
 737 int
 738 dl_unload_file(libref)
 739     void *      libref
 740   CODE:
 741     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
 742     RETVAL = (dlclose(libref) == 0 ? 1 : 0);
 743     if (!RETVAL)
 744         SaveError(aTHX_ "%s", dlerror()) ;
 745     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
 746   OUTPUT:
 747     RETVAL
 748
 749 void *
 750 dl_find_symbol(libhandle, symbolname)
 751         void *          libhandle
 752         char *          symbolname
 753         CODE:
 754         DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
 755                 libhandle, symbolname));
 756         RETVAL = dlsym(libhandle, symbolname);
 757         DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
 758         ST(0) = sv_newmortal() ;
 759         if (RETVAL == NULL)
 760             SaveError(aTHX_ "%s",dlerror()) ;
 761         else
 762             sv_setiv( ST(0), PTR2IV(RETVAL));
 763
 764
 765 void
 766 dl_undef_symbols()
 767         PPCODE:
 768
 769
 770
 771 # These functions should not need changing on any platform:
 772
 773 void
 774 dl_install_xsub(perl_name, symref, filename="$Package")
 775     char *      perl_name
 776     void *      symref
 777     char *      filename
 778     CODE:
 779     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
 780         perl_name, symref));
 781     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 782                                         (void(*)(pTHX_ CV *))symref,
 783                                         filename)));
 784
 785
 786 char *
 787 dl_error()
 788     CODE:
 789     dMY_CXT;
 790     RETVAL = dl_last_error ;
 791     OUTPUT:
 792     RETVAL
 793
 794 # end.