ext/DynaLoader/dl_dld.xs

   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.