This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads is no longer customized, as of commit c0ff91434b
[perl5.git] / ext / DynaLoader / dlutils.c
index 620d31b..96ea8be 100644 (file)
@@ -8,16 +8,29 @@
  *                      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
+
 #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 {
-    char *     x_dl_last_error;        /* pointer to allocated memory for
+    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
@@ -31,8 +44,10 @@ typedef struct {
 
 START_MY_CXT
 
-#define dl_last_error  (MY_CXT.x_dl_last_error)
+#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
 #define dl_loaded_files        (MY_CXT.x_dl_loaded_files)
 #endif
@@ -62,14 +77,15 @@ dl_unload_all_files(pTHX_ void *unused)
     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;
@@ -82,13 +98,14 @@ dl_unload_all_files(pTHX_ void *unused)
 static void
 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;
 
-    dl_last_error = NULL;
-    dl_nonlazy = 0;
+    MY_CXT.x_dl_last_error = newSVpvs("");
 #ifdef DL_LOADONCEONLY
-    dl_loaded_files = Nullhv;
+    dl_loaded_files = NULL;
 #endif
 #ifdef DEBUGGING
     {
@@ -96,10 +113,15 @@ dl_generic_private_init(pTHX)      /* called by dl_*.xs dl_private_init() */
        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 */
@@ -110,14 +132,14 @@ dl_generic_private_init(pTHX)     /* called by dl_*.xs dl_private_init() */
 }
 
 
+#ifndef SYMBIAN
 /* SaveError() takes printf style args and saves the result in dl_last_error */
 static void
-SaveError(pTHX_ char* pat, ...)
+SaveError(pTHX_ const char* pat, ...)
 {
-    dMY_CXT;
     va_list args;
     SV *msv;
-    char *message;
+    const char *message;
     STRLEN len;
 
     /* This code is based on croak/warn, see mess() in util.c */
@@ -129,14 +151,12 @@ SaveError(pTHX_ char* pat, ...)
     message = SvPV(msv,len);
     len++;             /* include terminating null char */
 
-    /* Allocate some memory for the error message */
-    if (dl_last_error)
-        dl_last_error = (char*)saferealloc(dl_last_error, len);
-    else
-        dl_last_error = (char*)safemalloc(len);
-
+    {
+       dMY_CXT;
     /* 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));
+       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