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 28 typedef 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 46 START_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 */ 74 static void 75 dl_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 97 static void 98 dl_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 = 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 */ 140 static void 141 SaveError(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