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