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 AV *dl_librefs; 79 SV *dl_libref; 80 81 if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) { 82 dl_librefs = get_av("DynaLoader::dl_librefs", 0); 83 EXTEND(SP,1); 84 while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) { 85 dSP; 86 ENTER; 87 SAVETMPS; 88 PUSHMARK(SP); 89 PUSHs(sv_2mortal(dl_libref)); 90 PUTBACK; 91 call_sv((SV*)sub, G_DISCARD | G_NODEBUG); 92 FREETMPS; 93 LEAVE; 94 } 95 } 96 } 97 #endif 98 99 static void 100 dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ 101 { 102 #if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 103 char *perl_dl_nonlazy; 104 UV uv; 105 #endif 106 MY_CXT_INIT; 107 108 MY_CXT.x_dl_last_error = newSVpvs(""); 109 #ifdef DL_LOADONCEONLY 110 dl_loaded_files = NULL; 111 #endif 112 #ifdef DEBUGGING 113 { 114 SV *sv = get_sv("DynaLoader::dl_debug", 0); 115 dl_debug = sv ? SvIV(sv) : 0; 116 } 117 #endif 118 119 #if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) 120 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL 121 && grok_atoUV(perl_dl_nonlazy, &uv, NULL) 122 && uv <= INT_MAX 123 ) { 124 dl_nonlazy = (int)uv; 125 } else 126 dl_nonlazy = 0; 127 if (dl_nonlazy) 128 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); 129 #endif 130 #ifdef DL_LOADONCEONLY 131 if (!dl_loaded_files) 132 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ 133 #endif 134 #ifdef DL_UNLOAD_ALL_AT_EXIT 135 call_atexit(&dl_unload_all_files, (void*)0); 136 #endif 137 } 138 139 140 #ifndef SYMBIAN 141 /* SaveError() takes printf style args and saves the result in dl_last_error */ 142 static void 143 SaveError(pTHX_ const char* pat, ...) 144 { 145 va_list args; 146 SV *msv; 147 const char *message; 148 STRLEN len; 149 150 /* This code is based on croak/warn, see mess() in util.c */ 151 152 va_start(args, pat); 153 msv = vmess(pat, &args); 154 va_end(args); 155 156 message = SvPV(msv,len); 157 len++; /* include terminating null char */ 158 159 { 160 dMY_CXT; 161 /* Copy message into dl_last_error (including terminating null char) */ 162 sv_setpvn(MY_CXT.x_dl_last_error, message, len) ; 163 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); 164 } 165 } 166 #endif 167 168