/* 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
=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
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
*/
#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
#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
# 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>
# define FP_QNAN FP_QNAN
# endif
# include <math.h>
-# ifdef I_IEEFP
+# ifdef I_IEEEFP
# include <ieeefp.h>
# endif
# ifdef I_FP
# 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. */
/* 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;
#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)
# 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
# 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
* 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
# 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
* 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
#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
https://perl5.git.perl.org / perl5.git / blobdiff