threads is no longer customized, as of commit c0ff91434b

[perl5.git] / ext / DynaLoader / dlutils.c

diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 5c6bbea..96ea8be 100644 (file)
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -8,42 +8,84 @@
  *                      files when the interpreter exits
  */
 
+#define PERL_EUPXS_ALWAYS_EXPORT
+#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
+#   include "EXTERN.h"
+#   include "perl.h"
+#   include "XSUB.h"
+#endif
 
-/* pointer to allocated memory for last error message */
-static char *LastError  = (char*)NULL;
+#ifndef XS_VERSION
+#  define XS_VERSION "0"
+#endif
+#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
+
+/* disable version checking since DynaLoader can't be DynaLoaded */
+#undef dXSBOOTARGSXSAPIVERCHK
+#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK
+
+typedef struct {
+    SV*                x_dl_last_error;        /* pointer to allocated memory for
+                                          last error message */
+#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
+    int                x_dl_nonlazy;           /* flag for immediate rather than lazy
+                                          linking (spots unresolved symbol) */
+#endif
+#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;
 
-/* flag for immediate rather than lazy linking (spots unresolved symbol) */
-static int dl_nonlazy = 0;
+START_MY_CXT
 
+#define dl_last_error  (SvPVX(MY_CXT.x_dl_last_error))
+#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
+#define dl_nonlazy     (MY_CXT.x_dl_nonlazy)
+#endif
 #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
-
 
 #ifdef DEBUGGING
-static int dl_debug = 0;       /* value copied from $DynaLoader::dl_error */
-#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
 /* Close all dlopen'd files */
 static void
-dl_unload_all_files(pTHXo_ void *unused)
+dl_unload_all_files(pTHX_ void *unused)
 {
     CV *sub;
     AV *dl_librefs;
     SV *dl_libref;
 
-    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
-        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+    if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
+        dl_librefs = get_av("DynaLoader::dl_librefs", 0);
+        EXTEND(SP,1);
         while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
            dSP;
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(dl_libref));
+           PUSHs(sv_2mortal(dl_libref));
            PUTBACK;
            call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
            FREETMPS;
@@ -51,35 +93,53 @@ dl_unload_all_files(pTHXo_ void *unused)
         }
     }
 }
-
+#endif
 
 static void
-dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
+dl_generic_private_init(pTHX)  /* called by dl_*.xs dl_private_init() */
 {
+#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
     char *perl_dl_nonlazy;
+#endif
+    MY_CXT_INIT;
+
+    MY_CXT.x_dl_last_error = newSVpvs("");
+#ifdef DL_LOADONCEONLY
+    dl_loaded_files = NULL;
+#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 defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
-       dl_nonlazy = atoi(perl_dl_nonlazy);
+       dl_nonlazy = grok_atou(perl_dl_nonlazy, NULL);
+    else
+       dl_nonlazy = 0;
     if (dl_nonlazy)
        DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
+#endif
 #ifdef DL_LOADONCEONLY
     if (!dl_loaded_files)
        dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 #endif
+#ifdef DL_UNLOAD_ALL_AT_EXIT
     call_atexit(&dl_unload_all_files, (void*)0);
+#endif
 }
 
 
-/* SaveError() takes printf style args and saves the result in LastError */
+#ifndef SYMBIAN
+/* SaveError() takes printf style args and saves the result in dl_last_error */
 static void
-SaveError(pTHXo_ char* pat, ...)
+SaveError(pTHX_ const char* pat, ...)
 {
     va_list args;
     SV *msv;
-    char *message;
+    const char *message;
     STRLEN len;
 
     /* This code is based on croak/warn, see mess() in util.c */
@@ -91,14 +151,12 @@ SaveError(pTHXo_ char* pat, ...)
     message = SvPV(msv,len);
     len++;             /* include terminating null char */
 
-    /* Allocate some memory for the error message */
-    if (LastError)
-        LastError = (char*)saferealloc(LastError, len) ;
-    else
-        LastError = (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));
+    {
+       dMY_CXT;
+    /* Copy message into dl_last_error (including terminating null char) */
+       sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
+    }
 }
+#endif