/* dl_dlopen.xs
*
* Platform: SunOS/Solaris, possibly others which use dlopen.
- * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * Author: Paul Marquess (Paul.Marquess@btinternet.com)
* 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
*
*/
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 *
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
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.
*/
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(aTHX);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (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
mode |= RTLD_GLOBAL;
#else
- warn("Can't make loaded symbols global on this platform while loading %s",filename);
+ Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
#endif
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
- RETVAL = dlopen(filename, mode) ;
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
+ handle = dlopen(filename, mode) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ if (handle == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)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(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(),
- " symbolref = %lx\n", (unsigned long) RETVAL));
+ sym = dlsym(libhandle, symbolname);
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+ " symbolref = %lx\n", (unsigned long) sym));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ if (sym == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(sym));
void
dl_undef_symbols()
- PPCODE:
+ CODE:
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
- perl_name, (unsigned long) symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((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
https://perl5.git.perl.org / perl5.git / blobdiff