ext/DynaLoader/dl_dlopen.xs

   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,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n", filename));
 155     RETVAL = dlopen(filename, mode) ;
 156     DLDEBUG(2,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
 174         libhandle, symbolname));
 175     RETVAL = dlsym(libhandle, symbolname);
 176     DLDEBUG(2,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_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.