1/* dlutils.c - handy functions and definitions for dl_*.xs files 2 * 3 * Currently this file is simply #included into dl_*.xs/.c files. 4 * It should really be split into a dlutils.h and dlutils.c 5 * 6 * Modified: 7 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd 8 * files when the interpreter exits 9 */ 10 11#define PERL_EUPXS_ALWAYS_EXPORT 12#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */ 13# define PERL_EXT 14# include "EXTERN.h" 15# include "perl.h" 16# include "XSUB.h" 17#endif 18 19#ifndef XS_VERSION 20# define XS_VERSION "0" 21#endif 22#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION 23 24/* disable version checking since DynaLoader can't be DynaLoaded */ 25#undef dXSBOOTARGSXSAPIVERCHK 26#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK 27 28typedef struct { 29 SV* x_dl_last_error; /* pointer to allocated memory for 30 last error message */ 31#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 32 int x_dl_nonlazy; /* flag for immediate rather than lazy 33 linking (spots unresolved symbol) */ 34#endif 35#ifdef DL_LOADONCEONLY 36 HV * x_dl_loaded_files; /* only needed on a few systems */ 37#endif 38#ifdef DL_CXT_EXTRA 39 my_cxtx_t x_dl_cxtx; /* extra platform-specific data */ 40#endif 41#ifdef DEBUGGING 42 int x_dl_debug; /* value copied from $DynaLoader::dl_debug */ 43#endif 44} my_cxt_t; 45 46START_MY_CXT 47 48#define dl_last_error (SvPVX(MY_CXT.x_dl_last_error)) 49#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 50#define dl_nonlazy (MY_CXT.x_dl_nonlazy) 51#endif 52#ifdef DL_LOADONCEONLY 53#define dl_loaded_files (MY_CXT.x_dl_loaded_files) 54#endif 55#ifdef DL_CXT_EXTRA 56#define dl_cxtx (MY_CXT.x_dl_cxtx) 57#endif 58#ifdef DEBUGGING 59#define dl_debug (MY_CXT.x_dl_debug) 60#endif 61 62#ifdef DEBUGGING 63#define DLDEBUG(level,code) \ 64 STMT_START { \ 65 dMY_CXT; \ 66 if (dl_debug>=level) { code; } \ 67 } STMT_END 68#else 69#define DLDEBUG(level,code) NOOP 70#endif 71 72#ifdef DL_UNLOAD_ALL_AT_EXIT 73/* Close all dlopen'd files */ 74static void 75dl_unload_all_files(pTHX_ void *unused) 76{ 77 CV *sub; 78 PERL_UNUSED_ARG(unused); 79 if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) { 80 AV *dl_librefs = get_av("DynaLoader::dl_librefs", 0); 81 SV *dl_libref; 82 while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) { 83 dSP; 84 ENTER; 85 SAVETMPS; 86 PUSHMARK(SP); 87 XPUSHs(sv_2mortal(dl_libref)); 88 PUTBACK; 89 call_sv((SV*)sub, G_DISCARD | G_NODEBUG); 90 FREETMPS; 91 LEAVE; 92 } 93 } 94} 95#endif 96 97static void 98dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ 99{ 100#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 101 char *perl_dl_nonlazy; 102 UV uv; 103#endif 104 MY_CXT_INIT; 105 106 MY_CXT.x_dl_last_error = newSVpvs(""); 107#ifdef DL_LOADONCEONLY 108 dl_loaded_files = NULL; 109#endif 110#ifdef DEBUGGING 111 { 112 SV *sv = get_sv("DynaLoader::dl_debug", 0); 113 dl_debug = sv ? SvIV(sv) : 0; 114 } 115#endif 116 117#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 118 if ( (perl_dl_nonlazy = PerlEnv_getenv("PERL_DL_NONLAZY")) != NULL 119 && grok_atoUV(perl_dl_nonlazy, &uv, NULL) 120 && uv <= INT_MAX 121 ) { 122 dl_nonlazy = (int)uv; 123 } else 124 dl_nonlazy = 0; 125 if (dl_nonlazy) 126 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); 127#endif 128#ifdef DL_LOADONCEONLY 129 if (!dl_loaded_files) 130 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ 131#endif 132#ifdef DL_UNLOAD_ALL_AT_EXIT 133 call_atexit(&dl_unload_all_files, (void*)0); 134#endif 135} 136 137 138#ifndef SYMBIAN 139/* SaveError() takes printf style args and saves the result in dl_last_error */ 140static void 141SaveError(pTHX_ const char* pat, ...) 142{ 143 va_list args; 144 SV *msv; 145 const char *message; 146 STRLEN len; 147 148 /* This code is based on croak/warn, see mess() in util.c */ 149 150 va_start(args, pat); 151 msv = vmess(pat, &args); 152 va_end(args); 153 154 message = SvPV(msv,len); 155 len++; /* include terminating null char */ 156 157 { 158 dMY_CXT; 159 /* Copy message into dl_last_error (including terminating null char) */ 160 sv_setpvn(MY_CXT.x_dl_last_error, message, len) ; 161 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); 162 } 163} 164#endif 165 166