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