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