Commit | Line | Data |
a0d0e21e |
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 */ |
10 | static char *LastError = (char*)NULL; |
11 | |
8e07c86e |
12 | /* flag for immediate rather than lazy linking (spots unresolved symbol) */ |
13 | static int dl_nonlazy = 0; |
14 | |
15 | #ifdef DL_LOADONCEONLY |
16 | static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ |
17 | #endif |
a0d0e21e |
18 | |
19 | |
20 | #ifdef DEBUGGING |
8e07c86e |
21 | static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */ |
22 | #define DLDEBUG(level,code) if (dl_debug>=level) { code; } |
a0d0e21e |
23 | #else |
24 | #define DLDEBUG(level,code) |
25 | #endif |
26 | |
27 | |
28 | static void |
0cb96387 |
29 | dl_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 |
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 |
39 | #ifdef DL_LOADONCEONLY |
40 | if (!dl_loaded_files) |
41 | dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ |
a0d0e21e |
42 | #endif |
43 | } |
44 | |
45 | |
46 | /* SaveError() takes printf style args and saves the result in LastError */ |
a0d0e21e |
47 | static void |
0cb96387 |
48 | SaveError(pTHXo_ char* pat, ...) |
a0d0e21e |
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 |
59 | va_end(args); |
60 | |
a6c40364 |
61 | message = SvPV(msv,len); |
62 | len++; /* include terminating null char */ |
a0d0e21e |
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 |
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 |
73 | } |
74 | |