X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2Fdl_next.xs;h=e5774c0ac32d51ae0f6dfae9645ce293c2154c07;hb=dcfdccf94c5ada3342776b740fd487168bef3ca3;hp=6c8009ba0c1b5a12c00d895287627622e5e2c751;hpb=f66f545a34e46cca76544b7cd178ab5d7e450e92;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 6c8009b..e5774c0 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -8,11 +8,13 @@ */ /* - And Gandalf said: 'Many folk like to know beforehand what is to - be set on the table; but those who have laboured to prepare the - feast like to keep their secret; for wonder makes the words of - praise louder.' -*/ + * And Gandalf said: 'Many folk like to know beforehand what is to + * be set on the table; but those who have laboured to prepare the + * feast like to keep their secret; for wonder makes the words of + * praise louder.' + * + * [p.970 of _The Lord of the Rings_, VI/v: "The Steward and the King"] + */ /* Porting notes: @@ -44,14 +46,19 @@ Anno Siegel #define DL_LOADONCEONLY -#include "dlutils.c" /* SaveError() etc */ +typedef struct { + AV * x_resolve_using; +} 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" /* SaveError() etc */ -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) static char *dlerror() { + dTHX; + dMY_CXT; return dl_last_error; } @@ -73,13 +80,14 @@ static void TranslateError (const char *path, enum dyldErrorSource type, int number) { dTHX; + dMY_CXT; char *error; unsigned int index; static char *OFIErrorStrings[] = { "%s(%d): Object Image Load Failure\n", "%s(%d): Object Image Load Success\n", - "%s(%d): Not an recognisable object file\n", + "%s(%d): Not a recognisable object file\n", "%s(%d): No valid architecture\n", "%s(%d): Object image has an invalid format\n", "%s(%d): Invalid access (permissions?)\n", @@ -93,11 +101,11 @@ static void TranslateError index = number; if (index > NUM_OFI_ERRORS - 1) index = NUM_OFI_ERRORS - 1; - error = form(OFIErrorStrings[index], path, number); + error = Perl_form_nocontext(OFIErrorStrings[index], path, number); break; default: - error = form("%s(%d): Totally unknown error type %d\n", + error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", path, number, type); break; } @@ -150,12 +158,14 @@ static void TransferError(NXStream *s) { char *buffer; int len, maxlen; + dTHX; + dMY_CXT; if ( dl_last_error ) { Safefree(dl_last_error); } NXGetMemoryBuffer(s, &buffer, &len, &maxlen); - New(1097, dl_last_error, len, char); + Newx(dl_last_error, len, char); strcpy(dl_last_error, buffer); } @@ -174,6 +184,8 @@ static char *dlopen(char *path, int mode /* mode is ignored */) char *result; char **p; STRLEN n_a; + dTHX; + dMY_CXT; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -210,7 +222,7 @@ char *symbol; NXStream *nxerr = OpenError(); unsigned long symref = 0; - if (!rld_lookup(nxerr, form("_%s", symbol), &symref)) + if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref)) TransferError(nxerr); CloseError(nxerr); return (void*) symref; @@ -226,7 +238,10 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); + { + dMY_CXT; + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -243,16 +258,16 @@ dl_load_file(filename, flags=0) PREINIT: int mode = 1; CODE: - 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) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), PTR2IV(RETVAL)); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void * @@ -261,19 +276,19 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #if NS_TARGET_MAJOR >= 4 - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), PTR2IV(RETVAL)); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void @@ -288,20 +303,38 @@ 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(*)(pTHX_ CV *))symref, - filename))); + ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, + (void(*)(pTHX_ CV *))symref, + filename, NULL, + XS_DYNAMIC_FILENAME))); char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = 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 = newSVpvn("", 0); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + +#endif + # end.