home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / ext / DynaLoader / dl_dld.xs < prev    next >
Text File  |  1995-10-19  |  4KB  |  173 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()
  52. {
  53.     int dlderr;
  54.     dl_generic_private_init();
  55.     dl_resolve_using   = perl_get_av("DynaLoader::dl_resolve_using",   0x4);
  56.     dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
  57. #ifdef __linux__
  58.     dlderr = dld_init("/proc/self/exe");
  59.     if (dlderr) {
  60. #endif
  61.         dlderr = dld_init(dld_find_executable(origargv[0]));
  62.         if (dlderr) {
  63.             char *msg = dld_strerror(dlderr);
  64.             SaveError("dld_init(%s) failed: %s", origargv[0], msg);
  65.             DLDEBUG(1,fprintf(stderr,"%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)
  81.     char *    filename
  82.     CODE:
  83.     int dlderr,x,max;
  84.     GV *gv;
  85.     RETVAL = filename;
  86.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename));
  87.  
  88.     max = AvFILL(dl_require_symbols);
  89.     for (x = 0; x <= max; x++) {
  90.     char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
  91.     DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym));
  92.     if (dlderr = dld_create_reference(sym)) {
  93.         SaveError("dld_create_reference(%s): %s", sym,
  94.               dld_strerror(dlderr));
  95.         goto haverror;
  96.     }
  97.     }
  98.  
  99.     DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename));
  100.     if (dlderr = dld_link(filename)) {
  101.     SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr));
  102.     goto haverror;
  103.     }
  104.  
  105.     max = AvFILL(dl_resolve_using);
  106.     for (x = 0; x <= max; x++) {
  107.     char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
  108.     DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym));
  109.     if (dlderr = dld_link(sym)) {
  110.         SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
  111.         goto haverror;
  112.     }
  113.     }
  114.     DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL));
  115. haverror:
  116.     ST(0) = sv_newmortal() ;
  117.     if (dlderr == 0)
  118.     sv_setiv(ST(0), (IV)RETVAL);
  119.  
  120.  
  121. void *
  122. dl_find_symbol(libhandle, symbolname)
  123.     void *    libhandle
  124.     char *    symbolname
  125.     CODE:
  126.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  127.         libhandle, symbolname));
  128.     RETVAL = (void *)dld_get_func(symbolname);
  129.     /* if RETVAL==NULL we should try looking for a non-function symbol */
  130.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  131.     ST(0) = sv_newmortal() ;
  132.     if (RETVAL == NULL)
  133.     SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
  134.     else
  135.     sv_setiv(ST(0), (IV)RETVAL);
  136.  
  137.  
  138. void
  139. dl_undef_symbols()
  140.     PPCODE:
  141.     if (dld_undefined_sym_count) {
  142.     int x;
  143.     char **undef_syms = dld_list_undefined_sym();
  144.     EXTEND(sp, dld_undefined_sym_count);
  145.     for (x=0; x < dld_undefined_sym_count; x++)
  146.         PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
  147.     free(undef_syms);
  148.     }
  149.  
  150.  
  151.  
  152. # These functions should not need changing on any platform:
  153.  
  154. void
  155. dl_install_xsub(perl_name, symref, filename="$Package")
  156.     char *    perl_name
  157.     void *    symref 
  158.     char *    filename
  159.     CODE:
  160.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  161.         perl_name, symref));
  162.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  163.  
  164.  
  165. char *
  166. dl_error()
  167.     CODE:
  168.     RETVAL = LastError ;
  169.     OUTPUT:
  170.     RETVAL
  171.  
  172. # end.
  173.