home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2J (Developer) / os42jdev.iso / NextDeveloper / Source / GNU / perl / Perl / ext / DynaLoader / dl_dld.xs < prev    next >
Encoding:
Text File  |  1994-10-18  |  4.3 KB  |  174 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 void
  48. dl_private_init()
  49. {
  50.     int dlderr;
  51.     dl_generic_private_init();
  52. #ifdef __linux__
  53.     dlderr = dld_init("/proc/self/exe");
  54.     if (dlderr) {
  55. #endif
  56.         dlderr = dld_init(dld_find_executable(origargv[0]));
  57.         if (dlderr) {
  58.             char *msg = dld_strerror(dlderr);
  59.             SaveError("dld_init(%s) failed: %s", origargv[0], msg);
  60.             DLDEBUG(1,fprintf(stderr,"%s", LastError));
  61.         }
  62. #ifdef __linux__
  63.     }
  64. #endif
  65. }
  66.  
  67.  
  68. MODULE = DynaLoader     PACKAGE = DynaLoader
  69.  
  70. BOOT:
  71.     (void)dl_private_init();
  72.  
  73.  
  74. char *
  75. dl_load_file(filename)
  76.     char *    filename
  77.     CODE:
  78.     int dlderr,x,max;
  79.     GV *gv;
  80.     AV *av;
  81.     RETVAL = filename;
  82.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename));
  83.     gv = gv_fetchpv("DynaLoader::dl_require_symbols", FALSE, SVt_PVAV);
  84.     if (gv) {
  85.     av  = GvAV(gv);
  86.     max = AvFILL(av);
  87.     for (x = 0; x <= max; x++) {
  88.         char *sym = SvPVX(*av_fetch(av, x, 0));
  89.         DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym));
  90.         if (dlderr = dld_create_reference(sym)) {
  91.         SaveError("dld_create_reference(%s): %s", sym,
  92.               dld_strerror(dlderr));
  93.         goto haverror;
  94.         }
  95.     }
  96.     }
  97.     DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename));
  98.     if (dlderr = dld_link(filename)) {
  99.     SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr));
  100.     goto haverror;
  101.     }
  102.     gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV);
  103.     if (gv) {
  104.     av  = GvAV(gv);
  105.     max = AvFILL(av);
  106.     for (x = 0; x <= max; x++) {
  107.         char *sym = SvPVX(*av_fetch(av, 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.     }
  115.     DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL));
  116. haverror:
  117.     ST(0) = sv_newmortal() ;
  118.     if (dlderr == 0)
  119.     sv_setiv(ST(0), (IV)RETVAL);
  120.  
  121.  
  122. void *
  123. dl_find_symbol(libhandle, symbolname)
  124.     void *    libhandle
  125.     char *    symbolname
  126.     CODE:
  127.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  128.         libhandle, symbolname));
  129.     RETVAL = (void *)dld_get_func(symbolname);
  130.     /* if RETVAL==NULL we should try looking for a non-function symbol */
  131.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  132.     ST(0) = sv_newmortal() ;
  133.     if (RETVAL == NULL)
  134.     SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
  135.     else
  136.     sv_setiv(ST(0), (IV)RETVAL);
  137.  
  138.  
  139. void
  140. dl_undef_symbols()
  141.     PPCODE:
  142.     if (dld_undefined_sym_count) {
  143.     int x;
  144.     char **undef_syms = dld_list_undefined_sym();
  145.     EXTEND(sp, dld_undefined_sym_count);
  146.     for (x=0; x < dld_undefined_sym_count; x++)
  147.         PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
  148.     free(undef_syms);
  149.     }
  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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  162.         perl_name, symref));
  163.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  164.  
  165.  
  166. char *
  167. dl_error()
  168.     CODE:
  169.     RETVAL = LastError ;
  170.     OUTPUT:
  171.     RETVAL
  172.  
  173. # end.
  174.