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