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