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