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     }
 163     else
 164         sv_setiv( ST(0), PTR2IV(retv));
 165     XSRETURN(1);
 166
 167
 168 void
 169 dl_undef_symbols()
 170     CODE:
 171
 172
 173
 174 # These functions should not need changing on any platform:
 175
 176 void
 177 dl_install_xsub(perl_name, symref, filename="$Package")
 178     char *              perl_name
 179     void *              symref
 180     const char *        filename
 181     PPCODE:
 182     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
 183                 perl_name, (unsigned long) symref));
 184     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
 185                                               (void(*)(pTHX_ CV *))symref,
 186                                               filename, NULL,
 187                                               XS_DYNAMIC_FILENAME)));
 188     XSRETURN(1);
 189
 190
 191 SV *
 192 dl_error()
 193     CODE:
 194     dMY_CXT;
 195     RETVAL = newSVsv(MY_CXT.x_dl_last_error);
 196     OUTPUT:
 197     RETVAL
 198
 199 #if defined(USE_ITHREADS)
 200
 201 void
 202 CLONE(...)
 203     CODE:
 204     MY_CXT_CLONE;
 205
 206     PERL_UNUSED_VAR(items);
 207
 208     /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
 209      * using Perl variables that belong to another thread, we create our
 210      * own for this thread.
 211      */
 212     MY_CXT.x_dl_last_error = newSVpvs("");
 213
 214 #endif
 215
 216 # end.