#endif
#ifndef PERL_UNUSED_DECL
-# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || __GNUC__ >= 4)
# define PERL_UNUSED_DECL __attribute__unused__
# else
# define PERL_UNUSED_DECL
#ifndef PERL_CORE
#define VOL volatile
#define CAN_PROTOTYPE
+#define _(args) args
+#define I_LIMITS
+#define I_STDARG
+#define STANDARD_C
#endif
/* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT,
cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here
since cewchar.h can't be included this early */
#if defined(UNDER_CE) && (_MSC_VER < 1300)
-# define MB_CUR_MAX 1
+# define MB_CUR_MAX 1uL
#endif
# include <stdarg.h>
EXTERN_C int usleep(unsigned int);
#endif
-#ifdef PERL_CORE
+/* macros for correct constant construction. These are in C99 <stdint.h>
+ * (so they will not be available in strict C89 mode), but they are nice, so
+ * let's define them if necessary. */
+#ifndef UINT16_C
+# if INTSIZE >= 2
+# define UINT16_C(x) ((U16_TYPE)x##U)
+# else
+# define UINT16_C(x) ((U16_TYPE)x##UL)
+# endif
+#endif
-/* macros for correct constant construction */
-# if INTSIZE >= 2
-# define U16_CONST(x) ((U16)x##U)
-# else
-# define U16_CONST(x) ((U16)x##UL)
-# endif
+#ifndef UINT32_C
+# if INTSIZE >= 4
+# define UINT32_C(x) ((U32_TYPE)x##U)
+# else
+# define UINT32_C(x) ((U32_TYPE)x##UL)
+# endif
+#endif
-# if INTSIZE >= 4
-# define U32_CONST(x) ((U32)x##U)
-# else
-# define U32_CONST(x) ((U32)x##UL)
-# endif
+#ifdef I_STDINT
+ typedef intmax_t PERL_INTMAX_T;
+ typedef uintmax_t PERL_UINTMAX_T;
+#endif
+
+/* N.B. We use QUADKIND here instead of HAS_QUAD here, because that doesn't
+ * actually mean what it has always been documented to mean (see RT #119753)
+ * and is explicitly turned off outside of core with dire warnings about
+ * removing the undef. */
+
+#if defined(QUADKIND)
+# undef PeRl_INT64_C
+# undef PeRl_UINT64_C
+/* Prefer the native integer types (int and long) over long long
+ * (which is not C89) and Win32-specific __int64. */
+# if QUADKIND == QUAD_IS_INT && INTSIZE == 8
+# define PeRl_INT64_C(c) (c)
+# define PeRl_UINT64_C(c) CAT2(c,U)
+# endif
+# if QUADKIND == QUAD_IS_LONG && LONGSIZE == 8
+# define PeRl_INT64_C(c) CAT2(c,L)
+# define PeRl_UINT64_C(c) CAT2(c,UL)
+# endif
+# if QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LONG_LONG)
+# define PeRl_INT64_C(c) CAT2(c,LL)
+# define PeRl_UINT64_C(c) CAT2(c,ULL)
+# endif
+# if QUADKIND == QUAD_IS___INT64
+# define PeRl_INT64_C(c) CAT2(c,I64)
+# define PeRl_UINT64_C(c) CAT2(c,UI64)
+# endif
+# ifndef PeRl_INT64_C
+# define PeRl_INT64_C(c) ((I64)(c)) /* last resort */
+# define PeRl_UINT64_C(c) ((U64TYPE)(c))
+# endif
+/* In OS X the INT64_C/UINT64_C are defined with LL/ULL, which will
+ * not fly with C89-pedantic gcc, so let's undefine them first so that
+ * we can redefine them with our native integer preferring versions. */
+# if defined(PERL_DARWIN) && defined(PERL_GCC_PEDANTIC)
+# undef INT64_C
+# undef UINT64_C
+# endif
+# ifndef INT64_C
+# define INT64_C(c) PeRl_INT64_C(c)
+# endif
+# ifndef UINT64_C
+# define UINT64_C(c) PeRl_UINT64_C(c)
+# endif
-# ifdef HAS_QUAD
-# if INTSIZE >= 8
-# define U64_CONST(x) ((U64)x##U)
-# elif LONGSIZE >= 8
-# define U64_CONST(x) ((U64)x##UL)
-# elif QUADKIND == QUAD_IS_LONG_LONG
-# define U64_CONST(x) ((U64)x##ULL)
-# elif QUADKIND == QUAD_IS___INT64
-# define U64_CONST(x) ((U64)x##UI64)
-# else /* best guess we can make */
-# define U64_CONST(x) ((U64)x##UL)
+# ifndef I_STDINT
+ typedef I64TYPE PERL_INTMAX_T;
+ typedef U64TYPE PERL_UINTMAX_T;
# endif
-# endif
+# ifndef INTMAX_C
+# define INTMAX_C(c) INT64_C(c)
+# endif
+# ifndef UINTMAX_C
+# define UINTMAX_C(c) UINT64_C(c)
+# endif
+
+#else /* below QUADKIND is undefined */
+
+/* Perl doesn't work on 16 bit systems, so must be 32 bit */
+# ifndef I_STDINT
+ typedef I32TYPE PERL_INTMAX_T;
+ typedef U32TYPE PERL_UINTMAX_T;
+# endif
+# ifndef INTMAX_C
+# define INTMAX_C(c) INT32_C(c)
+# endif
+# ifndef UINTMAX_C
+# define UINTMAX_C(c) UINT32_C(c)
+# endif
+
+#endif /* no QUADKIND */
+
+#ifdef PERL_CORE
/* byte-swapping functions for big-/little-endian conversion */
# define _swab_16_(x) ((U16)( \
- (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
- (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
+ (((U16)(x) & UINT16_C(0x00ff)) << 8) | \
+ (((U16)(x) & UINT16_C(0xff00)) >> 8) ))
# define _swab_32_(x) ((U32)( \
- (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
- (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \
- (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \
- (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
+ (((U32)(x) & UINT32_C(0x000000ff)) << 24) | \
+ (((U32)(x) & UINT32_C(0x0000ff00)) << 8) | \
+ (((U32)(x) & UINT32_C(0x00ff0000)) >> 8) | \
+ (((U32)(x) & UINT32_C(0xff000000)) >> 24) ))
# ifdef HAS_QUAD
# define _swab_64_(x) ((U64)( \
- (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
- (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
- (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
- (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \
- (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \
- (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
- (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
- (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
+ (((U64)(x) & UINT64_C(0x00000000000000ff)) << 56) | \
+ (((U64)(x) & UINT64_C(0x000000000000ff00)) << 40) | \
+ (((U64)(x) & UINT64_C(0x0000000000ff0000)) << 24) | \
+ (((U64)(x) & UINT64_C(0x00000000ff000000)) << 8) | \
+ (((U64)(x) & UINT64_C(0x000000ff00000000)) >> 8) | \
+ (((U64)(x) & UINT64_C(0x0000ff0000000000)) >> 24) | \
+ (((U64)(x) & UINT64_C(0x00ff000000000000)) >> 40) | \
+ (((U64)(x) & UINT64_C(0xff00000000000000)) >> 56) ))
# endif
/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
#endif /* PERL_CORE */
+/* Maximum number of args that may be passed to an OP_MULTICONCAT op.
+ * It determines the size of local arrays in S_maybe_multiconcat() and
+ * pp_multiconcat().
+ */
+#define PERL_MULTICONCAT_MAXARG 64
+
+/* The indexes of fields of a multiconcat aux struct.
+ * The fixed fields are followed by nargs+1 const segment lengths,
+ * and if utf8 and non-utf8 differ, a second nargs+1 set for utf8.
+ */
+
+#define PERL_MULTICONCAT_IX_NARGS 0 /* number of arguments */
+#define PERL_MULTICONCAT_IX_PLAIN_PV 1 /* non-utf8 constant string */
+#define PERL_MULTICONCAT_IX_PLAIN_LEN 2 /* non-utf8 constant string length */
+#define PERL_MULTICONCAT_IX_UTF8_PV 3 /* utf8 constant string */
+#define PERL_MULTICONCAT_IX_UTF8_LEN 4 /* utf8 constant string length */
+#define PERL_MULTICONCAT_IX_LENGTHS 5 /* first of nargs+1 const segment lens */
+#define PERL_MULTICONCAT_HEADER_SIZE 5 /* The number of fields of a
+ multiconcat header */
+
/* We no longer default to creating a new SV for GvSV.
Do this before embed. */
#ifndef PERL_CREATE_GVSV
*/
/* Note that we do not check against snprintf()/vsnprintf() returning
- * negative values because that is non-standard behaviour and we now
- * assume a working C89 implementation. */
+ * negative values because that is non-standard behaviour and we use
+ * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and
+ * that should be true only if the snprintf()/vsnprintf() are true
+ * to the standard. */
#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
#ifdef USE_QUADMATH
# define my_snprintf Perl_my_snprintf
# define PERL_MY_SNPRINTF_GUARDED
-#elif defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
+#elif defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
# define PERL_MY_SNPRINTF_GUARDED
/* There is no quadmath_vsnprintf, and therefore my_vsnprintf()
* dies if called under USE_QUADMATH. */
-#if defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
+#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
# define PERL_MY_VSNPRINTF_GUARDED
# define my_strlcat Perl_my_strlcat
#endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
+# ifdef HAS_MEMRCHR
+# define my_memrchr memrchr
+# else
+# define my_memrchr S_my_memrchr
+# endif
+#endif
+
#ifdef HAS_STRLCPY
# define my_strlcpy strlcpy
#else
# define my_strlcpy Perl_my_strlcpy
#endif
+#ifdef HAS_STRNLEN
+# define my_strnlen strnlen
+#else
+# define my_strnlen Perl_my_strnlen
+#endif
+
/*
The IV type is supposed to be long enough to hold any integral
value or a pointer.
*/
/* The following are stored in $^H{sort}, not in PL_hints */
-#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
-#define HINT_SORT_QUICKSORT 0x00000001
-#define HINT_SORT_MERGESORT 0x00000002
#define HINT_SORT_STABLE 0x00000100 /* sort styles */
#define HINT_SORT_UNSTABLE 0x00000200
#define PERLDB_LINE_OR_SAVESRC (PL_perldb & (PERLDBf_LINE | PERLDBf_SAVESRC))
+#ifdef USE_ITHREADS
+# define KEYWORD_PLUGIN_MUTEX_INIT MUTEX_INIT(&PL_keyword_plugin_mutex)
+# define KEYWORD_PLUGIN_MUTEX_LOCK MUTEX_LOCK(&PL_keyword_plugin_mutex)
+# define KEYWORD_PLUGIN_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_keyword_plugin_mutex)
+# define KEYWORD_PLUGIN_MUTEX_TERM MUTEX_DESTROY(&PL_keyword_plugin_mutex)
+#else
+# define KEYWORD_PLUGIN_MUTEX_INIT NOOP
+# define KEYWORD_PLUGIN_MUTEX_LOCK NOOP
+# define KEYWORD_PLUGIN_MUTEX_UNLOCK NOOP
+# define KEYWORD_PLUGIN_MUTEX_TERM NOOP
+#endif
+
#ifdef USE_LOCALE
/* These locale things are all subject to change */
# define IN_LC_COMPILETIME(category) \
(IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
- && _is_in_locale_category(TRUE, (category))))
+ && Perl__is_in_locale_category(aTHX_ TRUE, (category))))
# define IN_LC_RUNTIME(category) \
(IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
- && _is_in_locale_category(FALSE, (category))))
+ && Perl__is_in_locale_category(aTHX_ FALSE, (category))))
# define IN_LC(category) \
(IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
} STMT_END
# endif /* PERL_CORE or PERL_IN_XSUB_RE */
-
#else /* No locale usage */
# define LOCALE_INIT
# define LOCALE_TERM
*/
-#define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard)
+# define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard)
/* We can lock the category to stay in the C locale, making requests to the
* contrary be noops, in the dynamic scope by setting PL_numeric_standard to 2.
* */
-#define _NOT_IN_NUMERIC_UNDERLYING \
- (! PL_numeric_local && PL_numeric_standard < 2)
+# define _NOT_IN_NUMERIC_UNDERLYING \
+ (! PL_numeric_underlying && PL_numeric_standard < 2)
-#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
+# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
-#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
if (IN_LC(LC_NUMERIC)) { \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
- Perl_set_numeric_local(aTHX); \
+ Perl_set_numeric_underlying(aTHX); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
} \
} \
else { \
if (_NOT_IN_NUMERIC_STANDARD) { \
SET_NUMERIC_STANDARD(); \
- _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_underlying; \
} \
}
-#define RESTORE_LC_NUMERIC() \
+# define RESTORE_LC_NUMERIC() \
if (_restore_LC_NUMERIC_function) { \
_restore_LC_NUMERIC_function(aTHX); \
}
/* The next two macros set unconditionally. These should be rarely used, and
* only after being sure that this is what is needed */
-#define SET_NUMERIC_STANDARD() \
+# define SET_NUMERIC_STANDARD() \
STMT_START { if (_NOT_IN_NUMERIC_STANDARD) \
Perl_set_numeric_standard(aTHX); \
} STMT_END
-#define SET_NUMERIC_UNDERLYING() \
+# define SET_NUMERIC_UNDERLYING() \
STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \
- Perl_set_numeric_local(aTHX); } STMT_END
+ Perl_set_numeric_underlying(aTHX); } STMT_END
/* The rest of these LC_NUMERIC macros toggle to one or the other state, with
* the RESTORE_foo ones called to switch back, but only if need be */
-#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \
- bool _was_local = _NOT_IN_NUMERIC_STANDARD; \
- if (_was_local) Perl_set_numeric_standard(aTHX);
+# define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \
+ bool _was_underlying = _NOT_IN_NUMERIC_STANDARD; \
+ if (_was_underlying) Perl_set_numeric_standard(aTHX);
/* Doesn't change to underlying locale unless within the scope of some form of
* 'use locale'. This is the usual desired behavior. */
-#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \
+# define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \
bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \
&& IN_LC(LC_NUMERIC); \
- if (_was_standard) Perl_set_numeric_local(aTHX);
+ if (_was_standard) Perl_set_numeric_underlying(aTHX);
/* Rarely, we want to change to the underlying locale even outside of 'use
* locale'. This is principally in the POSIX:: functions */
-#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \
+# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
- Perl_set_numeric_local(aTHX); \
+ Perl_set_numeric_underlying(aTHX); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
}
/* Lock/unlock to the C locale until unlock is called. This needs to be
* recursively callable. [perl #128207] */
-#define LOCK_LC_NUMERIC_STANDARD() \
+# define LOCK_LC_NUMERIC_STANDARD() \
(__ASSERT_(PL_numeric_standard) \
PL_numeric_standard++)
-#define UNLOCK_LC_NUMERIC_STANDARD() \
+# define UNLOCK_LC_NUMERIC_STANDARD() \
STMT_START { \
if (PL_numeric_standard > 1) { \
PL_numeric_standard--; \
} \
} STMT_END
-#define RESTORE_LC_NUMERIC_UNDERLYING() \
- if (_was_local) Perl_set_numeric_local(aTHX);
+# define RESTORE_LC_NUMERIC_UNDERLYING() \
+ if (_was_underlying) Perl_set_numeric_underlying(aTHX);
-#define RESTORE_LC_NUMERIC_STANDARD() \
+# define RESTORE_LC_NUMERIC_STANDARD() \
if (_restore_LC_NUMERIC_function) { \
_restore_LC_NUMERIC_function(aTHX); \
}
#else /* !USE_LOCALE_NUMERIC */
-#define SET_NUMERIC_STANDARD()
-#define SET_NUMERIC_UNDERLYING()
-#define IS_NUMERIC_RADIX(a, b) (0)
-#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
-#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
-#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
-#define RESTORE_LC_NUMERIC_UNDERLYING()
-#define RESTORE_LC_NUMERIC_STANDARD()
-#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
-#define STORE_LC_NUMERIC_SET_TO_NEEDED()
-#define RESTORE_LC_NUMERIC()
-#define LOCK_LC_NUMERIC_STANDARD()
-#define UNLOCK_LC_NUMERIC_STANDARD()
+# define SET_NUMERIC_STANDARD()
+# define SET_NUMERIC_UNDERLYING()
+# define IS_NUMERIC_RADIX(a, b) (0)
+# define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
+# define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
+# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+# define RESTORE_LC_NUMERIC_UNDERLYING()
+# define RESTORE_LC_NUMERIC_STANDARD()
+# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+# define STORE_LC_NUMERIC_SET_TO_NEEDED()
+# define RESTORE_LC_NUMERIC()
+# define LOCK_LC_NUMERIC_STANDARD()
+# define UNLOCK_LC_NUMERIC_STANDARD()
#endif /* !USE_LOCALE_NUMERIC */