| 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 |
|
|---|
| 16 | typedef 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 |
|
|---|
| 32 | START_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 */
|
|---|
| 58 | static void
|
|---|
| 59 | dl_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 |
|
|---|
| 82 | static void
|
|---|
| 83 | dl_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 */
|
|---|
| 114 | static void
|
|---|
| 115 | SaveError(pTHX_ const char* pat, ...)
|
|---|
| 116 | {
|
|---|
| 117 | dMY_CXT;
|
|---|
| 118 | va_list args;
|
|---|
| 119 | SV *msv;
|
|---|
| 120 | const 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 |
|
|---|
