1N/A/* dlutils.c - handy functions and definitions for dl_*.xs files
1N/A *
1N/A * Currently this file is simply #included into dl_*.xs/.c files.
1N/A * It should really be split into a dlutils.h and dlutils.c
1N/A *
1N/A * Modified:
1N/A * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
1N/A * files when the interpreter exits
1N/A */
1N/A
1N/A#ifndef XS_VERSION
1N/A# define XS_VERSION "0"
1N/A#endif
1N/A#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
1N/A
1N/Atypedef struct {
1N/A SV* x_dl_last_error; /* pointer to allocated memory for
1N/A last error message */
1N/A int x_dl_nonlazy; /* flag for immediate rather than lazy
1N/A linking (spots unresolved symbol) */
1N/A#ifdef DL_LOADONCEONLY
1N/A HV * x_dl_loaded_files; /* only needed on a few systems */
1N/A#endif
1N/A#ifdef DL_CXT_EXTRA
1N/A my_cxtx_t x_dl_cxtx; /* extra platform-specific data */
1N/A#endif
1N/A#ifdef DEBUGGING
1N/A int x_dl_debug; /* value copied from $DynaLoader::dl_debug */
1N/A#endif
1N/A} my_cxt_t;
1N/A
1N/ASTART_MY_CXT
1N/A
1N/A#define dl_last_error (SvPVX(MY_CXT.x_dl_last_error))
1N/A#define dl_nonlazy (MY_CXT.x_dl_nonlazy)
1N/A#ifdef DL_LOADONCEONLY
1N/A#define dl_loaded_files (MY_CXT.x_dl_loaded_files)
1N/A#endif
1N/A#ifdef DL_CXT_EXTRA
1N/A#define dl_cxtx (MY_CXT.x_dl_cxtx)
1N/A#endif
1N/A#ifdef DEBUGGING
1N/A#define dl_debug (MY_CXT.x_dl_debug)
1N/A#endif
1N/A
1N/A#ifdef DEBUGGING
1N/A#define DLDEBUG(level,code) \
1N/A STMT_START { \
1N/A dMY_CXT; \
1N/A if (dl_debug>=level) { code; } \
1N/A } STMT_END
1N/A#else
1N/A#define DLDEBUG(level,code) NOOP
1N/A#endif
1N/A
1N/A#ifdef DL_UNLOAD_ALL_AT_EXIT
1N/A/* Close all dlopen'd files */
1N/Astatic void
1N/Adl_unload_all_files(pTHX_ void *unused)
1N/A{
1N/A CV *sub;
1N/A AV *dl_librefs;
1N/A SV *dl_libref;
1N/A
1N/A if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
1N/A dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
1N/A while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
1N/A dSP;
1N/A ENTER;
1N/A SAVETMPS;
1N/A PUSHMARK(SP);
1N/A XPUSHs(sv_2mortal(dl_libref));
1N/A PUTBACK;
1N/A call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
1N/A FREETMPS;
1N/A LEAVE;
1N/A }
1N/A }
1N/A}
1N/A#endif
1N/A
1N/Astatic void
1N/Adl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
1N/A{
1N/A char *perl_dl_nonlazy;
1N/A MY_CXT_INIT;
1N/A
1N/A MY_CXT.x_dl_last_error = newSVpvn("", 0);
1N/A dl_nonlazy = 0;
1N/A#ifdef DL_LOADONCEONLY
1N/A dl_loaded_files = Nullhv;
1N/A#endif
1N/A#ifdef DEBUGGING
1N/A {
1N/A SV *sv = get_sv("DynaLoader::dl_debug", 0);
1N/A dl_debug = sv ? SvIV(sv) : 0;
1N/A }
1N/A#endif
1N/A if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
1N/A dl_nonlazy = atoi(perl_dl_nonlazy);
1N/A if (dl_nonlazy)
1N/A DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
1N/A#ifdef DL_LOADONCEONLY
1N/A if (!dl_loaded_files)
1N/A dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
1N/A#endif
1N/A#ifdef DL_UNLOAD_ALL_AT_EXIT
1N/A call_atexit(&dl_unload_all_files, (void*)0);
1N/A#endif
1N/A}
1N/A
1N/A
1N/A/* SaveError() takes printf style args and saves the result in dl_last_error */
1N/Astatic void
1N/ASaveError(pTHX_ char* pat, ...)
1N/A{
1N/A dMY_CXT;
1N/A va_list args;
1N/A SV *msv;
1N/A char *message;
1N/A STRLEN len;
1N/A
1N/A /* This code is based on croak/warn, see mess() in util.c */
1N/A
1N/A va_start(args, pat);
1N/A msv = vmess(pat, &args);
1N/A va_end(args);
1N/A
1N/A message = SvPV(msv,len);
1N/A len++; /* include terminating null char */
1N/A
1N/A /* Copy message into dl_last_error (including terminating null char) */
1N/A sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
1N/A DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
1N/A}
1N/A