1 /* dlutils.c - handy functions and definitions for dl_*.xs files
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
7 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
8 * files when the interpreter exits
11 #define MY_CXT_KEY "DynaLoader_guts"
14 char * x_dl_last_error; /* pointer to allocated memory for
16 int x_dl_nonlazy; /* flag for immediate rather than lazy
17 linking (spots unresolved symbol) */
18 #ifdef DL_LOADONCEONLY
19 HV * x_dl_loaded_files; /* only needed on a few systems */
22 my_cxtx_t x_dl_cxtx; /* extra platform-specific data */
25 int x_dl_debug; /* value copied from $DynaLoader::dl_debug */
29 /* XXX most of this is boilerplate code that should abstracted further into
30 * macros and exposed via XSUB.h */
32 #if defined(USE_ITHREADS)
35 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
36 sizeof(MY_CXT_KEY)-1, TRUE)
38 /* we allocate my_cxt in a Perl SV so that it will be released when
39 * the interpreter goes away */
40 #define dMY_CXT_INIT \
42 /* newSV() allocates one more than needed */ \
43 my_cxt_t *my_cxt = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
44 Zero(my_cxt, 1, my_cxt_t); \
45 sv_setuv(my_cxt_sv, (UV)my_cxt);
49 my_cxt_t *my_cxt = (my_cxt_t*)SvUV(my_cxt_sv)
51 #define dl_last_error (my_cxt->x_dl_last_error)
52 #define dl_nonlazy (my_cxt->x_dl_nonlazy)
53 #ifdef DL_LOADONCEONLY
54 #define dl_loaded_files (my_cxt->x_dl_loaded_files)
57 #define dl_cxtx (my_cxt->x_dl_cxtx)
60 #define dl_debug (my_cxt->x_dl_debug)
63 #else /* USE_ITHREADS */
65 static my_cxt_t my_cxt;
67 #define dMY_CXT_SV dNOOP
68 #define dMY_CXT_INIT dNOOP
71 #define dl_last_error (my_cxt.x_dl_last_error)
72 #define dl_nonlazy (my_cxt.x_dl_nonlazy)
73 #ifdef DL_LOADONCEONLY
74 #define dl_loaded_files (my_cxt.x_dl_loaded_files)
77 #define dl_cxtx (my_cxt.x_dl_cxtx)
80 #define dl_debug (my_cxt.x_dl_debug)
83 #endif /* !defined(USE_ITHREADS) */
87 #define DLDEBUG(level,code) \
90 if (dl_debug>=level) { code; } \
93 #define DLDEBUG(level,code) NOOP
96 #ifdef DL_UNLOAD_ALL_AT_EXIT
97 /* Close all dlopen'd files */
99 dl_unload_all_files(pTHX_ void *unused)
105 if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
106 dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
107 while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
112 XPUSHs(sv_2mortal(dl_libref));
114 call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
123 dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
125 char *perl_dl_nonlazy;
128 dl_last_error = NULL;
130 #ifdef DL_LOADONCEONLY
131 dl_loaded_files = Nullhv;
135 SV *sv = get_sv("DynaLoader::dl_debug", 0);
136 dl_debug = sv ? SvIV(sv) : 0;
139 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
140 dl_nonlazy = atoi(perl_dl_nonlazy);
142 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
143 #ifdef DL_LOADONCEONLY
144 if (!dl_loaded_files)
145 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
147 #ifdef DL_UNLOAD_ALL_AT_EXIT
148 call_atexit(&dl_unload_all_files, (void*)0);
153 /* SaveError() takes printf style args and saves the result in dl_last_error */
155 SaveError(pTHX_ char* pat, ...)
163 /* This code is based on croak/warn, see mess() in util.c */
166 msv = vmess(pat, &args);
169 message = SvPV(msv,len);
170 len++; /* include terminating null char */
172 /* Allocate some memory for the error message */
174 dl_last_error = (char*)saferealloc(dl_last_error, len);
176 dl_last_error = (char*)safemalloc(len);
178 /* Copy message into dl_last_error (including terminating null char) */
179 strncpy(dl_last_error, message, len) ;
180 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));