This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regen Configure and Glossary once 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 *
6 */
7
8
9/* pointer to allocated memory for last error message */
10static char *LastError = (char*)NULL;
11
8e07c86e
AD
12/* flag for immediate rather than lazy linking (spots unresolved symbol) */
13static int dl_nonlazy = 0;
14
15#ifdef DL_LOADONCEONLY
16static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */
17#endif
a0d0e21e
LW
18
19
20#ifdef DEBUGGING
8e07c86e
AD
21static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */
22#define DLDEBUG(level,code) if (dl_debug>=level) { code; }
a0d0e21e
LW
23#else
24#define DLDEBUG(level,code)
25#endif
26
27
28static void
0cb96387 29dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
a0d0e21e 30{
8e07c86e 31 char *perl_dl_nonlazy;
a0d0e21e 32#ifdef DEBUGGING
cea2e8a9 33 dl_debug = SvIV(get_sv("DynaLoader::dl_debug", 0x04) );
8e07c86e
AD
34#endif
35 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
36 dl_nonlazy = atoi(perl_dl_nonlazy);
37 if (dl_nonlazy)
760ac839 38 DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n"));
8e07c86e
AD
39#ifdef DL_LOADONCEONLY
40 if (!dl_loaded_files)
41 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
a0d0e21e
LW
42#endif
43}
44
45
46/* SaveError() takes printf style args and saves the result in LastError */
a0d0e21e 47static void
0cb96387 48SaveError(pTHXo_ char* pat, ...)
a0d0e21e
LW
49{
50 va_list args;
a6c40364 51 SV *msv;
a0d0e21e 52 char *message;
a6c40364 53 STRLEN len;
a0d0e21e 54
8e07c86e 55 /* This code is based on croak/warn, see mess() in util.c */
a0d0e21e 56
a0d0e21e 57 va_start(args, pat);
a6c40364 58 msv = mess(pat, &args);
a0d0e21e
LW
59 va_end(args);
60
a6c40364
GS
61 message = SvPV(msv,len);
62 len++; /* include terminating null char */
a0d0e21e
LW
63
64 /* Allocate some memory for the error message */
65 if (LastError)
66 LastError = (char*)saferealloc(LastError, len) ;
67 else
2e5d53bf 68 LastError = (char *) safemalloc(len) ;
a0d0e21e
LW
69
70 /* Copy message into LastError (including terminating null char) */
71 strncpy(LastError, message, len) ;
760ac839 72 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError));
a0d0e21e
LW
73}
74