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_dlopen.xs < prev    next >
Text File  |  1996-02-12  |  6KB  |  211 lines
  1. /* dl_dlopen.xs
  2.  * 
  3.  * Platform:    SunOS/Solaris, possibly others which use dlopen.
  4.  * Author:    Paul Marquess (pmarquess@bfsec.bt.co.uk)
  5.  * Created:    10th July 1994
  6.  *
  7.  * Modified:
  8.  * 15th July 1994   - Added code to explicitly save any error messages.
  9.  * 3rd August 1994  - Upgraded to v3 spec.
  10.  * 9th August 1994  - Changed to use IV
  11.  * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
  12.  *                    basic FreeBSD support, removed ClearError
  13.  *
  14.  */
  15.  
  16. /* Porting notes:
  17.  
  18.  
  19.    Definition of Sunos dynamic Linking functions
  20.    =============================================
  21.    In order to make this implementation easier to understand here is a
  22.    quick definition of the SunOS Dynamic Linking functions which are
  23.    used here.
  24.  
  25.    dlopen
  26.    ------
  27.      void *
  28.      dlopen(path, mode)
  29.      char * path; 
  30.      int    mode;
  31.  
  32.      This function takes the name of a dynamic object file and returns
  33.      a descriptor which can be used by dlsym later. It returns NULL on
  34.      error.
  35.  
  36.      The mode parameter must be set to 1 for Solaris 1 and to
  37.      RTLD_LAZY (==2) on Solaris 2.
  38.  
  39.  
  40.    dlsym
  41.    ------
  42.      void *
  43.      dlsym(handle, symbol)
  44.      void * handle; 
  45.      char * symbol;
  46.  
  47.      Takes the handle returned from dlopen and the name of a symbol to
  48.      get the address of. If the symbol was found a pointer is
  49.      returned.  It returns NULL on error. If DL_PREPEND_UNDERSCORE is
  50.      defined an underscore will be added to the start of symbol. This
  51.      is required on some platforms (freebsd).
  52.  
  53.    dlerror
  54.    ------
  55.      char * dlerror()
  56.  
  57.      Returns a null-terminated string which describes the last error
  58.      that occurred with either dlopen or dlsym. After each call to
  59.      dlerror the error message will be reset to a null pointer. The
  60.      SaveError function is used to save the error as soo as it happens.
  61.  
  62.  
  63.    Return Types
  64.    ============
  65.    In this implementation the two functions, dl_load_file &
  66.    dl_find_symbol, return void *. This is because the underlying SunOS
  67.    dynamic linker calls also return void *.  This is not necessarily
  68.    the case for all architectures. For example, some implementation
  69.    will want to return a char * for dl_load_file.
  70.  
  71.    If void * is not appropriate for your architecture, you will have to
  72.    change the void * to whatever you require. If you are not certain of
  73.    how Perl handles C data types, I suggest you start by consulting    
  74.    Dean Roerich's Perl 5 API document. Also, have a look in the typemap 
  75.    file (in the ext directory) for a fairly comprehensive list of types 
  76.    that are already supported. If you are completely stuck, I suggest you
  77.    post a message to perl5-porters, comp.lang.perl.misc or if you are really 
  78.    desperate to me.
  79.  
  80.    Remember when you are making any changes that the return value from 
  81.    dl_load_file is used as a parameter in the dl_find_symbol 
  82.    function. Also the return value from find_symbol is used as a parameter 
  83.    to install_xsub.
  84.  
  85.  
  86.    Dealing with Error Messages
  87.    ============================
  88.    In order to make the handling of dynamic linking errors as generic as
  89.    possible you should store any error messages associated with your
  90.    implementation with the StoreError function.
  91.  
  92.    In the case of SunOS the function dlerror returns the error message 
  93.    associated with the last dynamic link error. As the SunOS dynamic 
  94.    linker functions dlopen & dlsym both return NULL on error every call 
  95.    to a SunOS dynamic link routine is coded like this
  96.  
  97.     RETVAL = dlopen(filename, 1) ;
  98.     if (RETVAL == NULL)
  99.         SaveError("%s",dlerror()) ;
  100.  
  101.    Note that SaveError() takes a printf format string. Use a "%s" as
  102.    the first parameter if the error may contain and % characters.
  103.  
  104. */
  105.  
  106. #include "EXTERN.h"
  107. #include "perl.h"
  108. #include "XSUB.h"
  109.  
  110. #ifdef I_DLFCN
  111. #include <dlfcn.h>    /* the dynamic linker include file for Sunos/Solaris */
  112. #else
  113. #include <nlist.h>
  114. #include <link.h>
  115. #endif
  116.  
  117. #ifndef RTLD_LAZY
  118. # define RTLD_LAZY 1    /* Solaris 1 */
  119. #endif
  120.  
  121. #ifndef HAS_DLERROR
  122. # ifdef __NetBSD__
  123. #  define dlerror() strerror(errno)
  124. # else
  125. #  define dlerror() "Unknown error - dlerror() not implemented"
  126. # endif
  127. #endif
  128.  
  129.  
  130. #include "dlutils.c"    /* SaveError() etc    */
  131.  
  132.  
  133. static void
  134. dl_private_init()
  135. {
  136.     (void)dl_generic_private_init();
  137. }
  138.  
  139. MODULE = DynaLoader    PACKAGE = DynaLoader
  140.  
  141. BOOT:
  142.     (void)dl_private_init();
  143.  
  144.  
  145. void *
  146. dl_load_file(filename)
  147.     char *        filename
  148.     CODE:
  149.     int mode = RTLD_LAZY;
  150. #ifdef RTLD_NOW
  151.     if (dl_nonlazy)
  152.     mode = RTLD_NOW;
  153. #endif
  154.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  155.     RETVAL = dlopen(filename, mode) ;
  156.     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  157.     ST(0) = sv_newmortal() ;
  158.     if (RETVAL == NULL)
  159.     SaveError("%s",dlerror()) ;
  160.     else
  161.     sv_setiv( ST(0), (IV)RETVAL);
  162.  
  163.  
  164. void *
  165. dl_find_symbol(libhandle, symbolname)
  166.     void *    libhandle
  167.     char *    symbolname
  168.     CODE:
  169. #ifdef DLSYM_NEEDS_UNDERSCORE
  170.     char symbolname_buf[1024];
  171.     symbolname = dl_add_underscore(symbolname, symbolname_buf);
  172. #endif
  173.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  174.     libhandle, symbolname));
  175.     RETVAL = dlsym(libhandle, symbolname);
  176.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  177.     ST(0) = sv_newmortal() ;
  178.     if (RETVAL == NULL)
  179.     SaveError("%s",dlerror()) ;
  180.     else
  181.     sv_setiv( ST(0), (IV)RETVAL);
  182.  
  183.  
  184. void
  185. dl_undef_symbols()
  186.     PPCODE:
  187.  
  188.  
  189.  
  190. # These functions should not need changing on any platform:
  191.  
  192. void
  193. dl_install_xsub(perl_name, symref, filename="$Package")
  194.     char *        perl_name
  195.     void *        symref 
  196.     char *        filename
  197.     CODE:
  198.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  199.         perl_name, symref));
  200.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  201.  
  202.  
  203. char *
  204. dl_error()
  205.     CODE:
  206.     RETVAL = LastError ;
  207.     OUTPUT:
  208.     RETVAL
  209.  
  210. # end.
  211.