This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Export DynaLoader symbols from libperl again
[perl5.git] / ext / DynaLoader / dlutils.c
CommitLineData
a0d0e21e
LW
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
GS
6 * Modified:
7 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
8 * files when the interpreter exits
a0d0e21e
LW
9 */
10
2e346879 11#define PERL_EUPXS_ALWAYS_EXPORT
27da23d5
JH
12#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
13# include "EXTERN.h"
14# include "perl.h"
15# include "XSUB.h"
16#endif
17
89ca4ac7
JH
18#ifndef XS_VERSION
19# define XS_VERSION "0"
20#endif
39c19e8a 21#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
a0d0e21e 22
cdc73a10 23typedef struct {
591022fb 24 SV* x_dl_last_error; /* pointer to allocated memory for
cdc73a10
JH
25 last error message */
26 int x_dl_nonlazy; /* flag for immediate rather than lazy
27 linking (spots unresolved symbol) */
28#ifdef DL_LOADONCEONLY
29 HV * x_dl_loaded_files; /* only needed on a few systems */
30#endif
31#ifdef DL_CXT_EXTRA
32 my_cxtx_t x_dl_cxtx; /* extra platform-specific data */
33#endif
34#ifdef DEBUGGING
35 int x_dl_debug; /* value copied from $DynaLoader::dl_debug */
36#endif
37} my_cxt_t;
38
89ca4ac7 39START_MY_CXT
cdc73a10 40
591022fb 41#define dl_last_error (SvPVX(MY_CXT.x_dl_last_error))
89ca4ac7 42#define dl_nonlazy (MY_CXT.x_dl_nonlazy)
cdc73a10 43#ifdef DL_LOADONCEONLY
89ca4ac7 44#define dl_loaded_files (MY_CXT.x_dl_loaded_files)
cdc73a10
JH
45#endif
46#ifdef DL_CXT_EXTRA
89ca4ac7 47#define dl_cxtx (MY_CXT.x_dl_cxtx)
cdc73a10
JH
48#endif
49#ifdef DEBUGGING
89ca4ac7 50#define dl_debug (MY_CXT.x_dl_debug)
cdc73a10
JH
51#endif
52
a0d0e21e 53#ifdef DEBUGGING
cdc73a10
JH
54#define DLDEBUG(level,code) \
55 STMT_START { \
56 dMY_CXT; \
57 if (dl_debug>=level) { code; } \
58 } STMT_END
a0d0e21e 59#else
cdc73a10 60#define DLDEBUG(level,code) NOOP
a0d0e21e
LW
61#endif
62
c6c619a9 63#ifdef DL_UNLOAD_ALL_AT_EXIT
abb9e9dc
GS
64/* Close all dlopen'd files */
65static void
acfe0abc 66dl_unload_all_files(pTHX_ void *unused)
abb9e9dc
GS
67{
68 CV *sub;
69 AV *dl_librefs;
70 SV *dl_libref;
71
b96d8cd9 72 if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
cbfd0a87 73 dl_librefs = get_av("DynaLoader::dl_librefs", 0);
abb9e9dc
GS
74 while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
75 dSP;
76 ENTER;
77 SAVETMPS;
78 PUSHMARK(SP);
79 XPUSHs(sv_2mortal(dl_libref));
80 PUTBACK;
22851543 81 call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
abb9e9dc
GS
82 FREETMPS;
83 LEAVE;
84 }
85 }
86}
c6c619a9 87#endif
abb9e9dc 88
a0d0e21e 89static void
acfe0abc 90dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
a0d0e21e 91{
8e07c86e 92 char *perl_dl_nonlazy;
89ca4ac7 93 MY_CXT_INIT;
cdc73a10 94
591022fb 95 MY_CXT.x_dl_last_error = newSVpvn("", 0);
cdc73a10
JH
96 dl_nonlazy = 0;
97#ifdef DL_LOADONCEONLY
5c284bb0 98 dl_loaded_files = NULL;
cdc73a10 99#endif
a0d0e21e 100#ifdef DEBUGGING
cdc73a10
JH
101 {
102 SV *sv = get_sv("DynaLoader::dl_debug", 0);
103 dl_debug = sv ? SvIV(sv) : 0;
104 }
8e07c86e
AD
105#endif
106 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
107 dl_nonlazy = atoi(perl_dl_nonlazy);
108 if (dl_nonlazy)
bf49b057 109 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
8e07c86e
AD
110#ifdef DL_LOADONCEONLY
111 if (!dl_loaded_files)
112 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
a0d0e21e 113#endif
23d2500b 114#ifdef DL_UNLOAD_ALL_AT_EXIT
abb9e9dc 115 call_atexit(&dl_unload_all_files, (void*)0);
23d2500b 116#endif
a0d0e21e
LW
117}
118
119
27da23d5 120#ifndef SYMBIAN
cdc73a10 121/* SaveError() takes printf style args and saves the result in dl_last_error */
a0d0e21e 122static void
dd374669 123SaveError(pTHX_ const char* pat, ...)
a0d0e21e 124{
cdc73a10 125 dMY_CXT;
a0d0e21e 126 va_list args;
a6c40364 127 SV *msv;
dd374669 128 const char *message;
a6c40364 129 STRLEN len;
a0d0e21e 130
8e07c86e 131 /* This code is based on croak/warn, see mess() in util.c */
a0d0e21e 132
a0d0e21e 133 va_start(args, pat);
5a844595 134 msv = vmess(pat, &args);
a0d0e21e
LW
135 va_end(args);
136
a6c40364
GS
137 message = SvPV(msv,len);
138 len++; /* include terminating null char */
a0d0e21e 139
cdc73a10 140 /* Copy message into dl_last_error (including terminating null char) */
591022fb 141 sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
cdc73a10 142 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
a0d0e21e 143}
27da23d5 144#endif
a0d0e21e 145