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 #include "EXTERN.h"
  88 #include "perl.h"
  89 #include "XSUB.h"
  90
  91 #include <dll.h>        /* the dynamic linker include file for S/390 */
  92 #include <errno.h>      /* strerror() and friends */
  93
  94 #include "dlutils.c"    /* SaveError() etc */
  95
  96 static void
  97 dl_private_init(pTHX)
  98 {
  99     (void)dl_generic_private_init(aTHX);
 100 }
 101
 102 MODULE = DynaLoader     PACKAGE = DynaLoader
 103
 104 BOOT:
 105     (void)dl_private_init(aTHX);
 106
 107
 108 void *
 109 dl_load_file(filename, flags=0)
 110     char *      filename
 111     int         flags
 112   PREINIT:
 113     int mode = 0;
 114   CODE:
 115 {
 116     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
 117     /* add a (void *) dllload(filename) ; cast if needed */
 118     RETVAL = dllload(filename) ;
 119     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
 120     ST(0) = sv_newmortal() ;
 121     if (RETVAL == NULL)
 122         SaveError(aTHX_ "%s",strerror(errno)) ;
 123     else
 124         sv_setiv( ST(0), PTR2IV(RETVAL));
 125 }
 126
 127
 128 int
 129 dl_unload_file(libref)
 130     void *      libref
 131   CODE:
 132     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
 133     /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
 134     RETVAL = (dllfree(libref) == 0 ? 1 : 0);
 135     if (!RETVAL)
 136         SaveError(aTHX_ "%s", strerror(errno)) ;
 137     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
 138   OUTPUT:
 139     RETVAL
 140
 141
 142 void *
 143 dl_find_symbol(libhandle, symbolname)
 144     void *      libhandle
 145     char *      symbolname
 146     CODE:
 147     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
 148                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 149                              (unsigned long) libhandle, symbolname));
 150     if((RETVAL = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
 151     RETVAL = dllqueryvar(libhandle, symbolname);
 152     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
 153                              "  symbolref = %lx\n", (unsigned long) RETVAL));
 154     ST(0) = sv_newmortal() ;
 155     if (RETVAL == NULL)
 156         SaveError(aTHX_ "%s",strerror(errno)) ;
 157     else
 158         sv_setiv( ST(0), PTR2IV(RETVAL));
 159
 160
 161 void
 162 dl_undef_symbols()
 163     PPCODE:
 164
 165
 166
 167 # These functions should not need changing on any platform:
 168
 169 void
 170 dl_install_xsub(perl_name, symref, filename="$Package")
 171     char *              perl_name
 172     void *              symref
 173     char *              filename
 174     CODE:
 175     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
 176                 perl_name, (unsigned long) symref));
 177     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 178                                         (void(*)(pTHX_ CV *))symref,
 179                                         filename)));
 180
 181
 182 char *
 183 dl_error()
 184     CODE:
 185     dMY_CXT;
 186     RETVAL = dl_last_error ;
 187     OUTPUT:
 188     RETVAL
 189
 190 # end.