This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fixup Perl_magic_freemglob()
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 959ddfe..a283712 100644 (file)
--- a/perl.h
+++ b/perl.h
 /* this is used for functions which take a depth trailing
  * argument under debugging */
 #ifdef DEBUGGING
-#define _pDEPTH ,U32 depth
-#define _aDEPTH ,depth
+#  define _pDEPTH ,U32 depth
+#  define _aDEPTH ,depth
 #else
-#define _pDEPTH
-#define _aDEPTH
+#  define _pDEPTH
+#  define _aDEPTH
 #endif
 
 /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined
@@ -197,15 +197,15 @@ Now a no-op.
 
 =cut
  */
-#define CPERLscope(x) x
-#define CPERLarg void
-#define CPERLarg_
-#define _CPERLarg
-#define PERL_OBJECT_THIS
-#define _PERL_OBJECT_THIS
-#define PERL_OBJECT_THIS_
-#define CALL_FPTR(fptr) (*fptr)
-#define MEMBER_TO_FPTR(name) name
+#  define CPERLscope(x) x
+#  define CPERLarg void
+#  define CPERLarg_
+#  define _CPERLarg
+#  define PERL_OBJECT_THIS
+#  define _PERL_OBJECT_THIS
+#  define PERL_OBJECT_THIS_
+#  define CALL_FPTR(fptr) (*fptr)
+#  define MEMBER_TO_FPTR(name) name
 #endif /* !PERL_CORE */
 
 #define CALLRUNOPS  PL_runops
@@ -271,10 +271,10 @@ Now a no-op.
     RX_ENGINE(rx)->qr_package(aTHX_ (rx))
 
 #if defined(USE_ITHREADS)
-#define CALLREGDUPE(prog,param) \
+#  define CALLREGDUPE(prog,param) \
     Perl_re_dup(aTHX_ (prog),(param))
 
-#define CALLREGDUPE_PVT(prog,param) \
+#  define CALLREGDUPE_PVT(prog,param) \
     (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \
           : (REGEXP *)NULL)
 #endif
@@ -299,42 +299,42 @@ Now a no-op.
  */
 
 #ifndef PERL_MICRO
-#if defined __GNUC__ && !defined(__INTEL_COMPILER)
-#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
-#    define HASATTRIBUTE_DEPRECATED
-#  endif
-#  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
-#    define HASATTRIBUTE_FORMAT
-#    if defined __MINGW32__
-#      define PRINTF_FORMAT_NULL_OK
+#  if defined __GNUC__ && !defined(__INTEL_COMPILER)
+#    if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+#      define HASATTRIBUTE_DEPRECATED
+#    endif
+#    if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
+#      define HASATTRIBUTE_FORMAT
+#      if defined __MINGW32__
+#        define PRINTF_FORMAT_NULL_OK
+#      endif
+#    endif
+#    if __GNUC__ >= 3 /* 3.0 -> */
+#      define HASATTRIBUTE_MALLOC
+#    endif
+#    if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
+#      define HASATTRIBUTE_NONNULL
+#    endif
+#    if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
+#      define HASATTRIBUTE_NORETURN
+#    endif
+#    if __GNUC__ >= 3 /* gcc 3.0 -> */
+#      define HASATTRIBUTE_PURE
+#    endif
+#    if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+#      define HASATTRIBUTE_UNUSED
+#    endif
+#    if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
+#      define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
+#    endif
+#    if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+#      define HASATTRIBUTE_WARN_UNUSED_RESULT
+#    endif
+     /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */
+#    if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */
+#      define HASATTRIBUTE_ALWAYS_INLINE
 #    endif
 #  endif
-#  if __GNUC__ >= 3 /* 3.0 -> */
-#    define HASATTRIBUTE_MALLOC
-#  endif
-#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
-#    define HASATTRIBUTE_NONNULL
-#  endif
-#  if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
-#    define HASATTRIBUTE_NORETURN
-#  endif
-#  if __GNUC__ >= 3 /* gcc 3.0 -> */
-#    define HASATTRIBUTE_PURE
-#  endif
-#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
-#    define HASATTRIBUTE_UNUSED
-#  endif
-#  if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
-#    define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
-#  endif
-#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
-#    define HASATTRIBUTE_WARN_UNUSED_RESULT
-#  endif
-/* always_inline is buggy in gcc <= 4.6 and causes compilation errors */
-#  if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */
-#    define HASATTRIBUTE_ALWAYS_INLINE
-#  endif
-#endif
 #endif /* #ifndef PERL_MICRO */
 
 #ifdef HASATTRIBUTE_DEPRECATED
@@ -531,7 +531,7 @@ __typeof__ and nothing else.
 
 #if defined(_MSC_VER) && _MSC_VER < 1400
 /* XXX older MSVC versions have a smallish macro buffer */
-#define PERL_SMALL_MACRO_BUFFER
+#  define PERL_SMALL_MACRO_BUFFER
 #endif
 
 /* on gcc (and clang), specify that a warning should be temporarily
@@ -2178,7 +2178,22 @@ You probably want to be using L<C</INT2PTR>> instead.
 #  endif
 #endif
 
-typedef NVTYPE NV;
+/* On MS Windows,with 64-bit mingw-w64 compilers, we
+   need to attend to a __float128 alignment issue if
+   USE_QUADMATH is defined. Otherwise we simply:
+   typedef NVTYPE NV
+   32-bit mingw.org compilers might also require
+   aligned(32) - at least that's what I found with my
+   Math::Foat128 module. But this is as yet untested
+   here, so no allowance is being made for mingw.org
+   compilers at this stage. -- sisyphus January 2021
+*/
+#if defined(USE_QUADMATH) && defined(__MINGW64__)
+   /* 64-bit build, mingw-w64 compiler only */
+   typedef NVTYPE NV __attribute__ ((aligned(8)));
+#else
+   typedef NVTYPE NV;
+#endif
 
 #ifdef I_IEEEFP
 #   include <ieeefp.h>
@@ -2468,7 +2483,7 @@ extern long double Perl_my_frexpl(long double x, int *e);
 #     define FP_QNAN FP_QNAN
 #    endif
 #    include <math.h>
-#    ifdef I_IEEFP
+#    ifdef I_IEEEFP
 #        include <ieeefp.h>
 #    endif
 #    ifdef I_FP
@@ -2677,7 +2692,7 @@ extern long double Perl_my_frexpl(long double x, int *e);
 #        define Perl_isfinitel(x) isfinitel(x)
 #    elif defined(HAS_FINITEL)
 #        define Perl_isfinitel(x) finitel(x)
-#    elif defined(HAS_INFL) && defined(HAS_NANL)
+#    elif defined(HAS_ISINFL) && defined(HAS_ISNANL)
 #        define Perl_isfinitel(x) !(isinfl(x)||isnanl(x))
 #    else
 #        define Perl_isfinitel(x) ((x) * 0 == 0)  /* See Perl_isfinite. */
@@ -3344,8 +3359,8 @@ typedef pthread_key_t     perl_key;
 /* Many readers; single writer */
 typedef struct {
     perl_mutex lock;
-    perl_cond  zero_readers;
-    Size_t     readers_count;
+    perl_cond  wakeup;
+    SSize_t    readers_count;
 } perl_RnW1_mutex_t;
 
 
@@ -4372,6 +4387,11 @@ Gid_t getegid (void);
 #define DEBUG_DB_RECURSE_FLAG  0x40000000
 #define DEBUG_TOP_FLAG         0x80000000 /* -D was given --> PL_debug |= FLAG */
 
+/* Both flags have to be set */
+#  define DEBUG_BOTH_FLAGS_TEST_(flag1, flag2)              \
+            UNLIKELY((PL_debug & ((flag1)|(flag2)))         \
+                              == ((flag1)|(flag2)))
+
 #  define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG)
 #  define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG)
 #  define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG)
@@ -4400,11 +4420,11 @@ Gid_t getegid (void);
 #  define DEBUG_L_TEST_ UNLIKELY(PL_debug & DEBUG_L_FLAG)
 #  define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG)
 #  define DEBUG_y_TEST_ UNLIKELY(PL_debug & DEBUG_y_FLAG)
-#  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
-#  define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
-#  define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
-#  define DEBUG_Lv_TEST_ (DEBUG_L_TEST_ && DEBUG_v_TEST_)
-#  define DEBUG_yv_TEST_ (DEBUG_y_TEST_ && DEBUG_v_TEST_)
+#  define DEBUG_Xv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_X_FLAG, DEBUG_v_FLAG)
+#  define DEBUG_Uv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_U_FLAG, DEBUG_v_FLAG)
+#  define DEBUG_Pv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_P_FLAG, DEBUG_v_FLAG)
+#  define DEBUG_Lv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_L_FLAG, DEBUG_v_FLAG)
+#  define DEBUG_yv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_y_FLAG, DEBUG_v_FLAG)
 
 #ifdef DEBUGGING
 
@@ -6505,6 +6525,18 @@ the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
 #  define LC_NUMERIC_UNLOCK         NOOP
 #  define LOCALECONV_LOCK           NOOP
 #  define LOCALECONV_UNLOCK         NOOP
+#  define LOCALE_READ_LOCK          NOOP
+#  define LOCALE_READ_UNLOCK        NOOP
+#  define MBLEN_LOCK                NOOP
+#  define MBLEN_UNLOCK              NOOP
+#  define MBTOWC_LOCK               NOOP
+#  define MBTOWC_UNLOCK             NOOP
+#  define NL_LANGINFO_LOCK          NOOP
+#  define NL_LANGINFO_UNLOCK        NOOP
+#  define SETLOCALE_LOCK            NOOP
+#  define SETLOCALE_UNLOCK          NOOP
+#  define WCTOMB_LOCK               NOOP
+#  define WCTOMB_UNLOCK             NOOP
 #else
 
    /* Here, we will need critical sections in locale handling, because one or
@@ -6535,21 +6567,46 @@ the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
     * will be called frequently, and the locked interval should be short, and
     * modern platforms will have reentrant versions (which don't lock) for
     * almost all of them, so khw thinks a single mutex should suffice. */
-#  define LOCALE_LOCK                                                       \
+#  define LOCALE_LOCK_                                                      \
         STMT_START {                                                        \
             DEBUG_Lv(PerlIO_printf(Perl_debug_log,                          \
                     "%s: %d: locking locale\n", __FILE__, __LINE__));       \
             MUTEX_LOCK(&PL_locale_mutex);                                   \
         } STMT_END
-#  define LOCALE_UNLOCK                                                     \
+#  define LOCALE_UNLOCK_                                                    \
         STMT_START {                                                        \
             DEBUG_Lv(PerlIO_printf(Perl_debug_log,                          \
                    "%s: %d: unlocking locale\n", __FILE__, __LINE__));      \
             MUTEX_UNLOCK(&PL_locale_mutex);                                 \
         } STMT_END
 
-#    define LOCALECONV_LOCK   LOCALE_LOCK
-#    define LOCALECONV_UNLOCK LOCALE_UNLOCK
+   /* We do define a different macro for each case; then if we want to have
+    * separate mutexes for some of them, the only changes needed are here.
+    * Define just the necessary macros.  The compiler should then croak if the
+    * #ifdef's in the code are incorrect */
+#  if defined(HAS_LOCALECONV) && (  ! defined(HAS_POSIX_2008_LOCALE)        \
+                                 || ! defined(HAS_LOCALECONV_L)             \
+                                 ||   defined(TS_W32_BROKEN_LOCALECONV))
+#    define LOCALECONV_LOCK   LOCALE_LOCK_
+#    define LOCALECONV_UNLOCK LOCALE_UNLOCK_
+#  endif
+#  if defined(HAS_NL_LANGINFO) && (   ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \
+                                   || ! defined(HAS_POSIX_2008_LOCALE))
+#    define NL_LANGINFO_LOCK   LOCALE_LOCK_
+#    define NL_LANGINFO_UNLOCK LOCALE_UNLOCK_
+#  endif
+#  if defined(HAS_MBLEN) && ! defined(HAS_MBRLEN)
+#    define MBLEN_LOCK   LOCALE_LOCK_
+#    define MBLEN_UNLOCK LOCALE_UNLOCK_
+#  endif
+#  if defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC)
+#    define MBTOWC_LOCK   LOCALE_LOCK_
+#    define MBTOWC_UNLOCK LOCALE_UNLOCK_
+#  endif
+#  if defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB)
+#    define WCTOMB_LOCK   LOCALE_LOCK_
+#    define WCTOMB_UNLOCK LOCALE_UNLOCK_
+#  endif
 #  if defined(USE_THREAD_SAFE_LOCALE)
      /* On locale thread-safe systems, we don't need these workarounds */
 #    define LOCALE_TERM_LC_NUMERIC_   NOOP
@@ -6558,7 +6615,14 @@ the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
 #    define LC_NUMERIC_UNLOCK       NOOP
 #    define LOCALE_INIT_LC_NUMERIC_ NOOP
 #    define LOCALE_TERM_LC_NUMERIC_ NOOP
+
+     /* There may be instance core where we this is invoked yet should do
+      * nothing.  Rather than have #ifdef's around them, define it here */
+#    define SETLOCALE_LOCK    NOOP
+#    define SETLOCALE_UNLOCK  NOOP
 #  else
+#    define SETLOCALE_LOCK   LOCALE_LOCK_
+#    define SETLOCALE_UNLOCK LOCALE_UNLOCK_
 
     /* On platforms without per-thread locales, when another thread can switch
      * our locale, we need another mutex to create critical sections where we
@@ -6582,7 +6646,7 @@ the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
      * Clang improperly gives warnings for this, if not silenced:
      * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks
      *
-     * If LC_NUMERIC_LOCK is combined with LOCALE_LOCK, calls to
+     * If LC_NUMERIC_LOCK is combined with one of the LOCKs above, calls to
      * that and its corresponding unlock should be contained entirely within
      * the locked portion of LC_NUMERIC.  Those mutexes should be used only in
      * very short sections of code, while LC_NUMERIC_LOCK may span more
@@ -6959,19 +7023,36 @@ cannot have changed since the precalculation.
 #endif /* !USE_LOCALE_NUMERIC */
 
 #ifdef USE_ITHREADS
-   /* On some platforms it would be safe to use a read/write mutex with many
-    * readers possible at the same time.  On other platforms, notably IBM ones,
-    * subsequent getenv calls destroy earlier ones.  Those platforms would not
-    * be able to handle simultaneous getenv calls */
-#  define ENV_LOCK            MUTEX_LOCK(&PL_env_mutex)
-#  define ENV_UNLOCK          MUTEX_UNLOCK(&PL_env_mutex)
-#  define ENV_INIT            MUTEX_INIT(&PL_env_mutex);
-#  define ENV_TERM            MUTEX_DESTROY(&PL_env_mutex);
+#  define ENV_LOCK            PERL_WRITE_LOCK(&PL_env_mutex)
+#  define ENV_UNLOCK          PERL_WRITE_UNLOCK(&PL_env_mutex)
+#  define ENV_READ_LOCK       PERL_READ_LOCK(&PL_env_mutex)
+#  define ENV_READ_UNLOCK     PERL_READ_UNLOCK(&PL_env_mutex)
+#  define ENV_INIT            PERL_RW_MUTEX_INIT(&PL_env_mutex)
+#  define ENV_TERM            PERL_RW_MUTEX_DESTROY(&PL_env_mutex)
+
+   /* On platforms where the static buffer contained in getenv() is per-thread
+    * rather than process-wide, another thread executing a getenv() at the same
+    * time won't destroy ours before we have copied the result safely away and
+    * unlocked the mutex.  On such platforms (which is most), we can have many
+    * readers of the environment at the same time. */
+#  ifdef GETENV_PRESERVES_OTHER_THREAD
+#    define GETENV_LOCK    ENV_READ_LOCK
+#    define GETENV_UNLOCK  ENV_READ_UNLOCK
+#  else
+     /* If, on the other hand, another thread could zap our getenv() return, we
+      * need to keep them from executing until we are done */
+#    define GETENV_LOCK    ENV_LOCK
+#    define GETENV_UNLOCK  ENV_UNLOCK
+#  endif
 #else
-#  define ENV_LOCK       NOOP
-#  define ENV_UNLOCK     NOOP
-#  define ENV_INIT       NOOP
-#  define ENV_TERM       NOOP
+#  define ENV_LOCK        NOOP
+#  define ENV_UNLOCK      NOOP
+#  define ENV_READ_LOCK   NOOP
+#  define ENV_READ_UNLOCK NOOP
+#  define ENV_INIT        NOOP
+#  define ENV_TERM        NOOP
+#  define GETENV_LOCK     NOOP
+#  define GETENV_UNLOCK   NOOP
 #endif
 
 #ifndef PERL_NO_INLINE_FUNCTIONS