ext/DynaLoader/dl_dllload.xs

   1 /* dl_dllload.xs
   2  *
   3  * Platform:    OS/390, possibly others that use dllload(),dllfree() (VM/ESA?).
   4  * Authors:     John Goodyear && Peter Prymmer
   5  * Created:     28 October 2000
   6  * Modified:
   7  * 16 January 2001 - based loosely on dl_dlopen.xs.
   8  */
   9
  10 /* Porting notes:
  11
  12    OS/390 Dynamic Loading functions:
  13
  14    dllload
  15    -------
  16      dllhandle * dllload(const char *dllName)
  17
  18      This function takes the name of a dynamic object file and returns
  19      a descriptor which can be used by dlllqueryfn() and/or dllqueryvar()
  20      later.  If dllName contains a slash, it is used to locate the dll.
  21      If not then the LIBPATH environment variable is used to
  22      search for the requested dll (at least within the HFS).
  23      It returns NULL on error and sets errno.
  24
  25    dllfree
  26    -------
  27      int dllfree(dllhandle *handle);
  28
  29      dllfree() decrements the load count for the dll and frees
  30      it if the count is 0.  It returns zero on success, and
  31      non-zero on failure.
  32
  33    dllqueryfn && dllqueryvar
  34    -------------------------
  35      void (* dllqueryfn(dllhandle *handle, const char *function))();
  36      void * dllqueryvar(dllhandle *handle, const char *symbol);
  37
  38      dllqueryfn() takes the handle returned from dllload() and the name
  39      of a function to get the address of.  If the function was found
  40      a pointer is returned, otherwise NULL is returned.
  41
  42      dllqueryvar() takes the handle returned from dllload() and the name
  43      of a symbol to get the address of.  If the variable was found a
  44      pointer is returned, otherwise NULL is returned.
  45
  46      The XS dl_find_symbol() first calls dllqueryfn().  If it fails
  47      dlqueryvar() is then called.
  48
  49    strerror
  50    --------
  51      char * strerror(int errno)
  52
  53      Returns a null-terminated string which describes the last error
  54      that occurred with other functions (not necessarily unique to
  55      dll loading).
  56
  57    Return Types
  58    ============
  59    In this implementation the two functions, dl_load_file() &&
  60    dl_find_symbol(), return (void *).  This is primarily because the
  61    dlopen() && dlsym() style dynamic linker calls return (void *).
  62    We suspect that casting to (void *) may be easier than teaching XS
  63    typemaps about the (dllhandle *) type.
  64
  65    Dealing with Error Messages
  66    ===========================
  67    In order to make the handling of dynamic linking errors as generic as
  68    possible you should store any error messages associated with your
  69    implementation with the StoreError function.
  70
  71    In the case of OS/390 the function strerror(errno) returns the error
  72    message associated with the last dynamic link error.  As the S/390
  73    dynamic linker functions dllload() && dllqueryvar() both return NULL
  74    on error every call to an S/390 dynamic link routine is coded
  75    like this:
  76
  77         RETVAL = dllload(filename) ;
  78         if (RETVAL == NULL)
  79             SaveError("%s",strerror(errno)) ;
  80
  81    Note that SaveError() takes a printf format string. Use a "%s" as
  82    the first parameter if the error may contain any % characters.
  83
  84    Other comments within the dl_dlopen.xs file may be helpful as well.
  85 */
  86
  87 #define PERL_EXT
  88 #include "EXTERN.h"
  89 #define PERL_IN_DL_DLLLOAD_XS
  90 #include "perl.h"
  91 #include "XSUB.h"
  92
  93 #include <dll.h>        /* the dynamic linker include file for S/390 */
  94 #include <errno.h>      /* strerror() and friends */
  95
  96 #include "dlutils.c"    /* SaveError() etc */
  97
  98 static void
  99 dl_private_init(pTHX)
 100 {
 101     (void)dl_generic_private_init(aTHX);
 102 }
 103
 104 MODULE = DynaLoader     PACKAGE = DynaLoader
 105
 106 BOOT:
 107     (void)dl_private_init(aTHX);
 108
 109
 110 void
 111 dl_load_file(filename, flags=0)
 112     char *      filename
 113     int         flags
 114   PREINIT:
 115     int mode = 0;
 116     void *retv;
 117   PPCODE:
 118     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
 119     /* add a (void *) dllload(filename) ; cast if needed */
 120     retv = dllload(filename) ;
 121     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) retv));
 122     ST(0) = sv_newmortal() ;
 123     if (retv == NULL)
 124         SaveError(aTHX_ "%s",strerror(errno)) ;
 125     else
 126         sv_setiv( ST(0), PTR2IV(retv));
 127     XSRETURN(1);
 128
 129
 130 int
 131 dl_unload_file(libref)
 132     void *      libref
 133   CODE:
 134     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
 135     /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
 136     RETVAL = (dllfree(libref) == 0 ? 1 : 0);
 137     if (!RETVAL)
 138         SaveError(aTHX_ "%s", strerror(errno)) ;
 139     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
 140   OUTPUT:
 141     RETVAL
 142
 143
 144 void
 145 dl_find_symbol(libhandle, symbolname, ign_err=0)
 146     void *      libhandle
 147     char *      symbolname
 148     int         ign_err
 149     PREINIT:
 150     void *retv;
 151     PPCODE:
 152     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
 153                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 154                              (unsigned long) libhandle, symbolname));
 155     if((retv = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
 156     retv  = dllqueryvar(libhandle, symbolname);
 157     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
 158                              "  symbolref = %lx\n", (unsigned long) retv));
 159     ST(0) = sv_newmortal();
 160     if (retv == NULL)
 161         if (!ign_err) SaveError(aTHX_ "%s", strerror(errno));
 162     else
 163         sv_setiv( ST(0), PTR2IV(retv));
 164     XSRETURN(1);
 165
 166
 167 void
 168 dl_undef_symbols()
 169     CODE:
 170
 171
 172
 173 # These functions should not need changing on any platform:
 174
 175 void
 176 dl_install_xsub(perl_name, symref, filename="$Package")
 177     char *              perl_name
 178     void *              symref
 179     const char *        filename
 180     PPCODE:
 181     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
 182                 perl_name, (unsigned long) symref));
 183     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
 184                                               (void(*)(pTHX_ CV *))symref,
 185                                               filename, NULL,
 186                                               XS_DYNAMIC_FILENAME)));
 187     XSRETURN(1);
 188
 189
 190 SV *
 191 dl_error()
 192     CODE:
 193     dMY_CXT;
 194     RETVAL = newSVsv(MY_CXT.x_dl_last_error);
 195     OUTPUT:
 196     RETVAL
 197
 198 #if defined(USE_ITHREADS)
 199
 200 void
 201 CLONE(...)
 202     CODE:
 203     MY_CXT_CLONE;
 204
 205     PERL_UNUSED_VAR(items);
 206
 207     /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
 208      * using Perl variables that belong to another thread, we create our
 209      * own for this thread.
 210      */
 211     MY_CXT.x_dl_last_error = newSVpvs("");
 212
 213 #endif
 214
 215 # end.