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