home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / ext / DynaLoader / dl_aix.xs next >
Text File  |  1994-10-18  |  13KB  |  583 lines
  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. #include <stdio.h>
  24. #include <errno.h>
  25. #include <string.h>
  26. #include <stdlib.h>
  27. #include <sys/types.h>
  28. #include <sys/ldr.h>
  29. #include <a.out.h>
  30. #include <ldfcn.h>
  31.  
  32. /*
  33.  * We simulate dlopen() et al. through a call to load. Because AIX has
  34.  * no call to find an exported symbol we read the loader section of the
  35.  * loaded module and build a list of exported symbols and their virtual
  36.  * address.
  37.  */
  38.  
  39. typedef struct {
  40.     char        *name;        /* the symbols's name */
  41.     void        *addr;        /* its relocated virtual address */
  42. } Export, *ExportPtr;
  43.  
  44. /*
  45.  * The void * handle returned from dlopen is actually a ModulePtr.
  46.  */
  47. typedef struct Module {
  48.     struct Module    *next;
  49.     char        *name;        /* module name for refcounting */
  50.     int        refCnt;        /* the number of references */
  51.     void        *entry;        /* entry point from load */
  52.     int        nExports;    /* the number of exports found */
  53.     ExportPtr    exports;    /* the array of exports */
  54. } Module, *ModulePtr;
  55.  
  56. /*
  57.  * We keep a list of all loaded modules to be able to call the fini
  58.  * handlers at atexit() time.
  59.  */
  60. static ModulePtr modList;
  61.  
  62. /*
  63.  * The last error from one of the dl* routines is kept in static
  64.  * variables here. Each error is returned only once to the caller.
  65.  */
  66. static char errbuf[BUFSIZ];
  67. static int errvalid;
  68.  
  69. static void caterr(char *);
  70. static int readExports(ModulePtr);
  71. static void terminate(void);
  72. static void *findMain(void);
  73.  
  74.   
  75. /* ARGSUSED */
  76. void *dlopen(char *path, int mode)
  77. {
  78.     register ModulePtr mp;
  79.     static void *mainModule;
  80.  
  81.     /*
  82.      * Upon the first call register a terminate handler that will
  83.      * close all libraries. Also get a reference to the main module
  84.      * for use with loadbind.
  85.      */
  86.     if (!mainModule) {
  87.         if ((mainModule = findMain()) == NULL)
  88.             return NULL;
  89.         atexit(terminate);
  90.     }
  91.     /*
  92.      * Scan the list of modules if have the module already loaded.
  93.      */
  94.     for (mp = modList; mp; mp = mp->next)
  95.         if (strcmp(mp->name, path) == 0) {
  96.             mp->refCnt++;
  97.             return mp;
  98.         }
  99.     Newz(1000,mp,1,Module);
  100.     if (mp == NULL) {
  101.         errvalid++;
  102.         strcpy(errbuf, "Newz: ");
  103.         strcat(errbuf, strerror(errno));
  104.         return NULL;
  105.     }
  106.     
  107.     if ((mp->name = savepv(path)) == NULL) {
  108.         errvalid++;
  109.         strcpy(errbuf, "savepv: ");
  110.         strcat(errbuf, strerror(errno));
  111.         safefree(mp);
  112.         return NULL;
  113.     }
  114.     /*
  115.      * load should be declared load(const char *...). Thus we
  116.      * cast the path to a normal char *. Ugly.
  117.      */
  118.     if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
  119.         safefree(mp->name);
  120.         safefree(mp);
  121.         errvalid++;
  122.         strcpy(errbuf, "dlopen: ");
  123.         strcat(errbuf, path);
  124.         strcat(errbuf, ": ");
  125.         /*
  126.          * If AIX says the file is not executable, the error
  127.          * can be further described by querying the loader about
  128.          * the last error.
  129.          */
  130.         if (errno == ENOEXEC) {
  131.             char *tmp[BUFSIZ/sizeof(char *)];
  132.             if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
  133.                 strcpy(errbuf, strerror(errno));
  134.             else {
  135.                 char **p;
  136.                 for (p = tmp; *p; p++)
  137.                     caterr(*p);
  138.             }
  139.         } else
  140.             strcat(errbuf, strerror(errno));
  141.         return NULL;
  142.     }
  143.     mp->refCnt = 1;
  144.     mp->next = modList;
  145.     modList = mp;
  146.     if (loadbind(0, mainModule, mp->entry) == -1) {
  147.         dlclose(mp);
  148.         errvalid++;
  149.         strcpy(errbuf, "loadbind: ");
  150.         strcat(errbuf, strerror(errno));
  151.         return NULL;
  152.     }
  153.     if (readExports(mp) == -1) {
  154.         dlclose(mp);
  155.         return NULL;
  156.     }
  157.     return mp;
  158. }
  159.  
  160. /*
  161.  * Attempt to decipher an AIX loader error message and append it
  162.  * to our static error message buffer.
  163.  */
  164. static void caterr(char *s)
  165. {
  166.     register char *p = s;
  167.  
  168.     while (*p >= '0' && *p <= '9')
  169.         p++;
  170.     switch(atoi(s)) {
  171.     case L_ERROR_TOOMANY:
  172.         strcat(errbuf, "to many errors");
  173.         break;
  174.     case L_ERROR_NOLIB:
  175.         strcat(errbuf, "can't load library");
  176.         strcat(errbuf, p);
  177.         break;
  178.     case L_ERROR_UNDEF:
  179.         strcat(errbuf, "can't find symbol");
  180.         strcat(errbuf, p);
  181.         break;
  182.     case L_ERROR_RLDBAD:
  183.         strcat(errbuf, "bad RLD");
  184.         strcat(errbuf, p);
  185.         break;
  186.     case L_ERROR_FORMAT:
  187.         strcat(errbuf, "bad exec format in");
  188.         strcat(errbuf, p);
  189.         break;
  190.     case L_ERROR_ERRNO:
  191.         strcat(errbuf, strerror(atoi(++p)));
  192.         break;
  193.     default:
  194.         strcat(errbuf, s);
  195.         break;
  196.     }
  197. }
  198.  
  199. void *dlsym(void *handle, const char *symbol)
  200. {
  201.     register ModulePtr mp = (ModulePtr)handle;
  202.     register ExportPtr ep;
  203.     register int i;
  204.  
  205.     /*
  206.      * Could speed up search, but I assume that one assigns
  207.      * the result to function pointers anyways.
  208.      */
  209.     for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
  210.         if (strcmp(ep->name, symbol) == 0)
  211.             return ep->addr;
  212.     errvalid++;
  213.     strcpy(errbuf, "dlsym: undefined symbol ");
  214.     strcat(errbuf, symbol);
  215.     return NULL;
  216. }
  217.  
  218. char *dlerror(void)
  219. {
  220.     if (errvalid) {
  221.         errvalid = 0;
  222.         return errbuf;
  223.     }
  224.     return NULL;
  225. }
  226.  
  227. int dlclose(void *handle)
  228. {
  229.     register ModulePtr mp = (ModulePtr)handle;
  230.     int result;
  231.     register ModulePtr mp1;
  232.  
  233.     if (--mp->refCnt > 0)
  234.         return 0;
  235.     result = unload(mp->entry);
  236.     if (result == -1) {
  237.         errvalid++;
  238.         strcpy(errbuf, strerror(errno));
  239.     }
  240.     if (mp->exports) {
  241.         register ExportPtr ep;
  242.         register int i;
  243.         for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
  244.             if (ep->name)
  245.                 safefree(ep->name);
  246.         safefree(mp->exports);
  247.     }
  248.     if (mp == modList)
  249.         modList = mp->next;
  250.     else {
  251.         for (mp1 = modList; mp1; mp1 = mp1->next)
  252.             if (mp1->next == mp) {
  253.                 mp1->next = mp->next;
  254.                 break;
  255.             }
  256.     }
  257.     safefree(mp->name);
  258.     safefree(mp);
  259.     return result;
  260. }
  261.  
  262. static void terminate(void)
  263. {
  264.     while (modList)
  265.         dlclose(modList);
  266. }
  267.  
  268. /* Added by Wayne Scott 
  269.  * This is needed because the ldopen system call calls
  270.  * calloc to allocated a block of date.  The ldclose call calls free.
  271.  * Without this we get this system calloc and perl's free, resulting
  272.  * in a "Bad free" message.  This way we always use perl's malloc.
  273.  */
  274. void *calloc(size_t ne, size_t sz) 
  275. {
  276.   void *out;
  277.  
  278.   out = (void *) safemalloc(ne*sz);
  279.   memzero(out, ne*sz);
  280.   return(out);
  281. }
  282.  
  283. /*
  284.  * Build the export table from the XCOFF .loader section.
  285.  */
  286. static int readExports(ModulePtr mp)
  287. {
  288.     LDFILE *ldp = NULL;
  289.     SCNHDR sh;
  290.     LDHDR *lhp;
  291.     char *ldbuf;
  292.     LDSYM *ls;
  293.     int i;
  294.     ExportPtr ep;
  295.  
  296.     if ((ldp = ldopen(mp->name, ldp)) == NULL) {
  297.         struct ld_info *lp;
  298.         char *buf;
  299.         int size = 4*1024;
  300.         if (errno != ENOENT) {
  301.             errvalid++;
  302.             strcpy(errbuf, "readExports: ");
  303.             strcat(errbuf, strerror(errno));
  304.             return -1;
  305.         }
  306.         /*
  307.          * The module might be loaded due to the LIBPATH
  308.          * environment variable. Search for the loaded
  309.          * module using L_GETINFO.
  310.          */
  311.         if ((buf = safemalloc(size)) == NULL) {
  312.             errvalid++;
  313.             strcpy(errbuf, "readExports: ");
  314.             strcat(errbuf, strerror(errno));
  315.             return -1;
  316.         }
  317.         while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
  318.             safefree(buf);
  319.             size += 4*1024;
  320.             if ((buf = safemalloc(size)) == NULL) {
  321.                 errvalid++;
  322.                 strcpy(errbuf, "readExports: ");
  323.                 strcat(errbuf, strerror(errno));
  324.                 return -1;
  325.             }
  326.         }
  327.         if (i == -1) {
  328.             errvalid++;
  329.             strcpy(errbuf, "readExports: ");
  330.             strcat(errbuf, strerror(errno));
  331.             safefree(buf);
  332.             return -1;
  333.         }
  334.         /*
  335.          * Traverse the list of loaded modules. The entry point
  336.          * returned by load() does actually point to the data
  337.          * segment origin.
  338.          */
  339.         lp = (struct ld_info *)buf;
  340.         while (lp) {
  341.             if (lp->ldinfo_dataorg == mp->entry) {
  342.                 ldp = ldopen(lp->ldinfo_filename, ldp);
  343.                 break;
  344.             }
  345.             if (lp->ldinfo_next == 0)
  346.                 lp = NULL;
  347.             else
  348.                 lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
  349.         }
  350.         safefree(buf);
  351.         if (!ldp) {
  352.             errvalid++;
  353.             strcpy(errbuf, "readExports: ");
  354.             strcat(errbuf, strerror(errno));
  355.             return -1;
  356.         }
  357.     }
  358.     if (TYPE(ldp) != U802TOCMAGIC) {
  359.         errvalid++;
  360.         strcpy(errbuf, "readExports: bad magic");
  361.         while(ldclose(ldp) == FAILURE)
  362.             ;
  363.         return -1;
  364.     }
  365.     if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
  366.         errvalid++;
  367.         strcpy(errbuf, "readExports: cannot read loader section header");
  368.         while(ldclose(ldp) == FAILURE)
  369.             ;
  370.         return -1;
  371.     }
  372.     /*
  373.      * We read the complete loader section in one chunk, this makes
  374.      * finding long symbol names residing in the string table easier.
  375.      */
  376.     if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
  377.         errvalid++;
  378.         strcpy(errbuf, "readExports: ");
  379.         strcat(errbuf, strerror(errno));
  380.         while(ldclose(ldp) == FAILURE)
  381.             ;
  382.         return -1;
  383.     }
  384.     if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
  385.         errvalid++;
  386.         strcpy(errbuf, "readExports: cannot seek to loader section");
  387.         safefree(ldbuf);
  388.         while(ldclose(ldp) == FAILURE)
  389.             ;
  390.         return -1;
  391.     }
  392.     if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
  393.         errvalid++;
  394.         strcpy(errbuf, "readExports: cannot read loader section");
  395.         safefree(ldbuf);
  396.         while(ldclose(ldp) == FAILURE)
  397.             ;
  398.         return -1;
  399.     }
  400.     lhp = (LDHDR *)ldbuf;
  401.     ls = (LDSYM *)(ldbuf+LDHDRSZ);
  402.     /*
  403.      * Count the number of exports to include in our export table.
  404.      */
  405.     for (i = lhp->l_nsyms; i; i--, ls++) {
  406.         if (!LDR_EXPORT(*ls))
  407.             continue;
  408.         mp->nExports++;
  409.     }
  410.     Newz(1001, mp->exports, mp->nExports, Export);
  411.     if (mp->exports == NULL) {
  412.         errvalid++;
  413.         strcpy(errbuf, "readExports: ");
  414.         strcat(errbuf, strerror(errno));
  415.         safefree(ldbuf);
  416.         while(ldclose(ldp) == FAILURE)
  417.             ;
  418.         return -1;
  419.     }
  420.     /*
  421.      * Fill in the export table. All entries are relative to
  422.      * the entry point we got from load.
  423.      */
  424.     ep = mp->exports;
  425.     ls = (LDSYM *)(ldbuf+LDHDRSZ);
  426.     for (i = lhp->l_nsyms; i; i--, ls++) {
  427.         char *symname;
  428.         if (!LDR_EXPORT(*ls))
  429.             continue;
  430.         if (ls->l_zeroes == 0)
  431.             symname = ls->l_offset+lhp->l_stoff+ldbuf;
  432.         else
  433.             symname = ls->l_name;
  434.         ep->name = savepv(symname);
  435.         ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
  436.         ep++;
  437.     }
  438.     safefree(ldbuf);
  439.     while(ldclose(ldp) == FAILURE)
  440.         ;
  441.     return 0;
  442. }
  443.  
  444. /*
  445.  * Find the main modules entry point. This is used as export pointer
  446.  * for loadbind() to be able to resolve references to the main part.
  447.  */
  448. static void * findMain(void)
  449. {
  450.     struct ld_info *lp;
  451.     char *buf;
  452.     int size = 4*1024;
  453.     int i;
  454.     void *ret;
  455.  
  456.     if ((buf = safemalloc(size)) == NULL) {
  457.         errvalid++;
  458.         strcpy(errbuf, "findMain: ");
  459.         strcat(errbuf, strerror(errno));
  460.         return NULL;
  461.     }
  462.     while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
  463.         safefree(buf);
  464.         size += 4*1024;
  465.         if ((buf = safemalloc(size)) == NULL) {
  466.             errvalid++;
  467.             strcpy(errbuf, "findMain: ");
  468.             strcat(errbuf, strerror(errno));
  469.             return NULL;
  470.         }
  471.     }
  472.     if (i == -1) {
  473.         errvalid++;
  474.         strcpy(errbuf, "findMain: ");
  475.         strcat(errbuf, strerror(errno));
  476.         safefree(buf);
  477.         return NULL;
  478.     }
  479.     /*
  480.      * The first entry is the main module. The entry point
  481.      * returned by load() does actually point to the data
  482.      * segment origin.
  483.      */
  484.     lp = (struct ld_info *)buf;
  485.     ret = lp->ldinfo_dataorg;
  486.     safefree(buf);
  487.     return ret;
  488. }
  489.  
  490. /* dl_dlopen.xs
  491.  * 
  492.  * Platform:    SunOS/Solaris, possibly others which use dlopen.
  493.  * Author:    Paul Marquess (pmarquess@bfsec.bt.co.uk)
  494.  * Created:    10th July 1994
  495.  *
  496.  * Modified:
  497.  * 15th July 1994   - Added code to explicitly save any error messages.
  498.  * 3rd August 1994  - Upgraded to v3 spec.
  499.  * 9th August 1994  - Changed to use IV
  500.  * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
  501.  *                    basic FreeBSD support, removed ClearError
  502.  *
  503.  */
  504.  
  505. /* Porting notes:
  506.  
  507.     see dl_dlopen.xs
  508.  
  509. */
  510.  
  511. #include "dlutils.c"    /* SaveError() etc    */
  512.  
  513.  
  514. static void
  515. dl_private_init()
  516. {
  517.     (void)dl_generic_private_init();
  518. }
  519.  
  520. MODULE = DynaLoader     PACKAGE = DynaLoader
  521.  
  522. BOOT:
  523.     (void)dl_private_init();
  524.  
  525.  
  526. void *
  527. dl_load_file(filename)
  528.     char *        filename
  529.     CODE:
  530.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  531.     RETVAL = dlopen(filename, 1) ;
  532.     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  533.     ST(0) = sv_newmortal() ;
  534.     if (RETVAL == NULL)
  535.         SaveError("%s",dlerror()) ;
  536.     else
  537.         sv_setiv( ST(0), (IV)RETVAL);
  538.  
  539.  
  540. void *
  541. dl_find_symbol(libhandle, symbolname)
  542.     void *        libhandle
  543.     char *        symbolname
  544.     CODE:
  545.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  546.         libhandle, symbolname));
  547.     RETVAL = dlsym(libhandle, symbolname);
  548.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  549.     ST(0) = sv_newmortal() ;
  550.     if (RETVAL == NULL)
  551.         SaveError("%s",dlerror()) ;
  552.     else
  553.         sv_setiv( ST(0), (IV)RETVAL);
  554.  
  555.  
  556. void
  557. dl_undef_symbols()
  558.     PPCODE:
  559.  
  560.  
  561.  
  562. # These functions should not need changing on any platform:
  563.  
  564. void
  565. dl_install_xsub(perl_name, symref, filename="$Package")
  566.     char *    perl_name
  567.     void *    symref 
  568.     char *    filename
  569.     CODE:
  570.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  571.     perl_name, symref));
  572.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  573.  
  574.  
  575. char *
  576. dl_error()
  577.     CODE:
  578.     RETVAL = LastError ;
  579.     OUTPUT:
  580.     RETVAL
  581.  
  582. # end.
  583.