#include "perl.h"
#include "XSUB.h"
+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" /* for SaveError() etc */
-static AV *dl_resolve_using = Nullav;
-
+#define dl_resolve_using (dl_cxtx.x_resolve_using)
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
PREINIT:
shl_t obj = NULL;
int i, max, bind_type;
+ dMY_CXT;
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);
if (dl_nonlazy) {
max = AvFILL(dl_resolve_using);
for (i = 0; i <= max; i++) {
char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym));
obj = shl_load(sym, bind_type, 0L);
if (obj == NULL) {
goto end;
}
}
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename));
obj = shl_load(filename, bind_type, 0L);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj));
end:
ST(0) = sv_newmortal() ;
if (obj == NULL)
SaveError(aTHX_ "%s",Strerror(errno));
else
- sv_setiv( ST(0), (IV)obj);
+ sv_setiv( ST(0), PTR2IV(obj) );
+
+
+int
+dl_unload_file(libref)
+ void * libref
+ CODE:
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
+ RETVAL = (shl_unload(libref) == 0 ? 1 : 0);
+ if (!RETVAL)
+ SaveError(aTHX_ "%s", Strerror(errno));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+ OUTPUT:
+ RETVAL
void *
void *symaddr = NULL;
int status;
#ifdef __hp9000s300
- 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));
errno = 0;
status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(PROCEDURE) = %x\n", symaddr));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %x\n", symaddr));
if (status == -1 && errno == 0) { /* try TYPE_DATA instead */
status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(DATA) = %x\n", symaddr));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %x\n", symaddr));
}
if (status == -1) {
SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ;
} else {
- sv_setiv( ST(0), (IV)symaddr);
+ sv_setiv( ST(0), PTR2IV(symaddr) );
}
void * symref
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,
char *
dl_error()
CODE:
- RETVAL = LastError ;
+ dMY_CXT;
+ RETVAL = dl_last_error ;
OUTPUT:
RETVAL