# ifdef PERL_GLOBAL_STRUCT_PRIVATE
EXTERN_C struct perl_vars* Perl_GetVarsPrivate();
# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
-# ifndef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_CONST /* Can't have these lying around. */
-# endif
# else
# define PERL_GET_VARS() PL_VarsPtr
# endif
# endif
#endif
+/* this used to be off by default, now its on, see perlio.h */
+#define PERLIO_FUNCS_CONST
+
#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL
#ifdef PERL_GLOBAL_STRUCT
#endif
#ifndef PERL_UNUSED_DECL
-# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
+# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
# define PERL_UNUSED_DECL __attribute__unused__
# else
# define PERL_UNUSED_DECL
# 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
+ since by then MB_CUR_MAX will be defined from stdlib.h.
+ 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
+#endif
#ifdef I_STDARG
# include <stdarg.h>
#else
# 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
# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
#endif
-/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
- * This is important for using IPv6.
- * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
- * a bad idea since it breaks send() and recv(). */
-#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
-# define _SOCKADDR_LEN
-#endif
-
#if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */
# include <sys/socket.h>
# if defined(USE_SOCKS) && defined(I_SOCKS)
# define SS_IVCHAN SS$_IVCHAN
# define SS_NORMAL SS$_NORMAL
# define SS_NOPRIV SS$_NOPRIV
+# define SS_BUFFEROVF SS$_BUFFEROVF
#else
# define LIB_INVARG 0
# define RMS_DIR 0
# define SS_IVCHAN 0
# define SS_NORMAL 0
# define SS_NOPRIV 0
+# define SS_BUFFEROVF 0
#endif
#ifdef WIN32
#define ERRSV GvSVn(PL_errgv)
+/* contains inlined gv_add_by_type */
#define CLEAR_ERRSV() STMT_START { \
- if (!GvSV(PL_errgv)) { \
- sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), ""); \
- } else if (SvREADONLY(GvSV(PL_errgv))) { \
- SvREFCNT_dec(GvSV(PL_errgv)); \
- GvSV(PL_errgv) = newSVpvs(""); \
+ SV ** const svp = &GvSV(PL_errgv); \
+ if (!*svp) { \
+ goto clresv_newemptypv; \
+ } else if (SvREADONLY(*svp)) { \
+ SvREFCNT_dec_NN(*svp); \
+ clresv_newemptypv: \
+ *svp = newSVpvs(""); \
} else { \
- SV *const errsv = GvSV(PL_errgv); \
+ SV *const errsv = *svp; \
sv_setpvs(errsv, ""); \
+ SvPOK_only(errsv); \
if (SvMAGICAL(errsv)) { \
mg_free(errsv); \
} \
- SvPOK_only(errsv); \
} \
} STMT_END
#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */
#ifdef USE_LONG_DOUBLE
-# if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
-# define LONG_DOUBLE_EQUALS_DOUBLE
-# endif
-# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
-# undef USE_LONG_DOUBLE /* Ouch! */
+# if LONG_DOUBLESIZE == DOUBLESIZE
+# define LONG_DOUBLE_EQUALS_DOUBLE
+# undef USE_LONG_DOUBLE /* Ouch! */
# endif
#endif
# include <ieeefp.h>
#endif
+#ifdef USING_MSVC6
+/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false,
+ * and for example NaN < IV_MIN. */
+# define NAN_COMPARE_BROKEN
+#endif
+#if defined(__DECC) && defined(__osf__)
+/* Also Tru64 cc has broken NaN comparisons. */
+# define NAN_COMPARE_BROKEN
+#endif
+
#ifdef USE_LONG_DOUBLE
# ifdef I_SUNMATH
# include <sunmath.h>
# endif
-# if defined(USE_QUADMATH) && defined(I_QUADMATH)
-# include <quadmath.h>
-# endif
-# ifdef FLT128_DIG
-# define NV_DIG FLT128_DIG
-# define NV_MANT_DIG FLT128_MANT_DIG
-# define NV_MIN FLT128_MIN
-# define NV_MAX FLT128_MAX
-# define NV_MIN_EXP FLT128_MIN_EXP
-# define NV_MAX_EXP FLT128_MAX_EXP
-# define NV_EPSILON FLT128_EPSILON
-# define NV_MIN_10_EXP FLT128_MIN_10_EXP
-# define NV_MAX_10_EXP FLT128_MAX_10_EXP
-# define NV_INF HUGE_VALQ
-# define NV_NAN nanq("0")
-# elif defined(LDBL_DIG)
+# if defined(LDBL_DIG)
# define NV_DIG LDBL_DIG
# ifdef LDBL_MANT_DIG
# define NV_MANT_DIG LDBL_MANT_DIG
# endif
# endif
# endif
-# if defined(USE_QUADMATH) && defined(I_QUADMATH)
-# define Perl_acos acosq
-# define Perl_asin asinq
-# define Perl_atan atanq
-# define Perl_atan2 atan2q
-# define Perl_ceil ceilq
-# define Perl_cos cosq
-# define Perl_cosh coshq
-# define Perl_exp expq
-/* no Perl_fabs, but there's PERL_ABS */
-# define Perl_floor floorq
-# define Perl_fmod fmodq
-# define Perl_log logq
-# define Perl_log10 log10q
-# define Perl_pow powq
-# define Perl_sin sinq
-# define Perl_sinh sinhq
-# define Perl_sqrt sqrtq
-# define Perl_tan tanq
-# define Perl_tanh tanhq
-# define Perl_modf(x,y) modfq(x,y)
-# define Perl_frexp(x,y) frexpq(x,y)
-# define Perl_ldexp(x, y) ldexpq(x,y)
-# define Perl_isinf(x) isinfq(x)
-# define Perl_isnan(x) isnanq(x)
-# define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
-# elif defined(HAS_SQRTL)
+# if defined(HAS_SQRTL)
# define Perl_acos acosl
# define Perl_asin asinl
# define Perl_atan atanl
# ifndef Perl_isinf
# if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99))
# define Perl_isinf(x) isinfl(x)
-# elif defined(LDBL_MAX)
+# elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN)
# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX)
# endif
# endif
# ifndef Perl_isfinite
# define Perl_isfinite(x) Perl_isfinitel(x)
# endif
+#elif defined(USE_QUADMATH) && defined(I_QUADMATH)
+# include <quadmath.h>
+# define NV_DIG FLT128_DIG
+# define NV_MANT_DIG FLT128_MANT_DIG
+# define NV_MIN FLT128_MIN
+# define NV_MAX FLT128_MAX
+# define NV_MIN_EXP FLT128_MIN_EXP
+# define NV_MAX_EXP FLT128_MAX_EXP
+# define NV_EPSILON FLT128_EPSILON
+# define NV_MIN_10_EXP FLT128_MIN_10_EXP
+# define NV_MAX_10_EXP FLT128_MAX_10_EXP
+# define NV_INF HUGE_VALQ
+# define NV_NAN nanq("0")
+# define Perl_acos acosq
+# define Perl_asin asinq
+# define Perl_atan atanq
+# define Perl_atan2 atan2q
+# define Perl_ceil ceilq
+# define Perl_cos cosq
+# define Perl_cosh coshq
+# define Perl_exp expq
+/* no Perl_fabs, but there's PERL_ABS */
+# define Perl_floor floorq
+# define Perl_fmod fmodq
+# define Perl_log logq
+# define Perl_log10 log10q
+# define Perl_pow powq
+# define Perl_sin sinq
+# define Perl_sinh sinhq
+# define Perl_sqrt sqrtq
+# define Perl_tan tanq
+# define Perl_tanh tanhq
+# define Perl_modf(x,y) modfq(x,y)
+# define Perl_frexp(x,y) frexpq(x,y)
+# define Perl_ldexp(x, y) ldexpq(x,y)
+# define Perl_isinf(x) isinfq(x)
+# define Perl_isnan(x) isnanq(x)
+# define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
#else
# define NV_DIG DBL_DIG
# ifdef DBL_MANT_DIG
# ifndef Perl_isinf
# if defined(HAS_ISINF)
# define Perl_isinf(x) isinf(x)
-# elif defined(DBL_MAX)
+# elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN)
# define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX)
# endif
# endif
typedef struct op OP;
typedef struct cop COP;
typedef struct unop UNOP;
+typedef struct unop_aux UNOP_AUX;
typedef struct binop BINOP;
typedef struct listop LISTOP;
typedef struct logop LOGOP;
typedef struct padop PADOP;
typedef struct pvop PVOP;
typedef struct loop LOOP;
+typedef struct methop METHOP;
#ifdef PERL_CORE
typedef struct opslab OPSLAB;
typedef struct ptr_tbl PTR_TBL_t;
typedef struct clone_params CLONE_PARAMS;
-/* a pad or name pad is currently just an AV; but that might change,
+/* a pad is currently just an AV; but that might change,
* so hide the type. */
typedef struct padlist PADLIST;
typedef AV PAD;
-typedef AV PADNAMELIST;
-typedef SV PADNAME;
+typedef struct padnamelist PADNAMELIST;
+typedef struct padname PADNAME;
/* enable PERL_NEW_COPY_ON_WRITE by default */
#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
#endif
#include "handy.h"
+#include "charclass_invlists.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
# define PERL_FPU_POST_EXEC }
#endif
+/* In Tru64 the cc -ieee enables the IEEE math but disables traps.
+ * We need to reenable the "invalid" trap because otherwise generation
+ * of NaN values leaves the IEEE fp flags in bad state, leaving any further
+ * fp ops behaving strangely (Inf + 1 resulting in zero, for example). */
+#ifdef __osf__
+# include <machine/fpu.h>
+# define PERL_SYS_FPU_INIT \
+ STMT_START { \
+ ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \
+ signal(SIGFPE, SIG_IGN); \
+ } STMT_END
+#endif
+
+#ifndef PERL_SYS_FPU_INIT
+# define PERL_SYS_FPU_INIT NOOP
+#endif
+
#ifndef PERL_SYS_INIT3_BODY
# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
#endif
#if defined(WIN32)
# include "win32.h"
-# ifdef NAN_COMPARE_BROKEN /* VC6 */
-/* We need to redefine Perl_isinf() because we most likely defined it
- * using the <DBL_MIN || >DBL_MAX way, which is broken if the NaN
- * compare is broken. */
-# undef Perl_isinf
-# define Perl_isinf(x) Perl_fp_class_inf(x)
-# endif
#endif
#ifdef NETWARE
#endif
#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
+#define PNf UTF8f
+#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn)
+
#ifdef PERL_CORE
/* not used; but needed for backward compatibility with XS code? - RMB */
# undef UVf
# define __attribute__warn_unused_result__
#endif
-#if defined(DEBUGGING) && defined(I_ASSERT)
+#ifdef I_ASSERT
+# if !defined(DEBUGGING) && !defined(NDEBUG)
+# define NDEBUG 1
+# endif
# include <assert.h>
#endif
/* placeholder */
#endif
+/* STATIC_ASSERT_GLOBAL/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
+ 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.
+*/
+/* IBM XL C V11 does not support _Static_assert, no matter what <assert.h> says */
+# define STATIC_ASSERT_GLOBAL(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.
+ We want to enforce constantness.
+*/
+# define STATIC_ASSERT_2(COND, SUFFIX) \
+ typedef struct { \
+ 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__)
+#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)
#ifndef __has_builtin
# define __has_builtin(x) 0 /* not a clang style compiler */
expression, which allows the compiler to generate better machine code.
In a debug build, ASSUME(x) is a synonym for assert(x). ASSUME(0) means
the control path is unreachable. In a for loop, ASSUME can be used to hint
- that a loop will run atleast X times. ASSUME is based off MSVC's __assume
+ that a loop will run at least X times. ASSUME is based off MSVC's __assume
intrinsic function, see its documents for more details.
*/
#ifndef DEBUGGING
# if __has_builtin(__builtin_unreachable) \
- || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 5) /* 4.5 -> */
+ || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4) /* 4.5 -> */
# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
# elif defined(_MSC_VER)
# define ASSUME(x) __assume(x)
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
# define PERL_DEB(a) a
+# define PERL_DEB2(a,b) a
# define PERL_DEBUG(a) if (PL_debug) a
# define DEBUG_p(a) if (DEBUG_p_TEST) a
# define DEBUG_s(a) if (DEBUG_s_TEST) a
# define DEBUG_Pv_TEST (0)
# define PERL_DEB(a)
+# define PERL_DEB2(a,b) b
# define PERL_DEBUG(a)
# define DEBUG_p(a)
# define DEBUG_s(a)
/* Keep the old croak based assert for those who want it, and as a fallback if
the platform is so heretically non-ANSI that it can't assert. */
-#define Perl_assert(what) PERL_DEB( \
+#define Perl_assert(what) PERL_DEB2( \
((what) ? ((void) 0) : \
(Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
"\", line %d", STRINGIFY(what), __LINE__), \
- (void) 0)))
+ (void) 0)), ((void)0))
/* assert() gets defined if DEBUGGING (and I_ASSERT).
* If no DEBUGGING, the <assert.h> has not been included. */
END_EXTERN_C
#endif
-#ifdef WIN32
-# if !defined(NV_INF) && defined(HUGE_VAL)
-# define NV_INF HUGE_VAL
-# endif
-/* For WIN32 the best NV_NAN is the __PL_nan_u trick, see below.
- * There is no supported way of getting the NAN across all the crts. */
-#endif
-
/* 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,
# endif
# if !defined(NV_NAN) && defined(LDBL_QNAN)
# define NV_NAN LDBL_QNAN
+# define NV_QNAN LDBL_QNAN
# endif
# if !defined(NV_NAN) && defined(LDBL_SNAN)
# define NV_NAN LDBL_SNAN
+# define NV_SNAN LDBL_SNAN
# endif
#endif
#if !defined(NV_NAN) && defined(DBL_NAN)
#endif
#if !defined(NV_NAN) && defined(DBL_QNAN)
# define NV_NAN (NV)DBL_QNAN
+# define NV_QNAN DBL_QNAN
#endif
#if !defined(NV_NAN) && defined(DBL_SNAN)
# define NV_NAN (NV)DBL_SNAN
+# define NV_SNAN DBL_SNAN
#endif
#if !defined(NV_NAN) && defined(NAN)
# define NV_NAN (NV)NAN
#endif
#if !defined(NV_NAN) && defined(QNAN)
# define NV_NAN (NV)QNAN
+# define NV_QNAN QNAN
#endif
#if !defined(NV_NAN) && defined(SNAN)
# define NV_NAN (NV)SNAN
+# define NV_SNAN SNAN
+#endif
+#if !defined(NV_NAN) && defined(I_SUNMATH)
+# define NV_NAN (NV)quiet_nan()
+# define NV_QNAN (NV)quiet_nan()
+# define NV_SNAN (NV)signaling_nan()
#endif
#if !defined(NV_NAN)
# if INTSIZE == 4
INIT("Unsuccessful %s on filename containing newline");
EXTCONST char PL_no_wrongref[]
INIT("Can't use %s ref as %s ref");
-/* The core no longer needs these here. If you require the string constant,
+/* The core no longer needs this here. If you require the string constant,
please inline a copy into your own code. */
EXTCONST char PL_no_symref[] __attribute__deprecated__
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXTCONST char PL_no_symref_sv[] __attribute__deprecated__
- INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
+EXTCONST char PL_no_symref_sv[]
+ INIT("Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use");
+
EXTCONST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
EXTCONST char PL_no_aelem[]
EXTCONST char PL_no_func[]
INIT("The %s function is unimplemented");
EXTCONST char PL_no_myglob[]
- INIT("\"%s\" variable %s can't be in a package");
+ INIT("\"%s\" %se %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
EXTCONST char PL_memory_wrap[]
#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */
- /* Note: Used for NATIVE_HINTS, currently
- defined by vms/vmsish.h:
+ /* Note: Used for HINT_M_VMSISH_*,
+ currently defined by vms/vmsish.h:
0x40000000
0x80000000
*/
(SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
#endif
+/* Used for debugvar magic */
+#define DBVARMG_SINGLE 0
+#define DBVARMG_TRACE 1
+#define DBVARMG_SIGNAL 2
+#define DBVARMG_COUNT 3
+
+#define PL_DBsingle_iv (PL_DBcontrol[DBVARMG_SINGLE])
+#define PL_DBtrace_iv (PL_DBcontrol[DBVARMG_TRACE])
+#define PL_DBsignal_iv (PL_DBcontrol[DBVARMG_SIGNAL])
+
/* Various states of the input record separator SV (rs) */
#define RsSNARF(sv) (! SvOK(sv))
#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
#undef PERLVARI
#undef PERLVARIC
+#if !defined(MULTIPLICITY)
+/* Set up PERLVAR macros for populating structs */
+# define PERLVAR(prefix,var,type) type prefix##var;
+/* 'var' is an array of length 'n' */
+# define PERLVARA(prefix,var,n,type) type prefix##var[n];
+/* initialize 'var' to init' */
+# define PERLVARI(prefix,var,type,init) type prefix##var;
+/* like PERLVARI, but make 'var' a const */
+# define PERLVARIC(prefix,var,type,init) type prefix##var;
+
+/* this is never instantiated, is it just used for sizeof(struct PerlHandShakeInterpreter) */
+struct PerlHandShakeInterpreter {
+# include "intrpvar.h"
+};
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
+#endif
+
START_EXTERN_C
/* dummy variables that hold pointers to both runops functions, thus forcing
EXTCONST runops_proc_t PL_runops_dbg
INIT(Perl_runops_debug);
-/* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the
- * magic vtables const, but this is incompatible with SWIG which
- * does want to modify the vtables. */
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-# define EXT_MGVTBL EXTCONST MGVTBL
-#else
-# define EXT_MGVTBL EXT MGVTBL
-#endif
+#define EXT_MGVTBL EXTCONST MGVTBL
#define PERL_MAGIC_READONLY_ACCEPTABLE 0x40
#define PERL_MAGIC_VALUE_MAGIC 0x80
#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subroutines */
#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */
-#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
-#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
-#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
-#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER))
-#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
-#define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
-#define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
-#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO))
-#define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
-#define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-#define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
-#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
-#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
+#define PERLDB_SUB (PL_perldb & PERLDBf_SUB)
+#define PERLDB_LINE (PL_perldb & PERLDBf_LINE)
+#define PERLDB_NOOPT (PL_perldb & PERLDBf_NOOPT)
+#define PERLDB_INTER (PL_perldb & PERLDBf_INTER)
+#define PERLDB_SUBLINE (PL_perldb & PERLDBf_SUBLINE)
+#define PERLDB_SINGLE (PL_perldb & PERLDBf_SINGLE)
+#define PERLDB_SUB_NN (PL_perldb & PERLDBf_NONAME)
+#define PERLDB_GOTO (PL_perldb & PERLDBf_GOTO)
+#define PERLDB_NAMEEVAL (PL_perldb & PERLDBf_NAMEEVAL)
+#define PERLDB_NAMEANON (PL_perldb & PERLDBf_NAMEANON)
+#define PERLDB_SAVESRC (PL_perldb & PERLDBf_SAVESRC)
+#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS)
+#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID)
#ifdef USE_LOCALE
/* These locale things are all subject to change */
# define IN_LC(category) \
(IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
+# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)
+
+ /* This internal macro should be called from places that operate under
+ * locale rules. It there is a problem with the current locale that
+ * hasn't been raised yet, it will output a warning this time. Because
+ * this will so rarely be true, there is no point to optimize for
+ * time; instead it makes sense to minimize space used and do all the
+ * work in the rarely called function */
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
+ STMT_START { \
+ if (UNLIKELY(PL_warn_locale)) { \
+ _warn_problematic_locale(); \
+ } \
+ } STMT_END
+
+
+ /* These two internal macros are called when a warning should be raised,
+ * and will do so if enabled. The first takes a single code point
+ * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded
+ * string, and an end position which it won't try to read past */
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \
+ Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%"UVXf") in %s", (UV) cp, OP_DESC(PL_op));
+
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \
+ STMT_START { /* Check if to warn before doing the conversion work */\
+ if (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", \
+ (cp == 0) \
+ ? UNICODE_REPLACEMENT \
+ : (UV) cp, \
+ OP_DESC(PL_op)); \
+ } \
+ } STMT_END
+
+# endif /* PERL_CORE or PERL_IN_XSUB_RE */
+
#else /* No locale usage */
# define IN_LOCALE_RUNTIME 0
# define IN_SOME_LOCALE_FORM_RUNTIME 0
# define IN_LC_COMPILETIME(category) 0
# define IN_LC_RUNTIME(category) 0
# define IN_LC(category) 0
+
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(a)
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(a,b)
#endif
#ifdef USE_LOCALE_NUMERIC
/* Clones the per-interpreter data. */
# define MY_CXT_CLONE \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\
- PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \
+ void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \
+ PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \
+ Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t);
+
/* This macro must be used to access members of the my_cxt_t structure.
int). value returned in pointed-
to UV */
#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
-#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */
+#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation or infnan */
#define IS_NUMBER_NEG 0x08 /* leading minus sign */
#define IS_NUMBER_INFINITY 0x10 /* this is big */
#define IS_NUMBER_NAN 0x20 /* this is not */
* passed straight through to _escape.
*/
-#define PERL_PV_ESCAPE_QUOTE 0x0001
+#define PERL_PV_ESCAPE_QUOTE 0x000001
#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-#define PERL_PV_PRETTY_ELLIPSES 0x0002
-#define PERL_PV_PRETTY_LTGT 0x0004
-
-#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+#define PERL_PV_PRETTY_ELLIPSES 0x000002
+#define PERL_PV_PRETTY_LTGT 0x000004
+#define PERL_PV_PRETTY_EXACTSIZE 0x000008
-#define PERL_PV_ESCAPE_UNI 0x0100
-#define PERL_PV_ESCAPE_UNI_DETECT 0x0200
-#define PERL_PV_ESCAPE_NONASCII 0x0400
+#define PERL_PV_ESCAPE_UNI 0x000100
+#define PERL_PV_ESCAPE_UNI_DETECT 0x000200
+#define PERL_PV_ESCAPE_NONASCII 0x000400
+#define PERL_PV_ESCAPE_FIRSTCHAR 0x000800
-#define PERL_PV_ESCAPE_ALL 0x1000
-#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
-#define PERL_PV_ESCAPE_NOCLEAR 0x4000
-#define PERL_PV_ESCAPE_RE 0x8000
+#define PERL_PV_ESCAPE_ALL 0x001000
+#define PERL_PV_ESCAPE_NOBACKSLASH 0x002000
+#define PERL_PV_ESCAPE_NOCLEAR 0x004000
+#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+#define PERL_PV_ESCAPE_RE 0x008000
-#define PERL_PV_ESCAPE_DWIM 0x10000
+#define PERL_PV_ESCAPE_DWIM 0x010000
-#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
/* used by pv_display in dump.c*/
#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_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_LITTLE_ENDIAN
+#endif
+
+#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define DOUBLE_BIG_ENDIAN
+#endif
+
+#if DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
+# define DOUBLE_MIX_ENDIAN
+#endif
+
+/* All the basic IEEE formats have the implicit bit,
+ * except for the 80-bit extended formats, which will undef this. */
+#define NV_IMPLICIT_BIT
+
+#ifdef LONG_DOUBLEKIND
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+# define LONGDOUBLE_LITTLE_ENDIAN
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+# define LONGDOUBLE_BIG_ENDIAN
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+# define LONGDOUBLE_X86_80_BIT
+# ifdef USE_LONG_DOUBLE
+# undef NV_IMPLICIT_BIT
+# endif
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+# define LONGDOUBLE_DOUBLEDOUBLE
+# endif
+
+#endif /* LONG_DOUBLEKIND */
+
+#if NVSIZE == DOUBLESIZE
+# ifdef DOUBLE_LITTLE_ENDIAN
+# define NV_LITTLE_ENDIAN
+# endif
+# ifdef DOUBLE_BIG_ENDIAN
+# define NV_BIG_ENDIAN
+# endif
+# ifdef DOUBLE_MIX_ENDIAN
+# define NV_MIX_ENDIAN
+# endif
+#elif NVSIZE == LONG_DOUBLESIZE
+# ifdef LONGDOUBLE_LITTLE_ENDIAN
+# define NV_LITTLE_ENDIAN
+# endif
+# ifdef LONGDOUBLE_BIG_ENDIAN
+# define NV_BIG_ENDIAN
+# endif
+#endif
+
+/* The implicit bit platforms include the implicit bit
+ * in the NV_MANT_DIG. The bit isn't really there, however,
+ * so the real count of mantissa bits is one less. */
+#ifdef NV_IMPLICIT_BIT
+# define NV_MANT_REAL_DIG (NV_MANT_DIG - 1)
+#else
+# define NV_MANT_REAL_DIG (NV_MANT_DIG)
+#endif
+
/*
(KEEP THIS LAST IN perl.h!)
https://perl5.git.perl.org / perl5.git / blobdiff