home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dl_vmesa.xs < prev    next >
Text File  |  1999-10-05  |  5KB  |  176 lines
  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(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
  120.     RETVAL = dlopen(filename) ;
  121.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " 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), PTR2IV(RETVAL) );
  127.  
  128.  
  129. void *
  130. dl_find_symbol(libhandle, symbolname)
  131.     void *    libhandle
  132.     char *    symbolname
  133.     CODE:
  134.     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  135.                  "dl_find_symbol(handle=%lx, symbol=%s)\n",
  136.                  (unsigned long) libhandle, symbolname));
  137.     RETVAL = dlsym(libhandle, symbolname);
  138.     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  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), PTR2IV(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(Perl_debug_log, "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.
  176.