/* * Written 3/1/94, Robert Sanders * * based upon the file "dl.c", which is * Copyright (c) 1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * * $Date: 1994/03/07 00:21:43 $ * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $ * $Revision: 1.4 $ * $State: Exp $ * * Adapted for use with FreeMINT after dld support was removed from perl. * * $Log: dld_dl.c,v $ * Removed implicit link against libc. 1994/09/14 William Setzer. * * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce. * * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer. * * Revision 1.4 1994/03/07 00:21:43 rsanders * added min symbol count for load_libs and switched order so system libs * are loaded after app-specified libs. * * Revision 1.3 1994/03/05 01:17:26 rsanders * added path searching. * * Revision 1.2 1994/03/05 00:52:39 rsanders * added package-specified libraries. * * Revision 1.1 1994/03/05 00:33:40 rsanders * Initial revision * * */ #define PERL_EXT #include "EXTERN.h" #define PERL_IN_DL_FREEMINT_XS #include "perl.h" #include "XSUB.h" #include /* GNU DLD header file */ #include typedef struct { AV * x_resolve_using; AV * x_require_symbols; } my_cxtx_t; /* this *must* be named my_cxtx_t */ #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ #include "dlutils.c" /* for SaveError() etc */ #define dl_resolve_using (dl_cxtx.x_resolve_using) #define dl_require_symbols (dl_cxtx.x_require_symbols) static void dl_private_init(pTHX) { dl_generic_private_init(aTHX); { int dlderr; dMY_CXT; dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); dlderr = dld_init("/kern/self/exe"); if (dlderr) { dlderr = dld_init(dld_find_executable(PL_origargv[0])); if (dlderr) { char *msg = dld_strerror(dlderr); SaveError(aTHX_ "dld_init(%s) failed: %s", dld_find_executable(PL_origargv[0]), msg); DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); } } } } MODULE = DynaLoader PACKAGE = DynaLoader BOOT: (void)dl_private_init(); void dl_load_file(filename, flags=0) char * filename int flags PREINIT: int dlderr,x,max; GV *gv; dMY_CXT; CODE: DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); max = AvFILL(dl_require_symbols); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); if (dlderr = dld_create_reference(sym)) { SaveError(aTHX_ "dld_create_reference(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); if (dlderr = dld_link(filename)) { SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); goto haverror; } DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libm.a)\n")); if (dlderr = dld_link("/usr/lib/libm.a")) { SaveError(aTHX_ "dld_link(libm.a): %s", dld_strerror(dlderr)); goto haverror; } DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libc.a)\n")); if (dlderr = dld_link("/usr/lib/libc.a")) { SaveError(aTHX_ "dld_link(libc.a): %s", dld_strerror(dlderr)); goto haverror; } max = AvFILL(dl_resolve_using); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); if (dlderr = dld_link(sym)) { SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", filename)); haverror: ST(0) = sv_newmortal() ; if (dlderr == 0) sv_setiv(ST(0), PTR2IV(filename)); XSRETURN(1); void dl_find_symbol(libhandle, symbolname, ign_err=0) void * libhandle char * symbolname int ign_err PREINIT: void *retv; CODE: DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); retv = (void *)dld_get_func(symbolname); DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", (unsigned int)retv)); ST(0) = sv_newmortal() ; if (retv == NULL) { if (!ign_err) SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; } else sv_setiv(ST(0), PTR2IV(retv)); XSRETURN(1); void dl_undef_symbols() PPCODE: if (dld_undefined_sym_count) { int x; char **undef_syms = dld_list_undefined_sym(); EXTEND(SP, dld_undefined_sym_count); for (x=0; x < dld_undefined_sym_count; x++) PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); free(undef_syms); } # These functions should not need changing on any platform: void dl_install_xsub(perl_name, symref, filename="$Package") char * perl_name void * symref const char * filename CODE: DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, (void(*)(pTHX_ CV *))symref, filename, NULL, XS_DYNAMIC_FILENAME))); XSRETURN(1); SV * dl_error() CODE: dMY_CXT; RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL #if defined(USE_ITHREADS) void CLONE(...) CODE: MY_CXT_CLONE; /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid * using Perl variables that belong to another thread, we create our * own for this thread. */ MY_CXT.x_dl_last_error = newSVpvs(""); dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); #endif # end.