[ID 20011201.170] Time::HiRes in devel-perl causes segfaults for xs users
[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dlutils.c
CommitLineData
a0d0e21e 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 *
abb9e9dc 6 * Modified:
7 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
8 * files when the interpreter exits
a0d0e21e 9 */
10
89ca4ac7 11#ifndef XS_VERSION
12# define XS_VERSION "0"
13#endif
39c19e8a 14#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
a0d0e21e 15
cdc73a10 16typedef struct {
17 char * 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
89ca4ac7 32START_MY_CXT
cdc73a10 33
89ca4ac7 34#define dl_last_error (MY_CXT.x_dl_last_error)
35#define dl_nonlazy (MY_CXT.x_dl_nonlazy)
cdc73a10 36#ifdef DL_LOADONCEONLY
89ca4ac7 37#define dl_loaded_files (MY_CXT.x_dl_loaded_files)
cdc73a10 38#endif
39#ifdef DL_CXT_EXTRA
89ca4ac7 40#define dl_cxtx (MY_CXT.x_dl_cxtx)
cdc73a10 41#endif
42#ifdef DEBUGGING
89ca4ac7 43#define dl_debug (MY_CXT.x_dl_debug)
cdc73a10 44#endif
45
a0d0e21e 46#ifdef DEBUGGING
cdc73a10 47#define DLDEBUG(level,code) \
48 STMT_START { \
49 dMY_CXT; \
50 if (dl_debug>=level) { code; } \
51 } STMT_END
a0d0e21e 52#else
cdc73a10 53#define DLDEBUG(level,code) NOOP
a0d0e21e 54#endif
55
c6c619a9 56#ifdef DL_UNLOAD_ALL_AT_EXIT
abb9e9dc 57/* Close all dlopen'd files */
58static void
acfe0abc 59dl_unload_all_files(pTHX_ void *unused)
abb9e9dc 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;
22851543 74 call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
abb9e9dc 75 FREETMPS;
76 LEAVE;
77 }
78 }
79}
c6c619a9 80#endif
abb9e9dc 81
a0d0e21e 82static void
acfe0abc 83dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
a0d0e21e 84{
8e07c86e 85 char *perl_dl_nonlazy;
89ca4ac7 86 MY_CXT_INIT;
cdc73a10 87
88 dl_last_error = NULL;
89 dl_nonlazy = 0;
90#ifdef DL_LOADONCEONLY
91 dl_loaded_files = Nullhv;
92#endif
a0d0e21e 93#ifdef DEBUGGING
cdc73a10 94 {
95 SV *sv = get_sv("DynaLoader::dl_debug", 0);
96 dl_debug = sv ? SvIV(sv) : 0;
97 }
8e07c86e 98#endif
99 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
100 dl_nonlazy = atoi(perl_dl_nonlazy);
101 if (dl_nonlazy)
bf49b057 102 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
8e07c86e 103#ifdef DL_LOADONCEONLY
104 if (!dl_loaded_files)
105 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
a0d0e21e 106#endif
23d2500b 107#ifdef DL_UNLOAD_ALL_AT_EXIT
abb9e9dc 108 call_atexit(&dl_unload_all_files, (void*)0);
23d2500b 109#endif
a0d0e21e 110}
111
112
cdc73a10 113/* SaveError() takes printf style args and saves the result in dl_last_error */
a0d0e21e 114static void
acfe0abc 115SaveError(pTHX_ char* pat, ...)
a0d0e21e 116{
cdc73a10 117 dMY_CXT;
a0d0e21e 118 va_list args;
a6c40364 119 SV *msv;
a0d0e21e 120 char *message;
a6c40364 121 STRLEN len;
a0d0e21e 122
8e07c86e 123 /* This code is based on croak/warn, see mess() in util.c */
a0d0e21e 124
a0d0e21e 125 va_start(args, pat);
5a844595 126 msv = vmess(pat, &args);
a0d0e21e 127 va_end(args);
128
a6c40364 129 message = SvPV(msv,len);
130 len++; /* include terminating null char */
a0d0e21e 131
132 /* Allocate some memory for the error message */
cdc73a10 133 if (dl_last_error)
134 dl_last_error = (char*)saferealloc(dl_last_error, len);
a0d0e21e 135 else
cdc73a10 136 dl_last_error = (char*)safemalloc(len);
a0d0e21e 137
cdc73a10 138 /* Copy message into dl_last_error (including terminating null char) */
139 strncpy(dl_last_error, message, len) ;
140 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
a0d0e21e 141}
142