Integrate change #12626 from maintperl;

[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dlutils.c

diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 081b9ab..604c7f4 100644 (file)
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -8,23 +8,89 @@
  *                      files when the interpreter exits
  */
 
+#define MY_CXT_KEY "DynaLoader_guts"
 
-/* pointer to allocated memory for last error message */
-static char *LastError  = (char*)NULL;
+typedef struct {
+    char *     x_dl_last_error;        /* pointer to allocated memory for
+                                          last error message */
+    int                x_dl_nonlazy;           /* flag for immediate rather than lazy
+                                          linking (spots unresolved symbol) */
+#ifdef DL_LOADONCEONLY
+    HV *       x_dl_loaded_files;      /* only needed on a few systems */
+#endif
+#ifdef DL_CXT_EXTRA
+    my_cxtx_t  x_dl_cxtx;              /* extra platform-specific data */
+#endif
+#ifdef DEBUGGING
+    int                x_dl_debug;     /* value copied from $DynaLoader::dl_debug */
+#endif
+} my_cxt_t;
+
+/* XXX most of this is boilerplate code that should abstracted further into
+ * macros and exposed via XSUB.h */
+
+#if defined(USE_ITHREADS)
+
+#define dMY_CXT_SV \
+       SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
+                                 sizeof(MY_CXT_KEY)-1, TRUE)
+
+/* we allocate my_cxt in a Perl SV so that it will be released when
+ * the interpreter goes away */
+#define dMY_CXT_INIT \
+       dMY_CXT_SV;                                                     \
+       /* newSV() allocates one more than needed */                    \
+       my_cxt_t *my_cxt = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
+       Zero(my_cxt, 1, my_cxt_t);                                      \
+       sv_setuv(my_cxt_sv, (UV)my_cxt);
+
+#define dMY_CXT        \
+       dMY_CXT_SV;                                                     \
+       my_cxt_t *my_cxt = (my_cxt_t*)SvUV(my_cxt_sv)
+
+#define dl_last_error  (my_cxt->x_dl_last_error)
+#define dl_nonlazy     (my_cxt->x_dl_nonlazy)
+#ifdef DL_LOADONCEONLY
+#define dl_loaded_files        (my_cxt->x_dl_loaded_files)
+#endif
+#ifdef DL_CXT_EXTRA
+#define dl_cxtx                (my_cxt->x_dl_cxtx)
+#endif
+#ifdef DEBUGGING
+#define dl_debug       (my_cxt->x_dl_debug)
+#endif
+
+#else /* USE_ITHREADS */
 
-/* flag for immediate rather than lazy linking (spots unresolved symbol) */
-static int dl_nonlazy = 0;
+static my_cxt_t my_cxt;
 
+#define dMY_CXT_SV     dNOOP
+#define dMY_CXT_INIT   dNOOP
+#define dMY_CXT                dNOOP
+
+#define dl_last_error  (my_cxt.x_dl_last_error)
+#define dl_nonlazy     (my_cxt.x_dl_nonlazy)
 #ifdef DL_LOADONCEONLY
-static HV *dl_loaded_files = Nullhv;   /* only needed on a few systems */
+#define dl_loaded_files        (my_cxt.x_dl_loaded_files)
+#endif
+#ifdef DL_CXT_EXTRA
+#define dl_cxtx                (my_cxt.x_dl_cxtx)
 #endif
+#ifdef DEBUGGING
+#define dl_debug       (my_cxt.x_dl_debug)
+#endif
+
+#endif /* !defined(USE_ITHREADS) */
 
 
 #ifdef DEBUGGING
-static int dl_debug = 0;       /* value copied from $DynaLoader::dl_debug */
-#define DLDEBUG(level,code)    if (dl_debug>=level) { code; }
+#define DLDEBUG(level,code) \
+    STMT_START {                                       \
+       dMY_CXT;                                        \
+       if (dl_debug>=level) { code; }                  \
+    } STMT_END
 #else
-#define DLDEBUG(level,code)
+#define DLDEBUG(level,code)    NOOP
 #endif
 
 #ifdef DL_UNLOAD_ALL_AT_EXIT
@@ -57,9 +123,18 @@ static void
 dl_generic_private_init(pTHX)  /* called by dl_*.xs dl_private_init() */
 {
     char *perl_dl_nonlazy;
+    dMY_CXT_INIT;
+
+    dl_last_error = NULL;
+    dl_nonlazy = 0;
+#ifdef DL_LOADONCEONLY
+    dl_loaded_files = Nullhv;
+#endif
 #ifdef DEBUGGING
-    SV *sv = get_sv("DynaLoader::dl_debug", 0);
-    dl_debug = sv ? SvIV(sv) : 0;
+    {
+       SV *sv = get_sv("DynaLoader::dl_debug", 0);
+       dl_debug = sv ? SvIV(sv) : 0;
+    }
 #endif
     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
        dl_nonlazy = atoi(perl_dl_nonlazy);
@@ -75,10 +150,11 @@ dl_generic_private_init(pTHX)      /* called by dl_*.xs dl_private_init() */
 }
 
 
-/* SaveError() takes printf style args and saves the result in LastError */
+/* SaveError() takes printf style args and saves the result in dl_last_error */
 static void
 SaveError(pTHX_ char* pat, ...)
 {
+    dMY_CXT;
     va_list args;
     SV *msv;
     char *message;
@@ -94,13 +170,13 @@ SaveError(pTHX_ char* pat, ...)
     len++;             /* include terminating null char */
 
     /* Allocate some memory for the error message */
-    if (LastError)
-        LastError = (char*)saferealloc(LastError, len) ;
+    if (dl_last_error)
+        dl_last_error = (char*)saferealloc(dl_last_error, len);
     else
-        LastError = (char *) safemalloc(len) ;
+        dl_last_error = (char*)safemalloc(len);
 
-    /* Copy message into LastError (including terminating null char)   */
-    strncpy(LastError, message, len) ;
-    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError));
+    /* Copy message into dl_last_error (including terminating null char) */
+    strncpy(dl_last_error, message, len) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
 }