home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dl_dld.xs < prev    next >
Text File  |  1999-12-16  |  5KB  |  178 lines
  1. /*
  2.  *    Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org>
  3.  *
  4.  * based upon the file "dl.c", which is
  5.  *    Copyright (c) 1994, Larry Wall
  6.  *
  7.  *    You may distribute under the terms of either the GNU General Public
  8.  *    License or the Artistic License, as specified in the README file.
  9.  *
  10.  * $Date: 1994/03/07 00:21:43 $
  11.  * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $
  12.  * $Revision: 1.4 $
  13.  * $State: Exp $
  14.  *
  15.  * $Log: dld_dl.c,v $
  16.  * Removed implicit link against libc.  1994/09/14 William Setzer.
  17.  *
  18.  * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce.
  19.  *
  20.  * rewrote dl_load_file, misc updates.  1994/09/03 William Setzer.
  21.  *
  22.  * Revision 1.4  1994/03/07  00:21:43  rsanders
  23.  * added min symbol count for load_libs and switched order so system libs
  24.  * are loaded after app-specified libs.
  25.  *
  26.  * Revision 1.3  1994/03/05  01:17:26  rsanders
  27.  * added path searching.
  28.  *
  29.  * Revision 1.2  1994/03/05  00:52:39  rsanders
  30.  * added package-specified libraries.
  31.  *
  32.  * Revision 1.1  1994/03/05  00:33:40  rsanders
  33.  * Initial revision
  34.  *
  35.  *
  36.  */
  37.  
  38. #include "EXTERN.h"
  39. #include "perl.h"
  40. #include "XSUB.h"
  41.  
  42. #include <dld.h>    /* GNU DLD header file */
  43. #include <unistd.h>
  44.  
  45. #include "dlutils.c"    /* for SaveError() etc */
  46.  
  47. static AV *dl_resolve_using   = Nullav;
  48. static AV *dl_require_symbols = Nullav;
  49.  
  50. static void
  51. dl_private_init(pTHX)
  52. {
  53.     int dlderr;
  54.     dl_generic_private_init(aTHX);
  55.     dl_resolve_using   = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
  56.     dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
  57. #ifdef __linux__
  58.     dlderr = dld_init("/proc/self/exe");
  59.     if (dlderr) {
  60. #endif
  61.         dlderr = dld_init(dld_find_executable(PL_origargv[0]));
  62.         if (dlderr) {
  63.             char *msg = dld_strerror(dlderr);
  64.             SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg);
  65.             DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError));
  66.         }
  67. #ifdef __linux__
  68.     }
  69. #endif
  70. }
  71.  
  72.  
  73. MODULE = DynaLoader     PACKAGE = DynaLoader
  74.  
  75. BOOT:
  76.     (void)dl_private_init();
  77.  
  78.  
  79. char *
  80. dl_load_file(filename, flags=0)
  81.     char *    filename
  82.     int        flags
  83.     PREINIT:
  84.     int dlderr,x,max;
  85.     GV *gv;
  86.     CODE:
  87.     RETVAL = filename;
  88.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
  89.     if (flags & 0x01)
  90.     Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
  91.     max = AvFILL(dl_require_symbols);
  92.     for (x = 0; x <= max; x++) {
  93.     char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
  94.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
  95.     if (dlderr = dld_create_reference(sym)) {
  96.         SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
  97.               dld_strerror(dlderr));
  98.         goto haverror;
  99.     }
  100.     }
  101.  
  102.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
  103.     if (dlderr = dld_link(filename)) {
  104.     SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr));
  105.     goto haverror;
  106.     }
  107.  
  108.     max = AvFILL(dl_resolve_using);
  109.     for (x = 0; x <= max; x++) {
  110.     char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
  111.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
  112.     if (dlderr = dld_link(sym)) {
  113.         SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
  114.         goto haverror;
  115.     }
  116.     }
  117.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL));
  118. haverror:
  119.     ST(0) = sv_newmortal() ;
  120.     if (dlderr == 0)
  121.     sv_setiv(ST(0), PTR2IV(RETVAL));
  122.  
  123.  
  124. void *
  125. dl_find_symbol(libhandle, symbolname)
  126.     void *    libhandle
  127.     char *    symbolname
  128.     CODE:
  129.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
  130.         libhandle, symbolname));
  131.     RETVAL = (void *)dld_get_func(symbolname);
  132.     /* if RETVAL==NULL we should try looking for a non-function symbol */
  133.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
  134.     ST(0) = sv_newmortal() ;
  135.     if (RETVAL == NULL)
  136.     SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
  137.     else
  138.     sv_setiv(ST(0), PTR2IV(RETVAL));
  139.  
  140.  
  141. void
  142. dl_undef_symbols()
  143.     PPCODE:
  144.     if (dld_undefined_sym_count) {
  145.     int x;
  146.     char **undef_syms = dld_list_undefined_sym();
  147.     EXTEND(SP, dld_undefined_sym_count);
  148.     for (x=0; x < dld_undefined_sym_count; x++)
  149.         PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
  150.     free(undef_syms);
  151.     }
  152.  
  153.  
  154.  
  155. # These functions should not need changing on any platform:
  156.  
  157. void
  158. dl_install_xsub(perl_name, symref, filename="$Package")
  159.     char *    perl_name
  160.     void *    symref 
  161.     char *    filename
  162.     CODE:
  163.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
  164.         perl_name, symref));
  165.     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
  166.                     (void(*)(pTHX_ CV *))symref,
  167.                     filename)));
  168.  
  169.  
  170. char *
  171. dl_error()
  172.     CODE:
  173.     RETVAL = LastError ;
  174.     OUTPUT:
  175.     RETVAL
  176.  
  177. # end.
  178.