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
28typedef 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
46START_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 */
74static void
75dl_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
97static void
98dl_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 */
140static void
141SaveError(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