X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2Fdl_dld.xs;h=ab72ca3c6ce065e0aaedd0f645c6287e36fa311b;hb=8381071f750dc80d2b1c239344ce1b5eb5c29628;hp=44933ec92ca2e41dcde90224c3fad3bb415551d6;hpb=ff7f3c60e77f15ff4f5a3176285a6a22c685a51b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index 44933ec..ab72ca3 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -42,31 +42,41 @@ #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 */ -static AV *dl_resolve_using = Nullav; -static AV *dl_require_symbols = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) +#define dl_require_symbols (dl_cxtx.x_require_symbols) static void -dl_private_init() +dl_private_init(pTHX) { - int dlderr; - dl_generic_private_init(); - dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); - dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4); + 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); #ifdef __linux__ - dlderr = dld_init("/proc/self/exe"); - if (dlderr) { + dlderr = dld_init("/proc/self/exe"); + if (dlderr) { #endif - dlderr = dld_init(dld_find_executable(origargv[0])); - if (dlderr) { - char *msg = dld_strerror(dlderr); - SaveError("dld_init(%s) failed: %s", origargv[0], msg); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError)); - } + dlderr = dld_init(dld_find_executable(PL_origargv[0])); + if (dlderr) { + char *msg = dld_strerror(dlderr); + SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); + } #ifdef __linux__ - } + } #endif + } } @@ -83,42 +93,43 @@ dl_load_file(filename, flags=0) PREINIT: int dlderr,x,max; GV *gv; + dMY_CXT; CODE: RETVAL = filename; - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) - croak("Can't make loaded symbols global on this platform while loading %s",filename); + 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(PerlIO_stderr(), "dld_create_ref(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); if (dlderr = dld_create_reference(sym)) { - SaveError("dld_create_reference(%s): %s", sym, + SaveError(aTHX_ "dld_create_reference(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); if (dlderr = dld_link(filename)) { - SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr)); + SaveError(aTHX_ "dld_link(%s): %s", filename, 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(PerlIO_stderr(), "dld_link(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); if (dlderr = dld_link(sym)) { - SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); + SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL)); haverror: ST(0) = sv_newmortal() ; if (dlderr == 0) - sv_setiv(ST(0), (IV)RETVAL); + sv_setiv(ST(0), PTR2IV(RETVAL)); void * @@ -126,16 +137,16 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void *)dld_get_func(symbolname); /* if RETVAL==NULL we should try looking for a non-function symbol */ - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ; + SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; else - sv_setiv(ST(0), (IV)RETVAL); + sv_setiv(ST(0), PTR2IV(RETVAL)); void @@ -144,7 +155,7 @@ dl_undef_symbols() if (dld_undefined_sym_count) { int x; char **undef_syms = dld_list_undefined_sym(); - EXTEND(sp, dld_undefined_sym_count); + 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); @@ -158,17 +169,21 @@ void dl_install_xsub(perl_name, symref, filename="$Package") char * perl_name void * symref - char * filename + const char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + 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(perl_name, (void(*)())symref, filename))); - + ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, + (void(*)(pTHX_ CV *))symref, + filename, NULL, + XS_DYNAMIC_FILENAME))); char * dl_error() + PREINIT: + dMY_CXT; CODE: - RETVAL = LastError ; + RETVAL = dl_last_error ; OUTPUT: RETVAL