ext/DynaLoader/dl_vmesa.xs

   1 /* dl_vmesa.xs
   2  *
   3  * Platform:    VM/ESA, possibly others which use dllload etc.
   4  * Author:      Neale Ferguson (neale@mailbox.tabnsw.com.au)
   5  * Created:     23rd Septemer, 1998
   6  *
   7  *
   8  */
   9
  10 /* Porting notes:
  11
  12
  13    Definition of VM/ESA dynamic Linking functions
  14    ==============================================
  15    In order to make this implementation easier to understand here is a
  16    quick definition of the VM/ESA Dynamic Linking functions which are
  17    used here.
  18
  19    dlopen
  20    ------
  21      void *
  22      dlopen(const char *path)
  23
  24      This function takes the name of a dynamic object file and returns
  25      a descriptor which can be used by dlsym later. It returns NULL on
  26      error.
  27
  28
  29    dllsym
  30    ------
  31      void *
  32      dlsym(void *handle, char *symbol)
  33
  34      Takes the handle returned from dlopen and the name of a symbol to
  35      get the address of. If the symbol was found a pointer is
  36      returned.  It returns NULL on error.
  37
  38    dlerror
  39    -------
  40      char * dlerror()
  41
  42      Returns a null-terminated string which describes the last error
  43      that occurred with the other dll functions. After each call to
  44      dlerror the error message will be reset to a null pointer. The
  45      SaveError function is used to save the error as soo as it happens.
  46
  47
  48    Return Types
  49    ============
  50    In this implementation the two functions, dl_load_file &
  51    dl_find_symbol, return void *. This is because the underlying SunOS
  52    dynamic linker calls also return void *.  This is not necessarily
  53    the case for all architectures. For example, some implementation
  54    will want to return a char * for dl_load_file.
  55
  56    If void * is not appropriate for your architecture, you will have to
  57    change the void * to whatever you require. If you are not certain of
  58    how Perl handles C data types, I suggest you start by consulting
  59    Dean Roerich's Perl 5 API document. Also, have a look in the typemap
  60    file (in the ext directory) for a fairly comprehensive list of types
  61    that are already supported. If you are completely stuck, I suggest you
  62    post a message to perl5-porters, comp.lang.perl.misc or if you are really
  63    desperate to me.
  64
  65    Remember when you are making any changes that the return value from
  66    dl_load_file is used as a parameter in the dl_find_symbol
  67    function. Also the return value from find_symbol is used as a parameter
  68    to install_xsub.
  69
  70
  71    Dealing with Error Messages
  72    ============================
  73    In order to make the handling of dynamic linking errors as generic as
  74    possible you should store any error messages associated with your
  75    implementation with the StoreError function.
  76
  77    In the case of VM/ESA the function dlerror returns the error message
  78    associated with the last dynamic link error. As the VM/ESA dynamic
  79    linker functions return NULL on error every call to a VM/ESA dynamic
  80    dynamic link routine is coded like this
  81
  82         RETVAL = dlopen(filename) ;
  83         if (RETVAL == NULL)
  84             SaveError(aTHX_ "%s",dlerror()) ;
  85
  86    Note that SaveError() takes a printf format string. Use a "%s" as
  87    the first parameter if the error may contain and % characters.
  88
  89 */
  90
  91 #include "EXTERN.h"
  92 #include "perl.h"
  93 #include "XSUB.h"
  94 #include <dll.h>
  95
  96
  97 #include "dlutils.c"    /* SaveError() etc      */
  98
  99
 100 static void
 101 dl_private_init(pTHX)
 102 {
 103     (void)dl_generic_private_init(aTHX);
 104 }
 105
 106 MODULE = DynaLoader     PACKAGE = DynaLoader
 107
 108 BOOT:
 109     (void)dl_private_init(aTHX);
 110
 111
 112 void *
 113 dl_load_file(filename, flags=0)
 114     char *      filename
 115     int         flags
 116     CODE:
 117     if (flags & 0x01)
 118         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 119     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 120     RETVAL = dlopen(filename) ;
 121     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
 122     ST(0) = sv_newmortal() ;
 123     if (RETVAL == NULL)
 124         SaveError(aTHX_ "%s",dlerror()) ;
 125     else
 126         sv_setiv( ST(0), (IV)RETVAL);
 127
 128
 129 void *
 130 dl_find_symbol(libhandle, symbolname)
 131     void *      libhandle
 132     char *      symbolname
 133     CODE:
 134     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 135                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 136                              (unsigned long) libhandle, symbolname));
 137     RETVAL = dlsym(libhandle, symbolname);
 138     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 139                              "  symbolref = %lx\n", (unsigned long) RETVAL));
 140     ST(0) = sv_newmortal() ;
 141     if (RETVAL == NULL)
 142         SaveError(aTHX_ "%s",dlerror()) ;
 143     else
 144         sv_setiv( ST(0), (IV)RETVAL);
 145
 146
 147 void
 148 dl_undef_symbols()
 149     PPCODE:
 150
 151
 152
 153 # These functions should not need changing on any platform:
 154
 155 void
 156 dl_install_xsub(perl_name, symref, filename="$Package")
 157     char *              perl_name
 158     void *              symref
 159     char *              filename
 160     CODE:
 161     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
 162                 perl_name, (unsigned long) symref));
 163     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 164                                         (void(*)(pTHX_ CV *))symref,
 165                                         filename)));
 166
 167
 168 char *
 169 dl_error()
 170     CODE:
 171     RETVAL = LastError ;
 172     OUTPUT:
 173     RETVAL
 174
 175 # end.