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
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 #   include "EXTERN.h"
14 #   include "perl.h"
15 #   include "XSUB.h"
16 #endif
17
18 #ifndef XS_VERSION
19 #  define XS_VERSION "0"
20 #endif
21 #define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
22
23 typedef struct {
24     SV*         x_dl_last_error;        /* pointer to allocated memory for
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
39 START_MY_CXT
40
41 #define dl_last_error   (SvPVX(MY_CXT.x_dl_last_error))
42 #define dl_nonlazy      (MY_CXT.x_dl_nonlazy)
43 #ifdef DL_LOADONCEONLY
44 #define dl_loaded_files (MY_CXT.x_dl_loaded_files)
45 #endif
46 #ifdef DL_CXT_EXTRA
47 #define dl_cxtx         (MY_CXT.x_dl_cxtx)
48 #endif
49 #ifdef DEBUGGING
50 #define dl_debug        (MY_CXT.x_dl_debug)
51 #endif
52
53 #ifdef DEBUGGING
54 #define DLDEBUG(level,code) \
55     STMT_START {                                        \
56         dMY_CXT;                                        \
57         if (dl_debug>=level) { code; }                  \
58     } STMT_END
59 #else
60 #define DLDEBUG(level,code)     NOOP
61 #endif
62
63 #ifdef DL_UNLOAD_ALL_AT_EXIT
64 /* Close all dlopen'd files */
65 static void
66 dl_unload_all_files(pTHX_ void *unused)
67 {
68     CV *sub;
69     AV *dl_librefs;
70     SV *dl_libref;
71
72     if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
73         dl_librefs = get_av("DynaLoader::dl_librefs", 0);
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;
81            call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
82            FREETMPS;
83            LEAVE;
84         }
85     }
86 }
87 #endif
88
89 static void
90 dl_generic_private_init(pTHX)   /* called by dl_*.xs dl_private_init() */
91 {
92     char *perl_dl_nonlazy;
93     MY_CXT_INIT;
94
95     MY_CXT.x_dl_last_error = newSVpvn("", 0);
96     dl_nonlazy = 0;
97 #ifdef DL_LOADONCEONLY
98     dl_loaded_files = NULL;
99 #endif
100 #ifdef DEBUGGING
101     {
102         SV *sv = get_sv("DynaLoader::dl_debug", 0);
103         dl_debug = sv ? SvIV(sv) : 0;
104     }
105 #endif
106     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
107         dl_nonlazy = atoi(perl_dl_nonlazy);
108     if (dl_nonlazy)
109         DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
110 #ifdef DL_LOADONCEONLY
111     if (!dl_loaded_files)
112         dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
113 #endif
114 #ifdef DL_UNLOAD_ALL_AT_EXIT
115     call_atexit(&dl_unload_all_files, (void*)0);
116 #endif
117 }
118
119
120 #ifndef SYMBIAN
121 /* SaveError() takes printf style args and saves the result in dl_last_error */
122 static void
123 SaveError(pTHX_ const char* pat, ...)
124 {
125     dMY_CXT;
126     va_list args;
127     SV *msv;
128     const char *message;
129     STRLEN len;
130
131     /* This code is based on croak/warn, see mess() in util.c */
132
133     va_start(args, pat);
134     msv = vmess(pat, &args);
135     va_end(args);
136
137     message = SvPV(msv,len);
138     len++;              /* include terminating null char */
139
140     /* Copy message into dl_last_error (including terminating null char) */
141     sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
142     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
143 }
144 #endif
145