X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2Fdl_dlopen.xs;h=dfa9d0675a7942f7a8fd2f4ecb3e9eae9d742127;hb=12c541f435c0fde6414e8942d051e05098e0253e;hp=0746bc5ea5411fd628f728d3e00853f097bff96e;hpb=0536e0eb9430aabbd7108b476aed1956f9be68df;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 0746bc5..dfa9d06 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -5,11 +5,13 @@ * Created: 10th July 1994 * * Modified: - * 15th July 1994 - Added code to explicitly save any error messages. - * 3rd August 1994 - Upgraded to v3 spec. - * 9th August 1994 - Changed to use IV - * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, - * basic FreeBSD support, removed ClearError + * 15th July 1994 - Added code to explicitly save any error messages. + * 3rd August 1994 - Upgraded to v3 spec. + * 9th August 1994 - Changed to use IV + * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, + * basic FreeBSD support, removed ClearError + * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd + * files when the interpreter exits * */ @@ -37,6 +39,17 @@ RTLD_LAZY (==2) on Solaris 2. + dlclose + ------- + int + dlclose(handle) + void * handle; + + This function takes the handle returned by a previous invocation of + dlopen and closes the associated dynamic object file. It returns zero + on success, and non-zero on failure. + + dlsym ------ void * @@ -57,7 +70,7 @@ Returns a null-terminated string which describes the last error that occurred with either dlopen or dlsym. After each call to dlerror the error message will be reset to a null pointer. The - SaveError function is used to save the error as soo as it happens. + SaveError function is used to save the error as soon as it happens. Return Types @@ -99,7 +112,7 @@ SaveError("%s",dlerror()) ; Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain and % characters. + the first parameter if the error may contain any % characters. */ @@ -142,16 +155,31 @@ BOOT: (void)dl_private_init(aTHX); -void * +void dl_load_file(filename, flags=0) char * filename int flags - PREINIT: + PREINIT: int mode = RTLD_LAZY; - CODE: + void *handle; + CODE: +{ +#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) + char pathbuf[PATH_MAX + 2]; + if (*filename != '/' && strchr(filename, '/')) { + if (getcwd(pathbuf, PATH_MAX - strlen(filename))) { + strcat(pathbuf, "/"); + strcat(pathbuf, filename); + filename = pathbuf; + } + } +#endif #ifdef RTLD_NOW - if (dl_nonlazy) - mode = RTLD_NOW; + { + dMY_CXT; + if (dl_nonlazy) + mode = RTLD_NOW; + } #endif if (flags & 0x01) #ifdef RTLD_GLOBAL @@ -160,39 +188,55 @@ dl_load_file(filename, flags=0) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); #endif DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); + handle = dlopen(filename, mode) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle)); ST(0) = sv_newmortal() ; - if (RETVAL == NULL) + if (handle == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), PTR2IV(RETVAL)); + sv_setiv( ST(0), PTR2IV(handle)); +} + + +int +dl_unload_file(libref) + void * libref + CODE: + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); + RETVAL = (dlclose(libref) == 0 ? 1 : 0); + if (!RETVAL) + SaveError(aTHX_ "%s", dlerror()) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); + OUTPUT: + RETVAL -void * +void dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname + PREINIT: + void *sym; CODE: #ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); + sym = dlsym(libhandle, symbolname); DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); + " symbolref = %lx\n", (unsigned long) sym)); ST(0) = sv_newmortal() ; - if (RETVAL == NULL) + if (sym == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), PTR2IV(RETVAL)); + sv_setiv( ST(0), PTR2IV(sym)); void dl_undef_symbols() - PPCODE: + CODE: @@ -202,20 +246,37 @@ void dl_install_xsub(perl_name, symref, filename="$Package") char * perl_name void * symref - char * filename + const char * filename CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", - perl_name, (unsigned long) symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n", + perl_name, PTR2UV(symref))); + ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, + DPTR2FPTR(XSUBADDR_t, 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); + +#endif + # end.