# include "config.h"
#endif
+/* this is used for functions which take a depth trailing
+ * argument under debugging */
+#ifdef DEBUGGING
+#define _pDEPTH ,U32 depth
+#define _aDEPTH ,depth
+#else
+#define _pDEPTH
+#define _aDEPTH
+#endif
+
/* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined
* because the __STDC_VERSION__ became a thing only with C90. Therefore,
* with gcc, HAS_C99 will never become true as long as we use -std=c89.
/* Use the reentrant APIs like localtime_r and getpwent_r */
/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32)
# define USE_REENTRANT_API
#endif
* or variables/arguments that are used only in certain configurations.
*/
#ifndef PERL_UNUSED_ARG
-# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-# include <note.h>
-# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-# else
-# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
-# endif
+# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
#endif
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(x) ((void)sizeof(x))
* clang only pretends to be GCC 4.2, but still supports push/pop.
*
* Note on usage: on non-gcc (or lookalike, like clang) compilers
- * one cannot use these at file (global) level without warnings
- * since they are defined as empty, which leads into the terminating
+ * one cannot use these with a semicolon at file (global) level without
+ * warnings since they are defined as empty, which leads into the terminating
* semicolon being left alone on a line:
* ;
* which makes compilers mildly cranky. Therefore at file level one
- * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE_FILE *without*
+ * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE macros *without*
* the semicolons.
*
* (A dead-on-arrival solution would be to try to define the macros as
# define DONT_DECLARE_STD 1
#endif
-#if defined(HASVOLATILE) || defined(STANDARD_C)
-# define VOL volatile
-#else
-# define VOL
+/* These exist only for back-compat with XS modules. */
+#ifndef PERL_CORE
+#define VOL volatile
+#define CAN_PROTOTYPE
#endif
/* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT,
#include <sys/types.h>
-#ifdef __cplusplus
-# ifndef I_STDARG
-# define I_STDARG 1
-# endif
-#endif
-
/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h
which is included from stdarg.h. Bad definition not present in SD 2008
SDK headers. wince.h is not yet included, so we cant fix this from there
#if defined(UNDER_CE) && (_MSC_VER < 1300)
# define MB_CUR_MAX 1
#endif
-#ifdef I_STDARG
-# include <stdarg.h>
-#else
-# ifdef I_VARARGS
-# include <varargs.h>
-# endif
-#endif
+
+# include <stdarg.h>
#ifdef I_STDINT
# include <stdint.h>
# include <locale.h>
#endif
+#ifdef I_XLOCALE
+# include <xlocale.h>
+#endif
+
#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
# define USE_LOCALE
# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
# if !defined(NO_LOCALE_TIME) && defined(LC_TIME)
# define USE_LOCALE_TIME
# endif
-# ifndef WIN32 /* No wrapper except on Windows */
-# define my_setlocale(a,b) setlocale(a,b)
-# endif
#endif /* !NO_LOCALE && HAS_SETLOCALE */
-/* Is $^ENCODING set, or are we under the encoding pragma? */
-#define IN_ENCODING UNLIKELY(PL_encoding \
- || (PL_lex_encoding && _get_encoding() != NULL))
-
#include <setjmp.h>
#ifdef I_SYS_PARAM
# endif
#endif
-/* Use all the "standard" definitions? */
-#if defined(STANDARD_C) && defined(I_STDLIB)
-# include <stdlib.h>
-#endif
+/* Use all the "standard" definitions */
+#include <stdlib.h>
/* If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
# define PERL_STRLEN_EXPAND_SHIFT 2
#endif
-#if defined(STANDARD_C) && defined(I_STDDEF) && !defined(PERL_GCC_PEDANTIC)
-# include <stddef.h>
-# define STRUCT_OFFSET(s,m) offsetof(s,m)
-#else
-# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
-#endif
+#include <stddef.h>
+#define STRUCT_OFFSET(s,m) offsetof(s,m)
/* ptrdiff_t is C11, so undef it under pedantic builds */
#ifdef PERL_GCC_PEDANTIC
#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL)
-#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
-#define strchr index
-#define strrchr rindex
-#endif
-
#ifdef I_MEMORY
# include <memory.h>
#endif
-#ifdef HAS_MEMCPY
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memcpy
- extern char * memcpy (char*, char*, int);
-# endif
-# endif
-#else
-# ifndef memcpy
-# define memcpy(d,s,l) my_bcopy(s,d,l)
-# endif
-#endif /* HAS_MEMCPY */
-
-#ifdef HAS_MEMSET
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memset
- extern char *memset (char*, int, int);
-# endif
-# endif
-#else
-# undef memset
-# define memset(d,c,l) my_memset(d,c,l)
-#endif /* HAS_MEMSET */
-
-#if !defined(HAS_MEMMOVE) && !defined(memmove)
-# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
-# define memmove(d,s,l) memcpy(d,s,l)
-# else
-# define memmove(d,s,l) my_bcopy(s,d,l)
-# endif
-#endif
-
-#if defined(mips) && defined(ultrix) && !defined(__STDC__)
-# undef HAS_MEMCMP
-#endif
-
-#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memcmp
- extern int memcmp (char*, char*, int);
-# endif
-# endif
-#else
-# ifndef memcmp
-# define memcmp my_memcmp
-# endif
-#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
-
#ifndef memzero
-# ifdef HAS_MEMSET
-# define memzero(d,l) memset(d,0,l)
-# else
-# ifdef HAS_BZERO
-# define memzero(d,l) bzero(d,l)
-# else
-# define memzero(d,l) my_bzero(d,l)
-# endif
-# endif
+# define memzero(d,l) memset(d,0,l)
#endif
-#ifndef PERL_MICRO
-#ifndef memchr
-# ifndef HAS_MEMCHR
-# define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
-# endif
-#endif
-#endif
-
-#ifndef HAS_BCMP
-# ifndef bcmp
-# define bcmp(s1,s2,l) memcmp(s1,s2,l)
-# endif
-#endif /* !HAS_BCMP */
-
#ifdef I_NETINET_IN
# include <netinet/in.h>
#endif
# undef S_ISLNK
#endif
-#ifdef I_TIME
-# include <time.h>
-#endif
+#include <time.h>
#ifdef I_SYS_TIME
# ifdef I_SYS_TIME_KERNEL
#define CLEAR_ERRSV() STMT_START { \
SV ** const svp = &GvSV(PL_errgv); \
if (!*svp) { \
- goto clresv_newemptypv; \
+ *svp = newSVpvs(""); \
} else if (SvREADONLY(*svp)) { \
SvREFCNT_dec_NN(*svp); \
- clresv_newemptypv: \
*svp = newSVpvs(""); \
} else { \
SV *const errsv = *svp; \
- sv_setpvs(errsv, ""); \
+ SvPVCLEAR(errsv); \
SvPOK_only(errsv); \
if (SvMAGICAL(errsv)) { \
mg_free(errsv); \
#undef UV
#endif
-/* For the times when you want the return value of sprintf, and you want it
- to be the length. Can't have a thread variable passed in, because C89 has
- no varargs macros.
-*/
-#ifdef SPRINTF_RETURNS_STRLEN
-# define my_sprintf sprintf
-#else
-# define my_sprintf Perl_my_sprintf
-#endif
+/* This used to be conditionally defined based on whether we had a sprintf()
+ * that correctly returns the string length (as required by C89), but we no
+ * longer need that. XS modules can (and do) use this name, so it must remain
+ * a part of the API that's visible to modules. But we no longer document it
+ * either (because using sprintf() rather than snprintf() is almost always
+ * a bad idea). */
+#define my_sprintf sprintf
/*
* If we have v?snprintf() and the C99 variadic macros, we can just
*/
/* Note that we do not check against snprintf()/vsnprintf() returning
- * 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. */
+ * negative values because that is non-standard behaviour and we now
+ * assume a working C89 implementation. */
-#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
+#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
#else
-#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
+#if 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_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
+#if 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 Perl_isinf(x) isinfq(x)
# define Perl_isnan(x) isnanq(x)
# define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+# define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1)
+# define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3)
+# define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4)
+# define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1)
+# define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2)
+# define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0)
#else
# define NV_DIG DBL_DIG
# ifdef DBL_MANT_DIG
typedef struct padnamelist PADNAMELIST;
typedef struct padname PADNAME;
+/* enable PERL_OP_PARENT by default */
+#if !defined(PERL_OP_PARENT) && !defined(PERL_NO_OP_PARENT)
+# define PERL_OP_PARENT
+#endif
+
/* enable PERL_COPY_ON_WRITE by default */
#if !defined(PERL_COPY_ON_WRITE) && !defined(PERL_NO_COW)
# define PERL_COPY_ON_WRITE
*/
#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \
defined(__clang__) && \
+ !defined(PERL_GLOBAL_STRUCT) && \
+ !defined(PERL_GLOBAL_STRUCT_PRIVATE) && \
!defined(SWIG) && \
((!defined(__apple_build_version__) && \
((__clang_major__ == 3 && __clang_minor__ >= 6) || \
* TODO: however, some platforms are starting to get these clang
* thread safety annotations for pthreads, for example FreeBSD.
* Do we need a way to a bypass these wrappers? */
-int perl_tsa_mutex_lock(perl_mutex* mutex)
+EXTERN_C int perl_tsa_mutex_lock(perl_mutex* mutex)
PERL_TSA_ACQUIRE(*mutex)
PERL_TSA_NO_TSA;
-int perl_tsa_mutex_unlock(perl_mutex* mutex)
+EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex)
PERL_TSA_RELEASE(*mutex)
PERL_TSA_NO_TSA;
#endif
/* placeholder */
#endif
-/* STATIC_ASSERT_GLOBAL/STATIC_ASSERT_STMT are like assert(), but for compile
+/* STATIC_ASSERT_DECL/STATIC_ASSERT_STMT are like assert(), but for compile
time invariants. That is, their argument must be a constant expression that
can be verified by the compiler. This expression can contain anything that's
known to the compiler, e.g. #define constants, enums, or sizeof (...). If
the expression evaluates to 0, compilation fails.
Because they generate no runtime code (i.e. their use is "free"), they're
always active, even under non-DEBUGGING builds.
- STATIC_ASSERT_GLOBAL expands to a declaration and is suitable for use at
+ STATIC_ASSERT_DECL expands to a declaration and is suitable for use at
file scope (outside of any function).
STATIC_ASSERT_STMT expands to a statement and is suitable for use inside a
function.
*/
#if (defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)) && (!defined(__IBMC__) || __IBMC__ >= 1210)
/* static_assert is a macro defined in <assert.h> in C11 or a compiler
- builtin in C++11.
+ builtin in C++11. But IBM XL C V11 does not support _Static_assert, no
+ matter what <assert.h> says.
*/
-/* IBM XL C V11 does not support _Static_assert, no matter what <assert.h> says */
-# define STATIC_ASSERT_GLOBAL(COND) static_assert(COND, #COND)
+# define STATIC_ASSERT_DECL(COND) static_assert(COND, #COND)
#else
/* We use a bit-field instead of an array because gcc accepts
'typedef char x[n]' where n is not a compile-time constant.
unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \
} _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL
# define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX)
-# define STATIC_ASSERT_GLOBAL(COND) STATIC_ASSERT_1(COND, __LINE__)
+# define STATIC_ASSERT_DECL(COND) STATIC_ASSERT_1(COND, __LINE__)
#endif
/* We need this wrapper even in C11 because 'case X: static_assert(...);' is an
error (static_assert is a declaration, and only statements can have labels).
*/
-#define STATIC_ASSERT_STMT(COND) do { STATIC_ASSERT_GLOBAL(COND); } while (0)
+#define STATIC_ASSERT_STMT(COND) STMT_START { STATIC_ASSERT_DECL(COND); } STMT_END
#ifndef __has_builtin
# define __has_builtin(x) 0 /* not a clang style compiler */
# define ASSUME(x) assert(x)
#endif
-#define NOT_REACHED ASSUME(0)
+#if defined(__sun) /* ASSUME() generates warnings on Solaris */
+# define NOT_REACHED
+#elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \
+ || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */
+# define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END
+#else
+# define NOT_REACHED ASSUME(0)
+#endif
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
# define USEMYBINMODE /**/
# include <io.h> /* for setmode() prototype */
# define my_binmode(fp, iotype, mode) \
- (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
+ cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1)
#endif
#ifdef __CYGWIN__
#else
union any {
void* any_ptr;
+ SV* any_sv;
+ SV** any_svp;
+ GV* any_gv;
+ AV* any_av;
+ HV* any_hv;
+ OP* any_op;
+ char* any_pv;
+ char** any_pvp;
I32 any_i32;
U32 any_u32;
IV any_iv;
#endif
/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
- * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
- * defined by Configure, despite their names being similar to the
- * other defines like USE_ITHREADS. Configure in fact knows nothing
- * about the randomised hashes. Therefore to enable/disable the hash
- * randomisation defines use the Configure -Accflags=... instead. */
-#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
+ * Note that the USE_HASH_SEED and similar defines are *NOT* defined by
+ * Configure, despite their names being similar to other defines like
+ * USE_ITHREADS. Configure in fact knows nothing about the randomised
+ * hashes. Therefore to enable/disable the hash randomisation defines
+ * use the Configure -Accflags=... instead. */
+#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED)
# define USE_HASH_SEED
#endif
-/* Win32 defines a type 'WORD' in windef.h, and AmigaOS in exec/types.h.
- * This conflicts with the enumerator 'WORD' defined in perly.h.
- * The yytokentype enum is only a debugging aid, so it's not really needed. */
-#if defined(WIN32) || defined(__amigaos4__)
-# define YYTOKENTYPE
-#endif
#include "perly.h"
#undef _XPVMG_HEAD
#undef _XPVCV_COMMON
-typedef struct _sublex_info SUBLEXINFO;
-struct _sublex_info {
- U8 super_state; /* lexer state to save */
- U16 sub_inwhat; /* "lex_inwhat" to use */
- OP *sub_op; /* "lex_op" to use */
- SV *repl; /* replacement of s/// or y/// */
-};
-
#include "parser.h"
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
/* U is reserved for Unofficial, exploratory hacking */
#define DEBUG_U_FLAG 0x00001000 /* 4096 */
-#define DEBUG_H_FLAG 0x00002000 /* 8192 */
+/* spare 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
#define DEBUG_S_FLAG 0x00010000 /* 65536 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
#define DEBUG_L_FLAG 0x04000000 /*67108864*/
-#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */
+#define DEBUG_i_FLAG 0x08000000 /*134217728*/
+#define DEBUG_MASK 0x0FFFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */
-# define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
-# define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
-# define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG)
-# define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG)
-# define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG)
-# define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG)
-# define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG)
-# define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG)
-# define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG)
-# define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
-# define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
-# define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
-# define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
-# define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
-# define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
-# define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
-# define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
-# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
-# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
-# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
-# define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
-# define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
-# define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
-# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
-# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
-# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
-# define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG)
+# 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_t_TEST_ UNLIKELY(PL_debug & DEBUG_t_FLAG)
+# define DEBUG_o_TEST_ UNLIKELY(PL_debug & DEBUG_o_FLAG)
+# define DEBUG_c_TEST_ UNLIKELY(PL_debug & DEBUG_c_FLAG)
+# define DEBUG_P_TEST_ UNLIKELY(PL_debug & DEBUG_P_FLAG)
+# define DEBUG_m_TEST_ UNLIKELY(PL_debug & DEBUG_m_FLAG)
+# define DEBUG_f_TEST_ UNLIKELY(PL_debug & DEBUG_f_FLAG)
+# define DEBUG_r_TEST_ UNLIKELY(PL_debug & DEBUG_r_FLAG)
+# define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG)
+# define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG)
+# define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG)
+# define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG)
+# define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG)
+# define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_FLAG)
+# define DEBUG_T_TEST_ UNLIKELY(PL_debug & DEBUG_T_FLAG)
+# define DEBUG_R_TEST_ UNLIKELY(PL_debug & DEBUG_R_FLAG)
+# define DEBUG_J_TEST_ UNLIKELY(PL_debug & DEBUG_J_FLAG)
+# define DEBUG_v_TEST_ UNLIKELY(PL_debug & DEBUG_v_FLAG)
+# define DEBUG_C_TEST_ UNLIKELY(PL_debug & DEBUG_C_FLAG)
+# define DEBUG_A_TEST_ UNLIKELY(PL_debug & DEBUG_A_FLAG)
+# define DEBUG_q_TEST_ UNLIKELY(PL_debug & DEBUG_q_FLAG)
+# define DEBUG_M_TEST_ UNLIKELY(PL_debug & DEBUG_M_FLAG)
+# define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG)
+# define DEBUG_L_TEST_ UNLIKELY(PL_debug & DEBUG_L_FLAG)
+# define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_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_x_TEST DEBUG_x_TEST_
# define DEBUG_u_TEST DEBUG_u_TEST_
# define DEBUG_U_TEST DEBUG_U_TEST_
-# define DEBUG_H_TEST DEBUG_H_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
# define DEBUG_D_TEST DEBUG_D_TEST_
# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
# define DEBUG_L_TEST DEBUG_L_TEST_
+# define DEBUG_i_TEST DEBUG_i_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
/* Temporarily turn off memory debugging in case the a
* does memory allocation, either directly or indirectly. */
# define DEBUG_m(a) \
- STMT_START { \
- if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
+ STMT_START { \
+ if (PERL_GET_INTERP) { \
+ dTHX; \
+ if (DEBUG_m_TEST) { \
+ PL_debug &= ~DEBUG_m_FLAG; \
+ a; \
+ PL_debug |= DEBUG_m_FLAG; \
+ } \
+ } \
} STMT_END
-# define DEBUG__(t, a) \
- STMT_START { \
- if (t) STMT_START {a;} STMT_END; \
- } STMT_END
+# define DEBUG__(t, a) \
+ STMT_START { \
+ if (t) STMT_START {a;} STMT_END; \
+ } STMT_END
# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+
#ifndef PERL_EXT_RE_BUILD
# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
#else
# define DEBUG_r(a) STMT_START {a;} STMT_END
#endif /* PERL_EXT_RE_BUILD */
+
# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
-# define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
+# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a)
#else /* DEBUGGING */
# define DEBUG_x_TEST (0)
# define DEBUG_u_TEST (0)
# define DEBUG_U_TEST (0)
-# define DEBUG_H_TEST (0)
# define DEBUG_X_TEST (0)
# define DEBUG_D_TEST (0)
# define DEBUG_S_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
# define DEBUG_L_TEST (0)
+# define DEBUG_i_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
# define DEBUG_x(a)
# define DEBUG_u(a)
# define DEBUG_U(a)
-# define DEBUG_H(a)
# define DEBUG_X(a)
# define DEBUG_D(a)
# define DEBUG_S(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
# define DEBUG_L(a)
+# define DEBUG_i(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
Time_t time();
struct tm *gmtime(), *localtime();
#if defined(OEMVS)
-char *(strchr)(), *(strrchr)();
char *(strcpy)(), *(strcat)();
#else
-char *strchr(), *strrchr();
char *strcpy(), *strcat();
#endif
#endif /* ! STANDARD_C */
INIT("1");
EXTCONST char PL_No[]
INIT("");
+EXTCONST char PL_Zero[]
+ INIT("0");
EXTCONST char PL_hexdigit[]
INIT("0123456789abcdef0123456789ABCDEF");
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
+/* a special string address whose value is "isa", but which perl knows
+ * to treat as if it were really "DOES" when printing the method name in
+ * the "Can't call method '%s'" error message */
+EXTCONST char PL_isa_DOES[]
+ INIT("isa");
+
#ifdef DOINIT
EXTCONST char PL_uudmap[256] =
# ifdef PERL_MICRO
/* These are all the compile time options that affect binary compatibility.
Other compile time options that are binary compatible are in perl.c
- Both are combined for the output of perl -V
+ (in S_Internals_V()). Both are combined for the output of perl -V
However, this string will be embedded in any shared perl library, which will
allow us add a comparison check in perlmain.c in the near future. */
#ifdef DOINIT
/* Do not use this macro. It only exists for extensions that rely on PL_dirty
* instead of using the newer PL_phase, which provides everything PL_dirty
* provided, and more. */
-# define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT)
+# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT)
# define PL_amagic_generation PL_na
+# define PL_encoding ((SV *)NULL)
#endif /* !PERL_CORE */
#define PL_hints PL_compiling.cop_hints
+#define PL_maxo MAXO
END_EXTERN_C
/* update exp_name[] in toke.c if adding to this enum */
} expectation;
+#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */
+
/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
special and there is no need for HINT_PRIVATE_MASK for COPs
However, bitops store HINT_INTEGER in their op_private.
#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 (currently one) */
+#define HINT_SORT_STABLE 0x00000100 /* sort styles */
+#define HINT_SORT_UNSTABLE 0x00000200
/* flags for PL_sawampersand */
START_EXTERN_C
# include "intrpvar.h"
END_EXTERN_C
+# define PL_sv_yes (PL_sv_immortals[0])
+# define PL_sv_undef (PL_sv_immortals[1])
+# define PL_sv_no (PL_sv_immortals[2])
+# define PL_sv_zero (PL_sv_immortals[3])
#endif
#ifdef PERL_CORE
EXTCONST bool
PL_valid_types_NVX[] = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
EXTCONST bool
-PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
+PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1 };
EXTCONST bool
PL_valid_types_RV[] = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
EXTCONST bool
/* In C99 we could use designated (named field) union initializers.
* In C89 we need to initialize the member declared first.
+ * In C++ we need extern C initializers.
*
* With the U8_NV version you will want to have inner braces,
- * while with the NV_U8 use just the NV.*/
-#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; }
-#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; }
-
-#ifdef DOINIT
-
-/* PL_inf and PL_nan initialization.
- *
- * For inf and nan initialization the ultimate fallback is dividing
- * one or zero by zero: however, some compilers will warn or even fail
- * on divide-by-zero, but hopefully something earlier will work.
- *
- * If you are thinking of using HUGE_VAL for infinity, or using
- * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
- * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX,
- * and the math functions might be just generating DBL_MAX, or even zero.
- *
- * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
- * Though logically correct, some compilers (like Visual C 2003)
- * falsely misoptimize that to zero (x-x is always zero, right?)
- */
-
-/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
-GCC_DIAG_IGNORE(-Wc++-compat)
-
-# ifdef USE_QUADMATH
-/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
- * constant. */
-INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q };
-# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES)
-INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } };
-# elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)
-INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } };
-# else
-# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
-# if defined(LDBL_INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY };
-# elif defined(LDBL_INF)
-INFNAN_NV_U8_DECL PL_inf = { LDBL_INF };
-# elif defined(INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
-# elif defined(INF)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
-# else
-INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */
-# endif
-# else
-# if defined(DBL_INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY };
-# elif defined(DBL_INF)
-INFNAN_NV_U8_DECL PL_inf = { DBL_INF };
-# elif defined(INFINITY) /* C99 */
-INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
-# elif defined(INF)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
-# else
-INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */
-# endif
-# endif
-# endif
-
-# ifdef USE_QUADMATH
-/* Cannot use nanq("0") for PL_nan because not a compile-time
- * constant. */
-INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q };
-# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES)
-INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } };
-# elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)
-INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } };
-# else
-# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
-# if defined(LDBL_NAN)
-INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN };
-# elif defined(LDBL_QNAN)
-INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN };
-# elif defined(NAN)
-INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
-# else
-INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */
-# endif
-# else
-# if defined(DBL_NAN)
-INFNAN_NV_U8_DECL PL_nan = { DBL_NAN };
-# elif defined(DBL_QNAN)
-INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN };
-# elif defined(NAN) /* C99 */
-INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
-# else
-INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */
-# endif
-# endif
-# endif
-
-GCC_DIAG_RESTORE
+ * while with the NV_U8 use just the NV. */
+#ifdef __cplusplus
+#define INFNAN_U8_NV_DECL EXTERN_C const union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTERN_C const union { NV nv; U8 u8[NVSIZE]; }
#else
-
-INFNAN_NV_U8_DECL PL_inf;
-INFNAN_NV_U8_DECL PL_nan;
-
-#endif
-
-/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h),
- * we will define NV_INF/NV_NAN as the nv part of the global const
- * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN
- * might not be a compile-time constant, in which case it cannot be
- * used to initialize PL_inf/PL_nan above. */
-#ifndef NV_INF
-# define NV_INF PL_inf.nv
-#endif
-#ifndef NV_NAN
-# define NV_NAN PL_nan.nv
+#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; }
#endif
/* if these never got defined, they need defaults */
#ifdef USE_LOCALE
/* These locale things are all subject to change */
+
+
+# if defined(HAS_NEWLOCALE) \
+ && defined(LC_ALL_MASK) \
+ && defined(HAS_FREELOCALE) \
+ && defined(HAS_USELOCALE) \
+ && ! defined(NO_POSIX_2008_LOCALE)
+
+ /* The code is written for simplicity to assume that any platform advanced
+ * enough to have the Posix 2008 locale functions has LC_ALL. The test
+ * above makes sure that assumption is valid */
+
+# define HAS_POSIX_2008_LOCALE
+# endif
+
+/* We create a C locale object unconditionally if we have the functions to do
+ * so; hence must destroy it unconditionally at the end */
+# ifndef HAS_POSIX_2008_LOCALE
+# define _LOCALE_TERM_POSIX_2008 NOOP
+# else
+# define _LOCALE_TERM_POSIX_2008 \
+ STMT_START { \
+ if (PL_C_locale_obj) { \
+ /* Make sure we aren't using the locale \
+ * space we are about to free */ \
+ uselocale(LC_GLOBAL_LOCALE); \
+ freelocale(PL_C_locale_obj); \
+ PL_C_locale_obj = (locale_t) NULL; \
+ } \
+ } STMT_END
+# endif
+
+# ifndef USE_ITHREADS
+# define LOCALE_INIT
+# define LOCALE_LOCK
+# define LOCALE_UNLOCK
+# define LOCALE_TERM STMT_START { _LOCALE_TERM_POSIX_2008; } STMT_END
+# else /* Below is do use threads */
+# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex)
+# define LOCALE_LOCK MUTEX_LOCK(&PL_locale_mutex)
+# define LOCALE_UNLOCK MUTEX_UNLOCK(&PL_locale_mutex)
+# define LOCALE_TERM \
+ STMT_START { \
+ MUTEX_DESTROY(&PL_locale_mutex); \
+ _LOCALE_TERM_POSIX_2008; \
+ } STMT_END
+# ifdef HAS_POSIX_2008_LOCALE
+# define USE_POSIX_2008_LOCALE
+# define USE_THREAD_SAFE_LOCALE
+# endif
+# endif
+
/* Returns TRUE if the plain locale pragma without a parameter is in effect
*/
-# define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
+# define IN_LOCALE_RUNTIME (PL_curcop \
+ && CopHINTS_get(PL_curcop) & HINT_LOCALE)
/* Returns TRUE if either form of the locale pragma is in effect */
# define IN_SOME_LOCALE_FORM_RUNTIME \
# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
# define IN_LC_PARTIAL_RUNTIME \
- cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
+ (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
# define IN_LC_COMPILETIME(category) \
(IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
STMT_START { \
if (UNLIKELY(PL_warn_locale)) { \
- _warn_problematic_locale(); \
+ Perl__warn_problematic_locale(); \
} \
} STMT_END
# else
STMT_START { \
if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
- "Wide character (U+%"UVXf") in %s", \
- (UV) cp, OP_DESC(PL_op)); \
+ "Wide character (U+%" UVXf ") in %s",\
+ (UV) cp, OP_DESC(PL_op)); \
} \
} STMT_END
if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \
Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
- "Wide character (U+%"UVXf") in %s", \
+ "Wide character (U+%" UVXf ") in %s", \
(cp == 0) \
? UNICODE_REPLACEMENT \
: (UV) cp, \
# endif /* PERL_CORE or PERL_IN_XSUB_RE */
#else /* No locale usage */
+# define LOCALE_INIT
+# define LOCALE_TERM
+# define LOCALE_LOCK
+# define LOCALE_UNLOCK
# define IN_LOCALE_RUNTIME 0
# define IN_SOME_LOCALE_FORM_RUNTIME 0
# define IN_LOCALE_COMPILETIME 0
#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
if (IN_LC(LC_NUMERIC)) { \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
- set_numeric_local(); \
+ Perl_set_numeric_local(aTHX); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
} \
} \
/* 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() \
- STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \
- } STMT_END
+ STMT_START { if (_NOT_IN_NUMERIC_STANDARD) \
+ Perl_set_numeric_standard(aTHX); \
+ } STMT_END
#define SET_NUMERIC_UNDERLYING() \
STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \
- set_numeric_local(); } STMT_END
+ Perl_set_numeric_local(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) set_numeric_standard();
+ if (_was_local) 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() \
bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \
&& IN_LC(LC_NUMERIC); \
- if (_was_standard) set_numeric_local();
+ if (_was_standard) Perl_set_numeric_local(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() \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
- set_numeric_local(); \
+ Perl_set_numeric_local(aTHX); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
}
-/* Lock to the C locale until unlock is called */
+/* Lock/unlock to the C locale until unlock is called. This needs to be
+ * recursively callable. [perl #128207] */
#define LOCK_LC_NUMERIC_STANDARD() \
(__ASSERT_(PL_numeric_standard) \
- PL_numeric_standard = 2)
-
+ PL_numeric_standard++)
#define UNLOCK_LC_NUMERIC_STANDARD() \
- (__ASSERT_(PL_numeric_standard == 2) \
- PL_numeric_standard = 1)
+ STMT_START { \
+ if (PL_numeric_standard > 1) { \
+ PL_numeric_standard--; \
+ } \
+ else { \
+ assert(0); \
+ } \
+ } STMT_END
#define RESTORE_LC_NUMERIC_UNDERLYING() \
- if (_was_local) set_numeric_local();
+ if (_was_local) Perl_set_numeric_local(aTHX);
#define RESTORE_LC_NUMERIC_STANDARD() \
if (_restore_LC_NUMERIC_function) { \
# ifdef __hpux
# define strtoll __strtoll /* secret handshake */
# endif
-# ifdef WIN64
+# if defined(WIN64) && defined(_MSC_VER)
# define strtoll _strtoi64 /* secret handshake */
# endif
# if !defined(Strtol) && defined(HAS_STRTOLL)
# ifdef __hpux
# define strtoull __strtoull /* secret handshake */
# endif
-# ifdef WIN64
+# if defined(WIN64) && defined(_MSC_VER)
# define strtoull _strtoui64 /* secret handshake */
# endif
# if !defined(Strtoul) && defined(HAS_STRTOULL)
#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII
+#if DOUBLEKIND == DOUBLE_IS_VAX_F_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_G_FLOAT
+# define DOUBLE_IS_VAX_FLOAT
+#else
+# define DOUBLE_IS_IEEE_FORMAT
+#endif
+
#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \
DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \
DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
# define DOUBLE_MIX_ENDIAN
#endif
+/* The VAX fp formats are neither consistently little-endian nor
+ * big-endian, and neither are they really IEEE-mixed endian like
+ * the mixed-endian ARM IEEE formats (with swapped bytes).
+ * Ultimately, the VAX format came from the PDP-11.
+ *
+ * The ordering of the parts in VAX floats is quite vexing.
+ * In the below the fraction_n are the mantissa bits.
+ *
+ * The fraction_1 is the most significant (numbering as by DEC/Digital),
+ * while the rightmost bit in each fraction is the least significant:
+ * in other words, big-endian bit order within the fractions.
+ *
+ * The fraction segments themselves would be big-endianly, except that
+ * within 32 bit segments the less significant half comes first, the more
+ * significant after, except that in the format H (used for long doubles)
+ * the first fraction segment is alone, because the exponent is wider.
+ * This means for example that both the most and the least significant
+ * bits can be in the middle of the floats, not at either end.
+ *
+ * References:
+ * http://nssdc.gsfc.nasa.gov/nssdc/formats/VAXFloatingPoint.htm
+ * http://www.quadibloc.com/comp/cp0201.htm
+ * http://h71000.www7.hp.com/doc/82final/6443/6443pro_028.html
+ * (somebody at HP should be fired for the URLs)
+ *
+ * F fraction_2:16 sign:1 exp:8 fraction_1:7
+ * (exponent bias 128, hidden first one-bit)
+ *
+ * D fraction_2:16 sign:1 exp:8 fraction_1:7
+ * fraction_4:16 fraction_3:16
+ * (exponent bias 128, hidden first one-bit)
+ *
+ * G fraction_2:16 sign:1 exp:11 fraction_1:4
+ * fraction_4:16 fraction_3:16
+ * (exponent bias 1024, hidden first one-bit)
+ *
+ * H fraction_1:16 sign:1 exp:15
+ * fraction_3:16 fraction_2:16
+ * fraction_5:16 fraction_4:16
+ * fraction_7:16 fraction_6:16
+ * (exponent bias 16384, hidden first one-bit)
+ * (available only on VAX, and only on Fortran?)
+ *
+ * The formats S, T and X are available on the Alpha (and Itanium,
+ * also known as I64/IA64) and are equivalent with the IEEE-754 formats
+ * binary32, binary64, and binary128 (commonly: float, double, long double).
+ *
+ * S sign:1 exp:8 mantissa:23
+ * (exponent bias 127, hidden first one-bit)
+ *
+ * T sign:1 exp:11 mantissa:52
+ * (exponent bias 1022, hidden first one-bit)
+ *
+ * X sign:1 exp:15 mantissa:112
+ * (exponent bias 16382, hidden first one-bit)
+ *
+ */
+
+#ifdef DOUBLE_IS_VAX_FLOAT
+# define DOUBLE_VAX_ENDIAN
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
/* All the basic IEEE formats have the implicit bit,
- * except for the 80-bit extended formats, which will undef this. */
-#define NV_IMPLICIT_BIT
+ * except for the x86 80-bit extended formats, which will undef this.
+ * Also note that the IEEE 754 subnormals (formerly known as denormals)
+ * do not have the implicit bit of one. */
+# define NV_IMPLICIT_BIT
+#endif
-#ifdef LONG_DOUBLEKIND
+#if defined(LONG_DOUBLEKIND) && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE
# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
# define LONGDOUBLE_X86_80_BIT
# ifdef USE_LONG_DOUBLE
# undef NV_IMPLICIT_BIT
+# define NV_X86_80_BIT
# endif
# endif
# define LONGDOUBLE_DOUBLEDOUBLE
# endif
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_VAX_H_FLOAT
+# define LONGDOUBLE_VAX_ENDIAN
+# endif
+
#endif /* LONG_DOUBLEKIND */
#ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */
# ifdef DOUBLE_MIX_ENDIAN
# define NV_MIX_ENDIAN
# endif
+# ifdef DOUBLE_VAX_ENDIAN
+# define NV_VAX_ENDIAN
+# endif
#elif NVSIZE == LONG_DOUBLESIZE
# ifdef LONGDOUBLE_LITTLE_ENDIAN
# define NV_LITTLE_ENDIAN
# ifdef LONGDOUBLE_MIX_ENDIAN
# define NV_MIX_ENDIAN
# endif
+# ifdef LONGDOUBLE_VAX_ENDIAN
+# define NV_VAX_ENDIAN
+# endif
+#endif
+
+/* We have somehow managed not to define the denormal/subnormal
+ * detection.
+ *
+ * This may happen if the compiler doesn't expose the C99 math like
+ * the fpclassify() without some special switches. Perl tries to
+ * stay C89, so for example -std=c99 is not an option.
+ *
+ * The Perl_isinf() and Perl_isnan() should have been defined even if
+ * the C99 isinf() and isnan() are unavailable, and the NV_MIN becomes
+ * from the C89 DBL_MIN or moral equivalent. */
+#if !defined(Perl_fp_class_denorm) && defined(Perl_isinf) && defined(Perl_isnan) && defined(NV_MIN)
+# define Perl_fp_class_denorm(x) ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN)
+#endif
+
+/* This is not a great fallback: subnormals tests will fail,
+ * but at least Perl will link and 99.999% of tests will work. */
+#if !defined(Perl_fp_class_denorm)
+# define Perl_fp_class_denorm(x) FALSE
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
+# define DOUBLE_HAS_INF
+# define DOUBLE_HAS_NAN
+#endif
+
+#ifdef DOUBLE_HAS_NAN
+
+#ifdef DOINIT
+
+/* PL_inf and PL_nan initialization.
+ *
+ * For inf and nan initialization the ultimate fallback is dividing
+ * one or zero by zero: however, some compilers will warn or even fail
+ * on divide-by-zero, but hopefully something earlier will work.
+ *
+ * If you are thinking of using HUGE_VAL for infinity, or using
+ * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
+ * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX,
+ * and the math functions might be just generating DBL_MAX, or even zero.
+ *
+ * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
+ * Though logically correct, some compilers (like Visual C 2003)
+ * falsely misoptimize that to zero (x-x is always zero, right?)
+ *
+ * Finally, note that not all floating point formats define Inf (or NaN).
+ * For the infinity a large number may be used instead. Operations that
+ * under the IEEE floating point would return Inf or NaN may return
+ * either large numbers (positive or negative), or they may cause
+ * a floating point exception or some other fault.
+ */
+
+/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
+GCC_DIAG_IGNORE(-Wc++-compat)
+
+# ifdef USE_QUADMATH
+/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q };
+# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } };
+# elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } };
+# else
+# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+# if defined(LDBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY };
+# elif defined(LDBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INF };
+# elif defined(INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+# elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+# else
+INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */
+# endif
+# else
+# if defined(DBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY };
+# elif defined(DBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INF };
+# elif defined(INFINITY) /* C99 */
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+# elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+# else
+INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */
+# endif
+# endif
+# endif
+
+# ifdef USE_QUADMATH
+/* Cannot use nanq("0") for PL_nan because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q };
+# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } };
+# elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } };
+# else
+# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+# if defined(LDBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN };
+# elif defined(LDBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN };
+# elif defined(NAN)
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+# else
+INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */
+# endif
+# else
+# if defined(DBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_NAN };
+# elif defined(DBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN };
+# elif defined(NAN) /* C99 */
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+# else
+INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */
+# endif
+# endif
+# endif
+
+GCC_DIAG_RESTORE
+
+#else
+
+INFNAN_NV_U8_DECL PL_inf;
+INFNAN_NV_U8_DECL PL_nan;
+
+#endif
+
+/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h),
+ * we will define NV_INF/NV_NAN as the nv part of the global const
+ * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN
+ * might not be a compile-time constant, in which case it cannot be
+ * used to initialize PL_inf/PL_nan above. */
+#ifndef NV_INF
+# define NV_INF PL_inf.nv
+#endif
+#ifndef NV_NAN
+# define NV_NAN PL_nan.nv
#endif
/* NaNs (not-a-numbers) can carry payload bits, in addition to
# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
# define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */
# else
+/* For example the VAX formats should never
+ * get here because they do not have NaN. */
# error "Unexpected double format"
# endif
#endif
# error "Unexpected double format"
# endif
#endif
+
+#endif /* DOUBLE_HAS_NAN */
+
+
/*
(KEEP THIS LAST IN perl.h!)
https://perl5.git.perl.org / perl5.git / blobdiff