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#ifndef XS_VERSION
12#  define XS_VERSION "0"
13#endif
14#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
15
16typedef struct {
17    SV*		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
32START_MY_CXT
33
34#define dl_last_error	(SvPVX(MY_CXT.x_dl_last_error))
35#define dl_nonlazy	(MY_CXT.x_dl_nonlazy)
36#ifdef DL_LOADONCEONLY
37#define dl_loaded_files	(MY_CXT.x_dl_loaded_files)
38#endif
39#ifdef DL_CXT_EXTRA
40#define dl_cxtx		(MY_CXT.x_dl_cxtx)
41#endif
42#ifdef DEBUGGING
43#define dl_debug	(MY_CXT.x_dl_debug)
44#endif
45
46#ifdef DEBUGGING
47#define DLDEBUG(level,code) \
48    STMT_START {					\
49	dMY_CXT;					\
50	if (dl_debug>=level) { code; }			\
51    } STMT_END
52#else
53#define DLDEBUG(level,code)	NOOP
54#endif
55
56#ifdef DL_UNLOAD_ALL_AT_EXIT
57/* Close all dlopen'd files */
58static void
59dl_unload_all_files(pTHX_ void *unused)
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;
74           call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
75           FREETMPS;
76           LEAVE;
77        }
78    }
79}
80#endif
81
82static void
83dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
84{
85    char *perl_dl_nonlazy;
86    MY_CXT_INIT;
87
88    MY_CXT.x_dl_last_error = newSVpvn("", 0);
89    dl_nonlazy = 0;
90#ifdef DL_LOADONCEONLY
91    dl_loaded_files = Nullhv;
92#endif
93#ifdef DEBUGGING
94    {
95	SV *sv = get_sv("DynaLoader::dl_debug", 0);
96	dl_debug = sv ? SvIV(sv) : 0;
97    }
98#endif
99    if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
100	dl_nonlazy = atoi(perl_dl_nonlazy);
101    if (dl_nonlazy)
102	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
103#ifdef DL_LOADONCEONLY
104    if (!dl_loaded_files)
105	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
106#endif
107#ifdef DL_UNLOAD_ALL_AT_EXIT
108    call_atexit(&dl_unload_all_files, (void*)0);
109#endif
110}
111
112
113/* SaveError() takes printf style args and saves the result in dl_last_error */
114static void
115SaveError(pTHX_ char* pat, ...)
116{
117    dMY_CXT;
118    va_list args;
119    SV *msv;
120    char *message;
121    STRLEN len;
122
123    /* This code is based on croak/warn, see mess() in util.c */
124
125    va_start(args, pat);
126    msv = vmess(pat, &args);
127    va_end(args);
128
129    message = SvPV(msv,len);
130    len++;		/* include terminating null char */
131
132    /* Copy message into dl_last_error (including terminating null char) */
133    sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
134    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
135}
136
137