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 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 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 HAS_DLERROR
 118 #define dlerror() "Unknown error - dlerror() not implemented"
 119 #endif
 120
 121
 122 #include "dlutils.c"    /* SaveError() etc      */
 123
 124
 125 static void
 126 dl_private_init()
 127 {
 128     (void)dl_generic_private_init();
 129 }
 130
 131 MODULE = DynaLoader     PACKAGE = DynaLoader
 132
 133 BOOT:
 134     (void)dl_private_init();
 135
 136
 137 void *
 138 dl_load_file(filename)
 139     char *              filename
 140     CODE:
 141     int mode = 1;     /* Solaris 1 */
 142 #ifdef RTLD_LAZY
 143     mode = RTLD_LAZY; /* Solaris 2 */
 144 #endif
 145     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
 146     RETVAL = dlopen(filename, mode) ;
 147     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
 148     ST(0) = sv_newmortal() ;
 149     if (RETVAL == NULL)
 150         SaveError("%s",dlerror()) ;
 151     else
 152         sv_setiv( ST(0), (IV)RETVAL);
 153
 154
 155 void *
 156 dl_find_symbol(libhandle, symbolname)
 157     void *      libhandle
 158     char *      symbolname
 159     CODE:
 160 #ifdef DLSYM_NEEDS_UNDERSCORE
 161     char symbolname_buf[1024];
 162     symbolname = dl_add_underscore(symbolname, symbolname_buf);
 163 #endif
 164     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
 165         libhandle, symbolname));
 166     RETVAL = dlsym(libhandle, symbolname);
 167     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
 168     ST(0) = sv_newmortal() ;
 169     if (RETVAL == NULL)
 170         SaveError("%s",dlerror()) ;
 171     else
 172         sv_setiv( ST(0), (IV)RETVAL);
 173
 174
 175 void
 176 dl_undef_symbols()
 177     PPCODE:
 178
 179
 180
 181 # These functions should not need changing on any platform:
 182
 183 void
 184 dl_install_xsub(perl_name, symref, filename="$Package")
 185     char *              perl_name
 186     void *              symref
 187     char *              filename
 188     CODE:
 189     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 190                 perl_name, symref));
 191     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 192
 193
 194 char *
 195 dl_error()
 196     CODE:
 197     RETVAL = LastError ;
 198     OUTPUT:
 199     RETVAL
 200
 201 # end.