16fb12b70Safresh1 /*
26fb12b70Safresh1 * Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org>
36fb12b70Safresh1 *
46fb12b70Safresh1 * based upon the file "dl.c", which is
56fb12b70Safresh1 * Copyright (c) 1994, Larry Wall
66fb12b70Safresh1 *
76fb12b70Safresh1 * You may distribute under the terms of either the GNU General Public
86fb12b70Safresh1 * License or the Artistic License, as specified in the README file.
96fb12b70Safresh1 *
106fb12b70Safresh1 * $Date: 1994/03/07 00:21:43 $
116fb12b70Safresh1 * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $
126fb12b70Safresh1 * $Revision: 1.4 $
136fb12b70Safresh1 * $State: Exp $
146fb12b70Safresh1 *
156fb12b70Safresh1 * Adapted for use with FreeMINT after dld support was removed from perl.
166fb12b70Safresh1 *
176fb12b70Safresh1 * $Log: dld_dl.c,v $
186fb12b70Safresh1 * Removed implicit link against libc. 1994/09/14 William Setzer.
196fb12b70Safresh1 *
206fb12b70Safresh1 * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce.
216fb12b70Safresh1 *
226fb12b70Safresh1 * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer.
236fb12b70Safresh1 *
246fb12b70Safresh1 * Revision 1.4 1994/03/07 00:21:43 rsanders
256fb12b70Safresh1 * added min symbol count for load_libs and switched order so system libs
266fb12b70Safresh1 * are loaded after app-specified libs.
276fb12b70Safresh1 *
286fb12b70Safresh1 * Revision 1.3 1994/03/05 01:17:26 rsanders
296fb12b70Safresh1 * added path searching.
306fb12b70Safresh1 *
316fb12b70Safresh1 * Revision 1.2 1994/03/05 00:52:39 rsanders
326fb12b70Safresh1 * added package-specified libraries.
336fb12b70Safresh1 *
346fb12b70Safresh1 * Revision 1.1 1994/03/05 00:33:40 rsanders
356fb12b70Safresh1 * Initial revision
366fb12b70Safresh1 *
376fb12b70Safresh1 *
386fb12b70Safresh1 */
396fb12b70Safresh1
40*b8851fccSafresh1 #define PERL_EXT
416fb12b70Safresh1 #include "EXTERN.h"
42*b8851fccSafresh1 #define PERL_IN_DL_FREEMINT_XS
436fb12b70Safresh1 #include "perl.h"
446fb12b70Safresh1 #include "XSUB.h"
456fb12b70Safresh1
466fb12b70Safresh1 #include <dld.h> /* GNU DLD header file */
476fb12b70Safresh1 #include <unistd.h>
486fb12b70Safresh1
496fb12b70Safresh1 typedef struct {
506fb12b70Safresh1 AV * x_resolve_using;
516fb12b70Safresh1 AV * x_require_symbols;
526fb12b70Safresh1 } my_cxtx_t; /* this *must* be named my_cxtx_t */
536fb12b70Safresh1
546fb12b70Safresh1 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
556fb12b70Safresh1 #include "dlutils.c" /* for SaveError() etc */
566fb12b70Safresh1
576fb12b70Safresh1 #define dl_resolve_using (dl_cxtx.x_resolve_using)
586fb12b70Safresh1 #define dl_require_symbols (dl_cxtx.x_require_symbols)
596fb12b70Safresh1
606fb12b70Safresh1 static void
dl_private_init(pTHX)616fb12b70Safresh1 dl_private_init(pTHX)
626fb12b70Safresh1 {
636fb12b70Safresh1 dl_generic_private_init(aTHX);
646fb12b70Safresh1 {
656fb12b70Safresh1 int dlderr;
666fb12b70Safresh1 dMY_CXT;
676fb12b70Safresh1
686fb12b70Safresh1 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
696fb12b70Safresh1 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
706fb12b70Safresh1 dlderr = dld_init("/kern/self/exe");
716fb12b70Safresh1 if (dlderr) {
726fb12b70Safresh1 dlderr = dld_init(dld_find_executable(PL_origargv[0]));
736fb12b70Safresh1 if (dlderr) {
746fb12b70Safresh1 char *msg = dld_strerror(dlderr);
756fb12b70Safresh1 SaveError(aTHX_ "dld_init(%s) failed: %s", dld_find_executable(PL_origargv[0]), msg);
766fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error));
776fb12b70Safresh1 }
786fb12b70Safresh1 }
796fb12b70Safresh1 }
806fb12b70Safresh1 }
816fb12b70Safresh1
826fb12b70Safresh1
836fb12b70Safresh1 MODULE = DynaLoader PACKAGE = DynaLoader
846fb12b70Safresh1
856fb12b70Safresh1 BOOT:
866fb12b70Safresh1 (void)dl_private_init();
876fb12b70Safresh1
886fb12b70Safresh1
896fb12b70Safresh1 void
906fb12b70Safresh1 dl_load_file(filename, flags=0)
916fb12b70Safresh1 char * filename
926fb12b70Safresh1 int flags
936fb12b70Safresh1 PREINIT:
946fb12b70Safresh1 int dlderr,x,max;
956fb12b70Safresh1 GV *gv;
966fb12b70Safresh1 dMY_CXT;
976fb12b70Safresh1 CODE:
986fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
996fb12b70Safresh1 if (flags & 0x01)
1006fb12b70Safresh1 Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
1016fb12b70Safresh1 max = AvFILL(dl_require_symbols);
1026fb12b70Safresh1 for (x = 0; x <= max; x++) {
1036fb12b70Safresh1 char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
1046fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
1056fb12b70Safresh1 if (dlderr = dld_create_reference(sym)) {
1066fb12b70Safresh1 SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
1076fb12b70Safresh1 dld_strerror(dlderr));
1086fb12b70Safresh1 goto haverror;
1096fb12b70Safresh1 }
1106fb12b70Safresh1 }
1116fb12b70Safresh1
1126fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
1136fb12b70Safresh1 if (dlderr = dld_link(filename)) {
1146fb12b70Safresh1 SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr));
1156fb12b70Safresh1 goto haverror;
1166fb12b70Safresh1 }
1176fb12b70Safresh1
1186fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libm.a)\n"));
1196fb12b70Safresh1 if (dlderr = dld_link("/usr/lib/libm.a")) {
1206fb12b70Safresh1 SaveError(aTHX_ "dld_link(libm.a): %s", dld_strerror(dlderr));
1216fb12b70Safresh1 goto haverror;
1226fb12b70Safresh1 }
1236fb12b70Safresh1
1246fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libc.a)\n"));
1256fb12b70Safresh1 if (dlderr = dld_link("/usr/lib/libc.a")) {
1266fb12b70Safresh1 SaveError(aTHX_ "dld_link(libc.a): %s", dld_strerror(dlderr));
1276fb12b70Safresh1 goto haverror;
1286fb12b70Safresh1 }
1296fb12b70Safresh1
1306fb12b70Safresh1 max = AvFILL(dl_resolve_using);
1316fb12b70Safresh1 for (x = 0; x <= max; x++) {
1326fb12b70Safresh1 char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
1336fb12b70Safresh1 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
1346fb12b70Safresh1 if (dlderr = dld_link(sym)) {
1356fb12b70Safresh1 SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
1366fb12b70Safresh1 goto haverror;
1376fb12b70Safresh1 }
1386fb12b70Safresh1 }
1396fb12b70Safresh1 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", filename));
1406fb12b70Safresh1 haverror:
1416fb12b70Safresh1 ST(0) = sv_newmortal() ;
1426fb12b70Safresh1 if (dlderr == 0)
1436fb12b70Safresh1 sv_setiv(ST(0), PTR2IV(filename));
1446fb12b70Safresh1 XSRETURN(1);
1456fb12b70Safresh1
1466fb12b70Safresh1
1476fb12b70Safresh1 void
148*b8851fccSafresh1 dl_find_symbol(libhandle, symbolname, ign_err=0)
1496fb12b70Safresh1 void * libhandle
1506fb12b70Safresh1 char * symbolname
151*b8851fccSafresh1 int ign_err
1526fb12b70Safresh1 PREINIT:
1536fb12b70Safresh1 void *retv;
1546fb12b70Safresh1 CODE:
1556fb12b70Safresh1 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
1566fb12b70Safresh1 libhandle, symbolname));
1576fb12b70Safresh1 retv = (void *)dld_get_func(symbolname);
1586fb12b70Safresh1 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", (unsigned int)retv));
1596fb12b70Safresh1 ST(0) = sv_newmortal() ;
160*b8851fccSafresh1 if (retv == NULL) {
161*b8851fccSafresh1 if (!ign_err)
1626fb12b70Safresh1 SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
163*b8851fccSafresh1 } else
1646fb12b70Safresh1 sv_setiv(ST(0), PTR2IV(retv));
1656fb12b70Safresh1 XSRETURN(1);
1666fb12b70Safresh1
1676fb12b70Safresh1
1686fb12b70Safresh1 void
1696fb12b70Safresh1 dl_undef_symbols()
1706fb12b70Safresh1 PPCODE:
1716fb12b70Safresh1 if (dld_undefined_sym_count) {
1726fb12b70Safresh1 int x;
1736fb12b70Safresh1 char **undef_syms = dld_list_undefined_sym();
1746fb12b70Safresh1 EXTEND(SP, dld_undefined_sym_count);
1756fb12b70Safresh1 for (x=0; x < dld_undefined_sym_count; x++)
1766fb12b70Safresh1 PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
1776fb12b70Safresh1 free(undef_syms);
1786fb12b70Safresh1 }
1796fb12b70Safresh1
1806fb12b70Safresh1
1816fb12b70Safresh1
1826fb12b70Safresh1 # These functions should not need changing on any platform:
1836fb12b70Safresh1
1846fb12b70Safresh1 void
1856fb12b70Safresh1 dl_install_xsub(perl_name, symref, filename="$Package")
1866fb12b70Safresh1 char * perl_name
1876fb12b70Safresh1 void * symref
1886fb12b70Safresh1 const char * filename
1896fb12b70Safresh1 CODE:
1906fb12b70Safresh1 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
1916fb12b70Safresh1 perl_name, symref));
1926fb12b70Safresh1 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
1936fb12b70Safresh1 (void(*)(pTHX_ CV *))symref,
1946fb12b70Safresh1 filename, NULL,
1956fb12b70Safresh1 XS_DYNAMIC_FILENAME)));
1966fb12b70Safresh1 XSRETURN(1);
1976fb12b70Safresh1
198*b8851fccSafresh1 SV *
1996fb12b70Safresh1 dl_error()
2006fb12b70Safresh1 CODE:
201*b8851fccSafresh1 dMY_CXT;
202*b8851fccSafresh1 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
2036fb12b70Safresh1 OUTPUT:
2046fb12b70Safresh1 RETVAL
2056fb12b70Safresh1
2066fb12b70Safresh1 #if defined(USE_ITHREADS)
2076fb12b70Safresh1
2086fb12b70Safresh1 void
2096fb12b70Safresh1 CLONE(...)
2106fb12b70Safresh1 CODE:
2116fb12b70Safresh1 MY_CXT_CLONE;
2126fb12b70Safresh1
2136fb12b70Safresh1 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
2146fb12b70Safresh1 * using Perl variables that belong to another thread, we create our
2156fb12b70Safresh1 * own for this thread.
2166fb12b70Safresh1 */
217*b8851fccSafresh1 MY_CXT.x_dl_last_error = newSVpvs("");
2186fb12b70Safresh1 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
2196fb12b70Safresh1 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
2206fb12b70Safresh1
2216fb12b70Safresh1 #endif
2226fb12b70Safresh1
2236fb12b70Safresh1 # end.
224