# 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
# 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
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 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 struct padnamelist PADNAMELIST;
-typedef SV PADNAME;
+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)
signal(SIGFPE, SIG_IGN); \
} STMT_END
#endif
+/* In IRIX the default for Flush to Zero bit is true,
+ * which means that results going below the minimum of normal
+ * floating points go to zero, instead of going denormal/subnormal.
+ * This is unlike almost any other system running Perl, so let's clear it.
+ * [perl #123767] IRIX64 blead (ddce084a) opbasic/arith.t failure, originally
+ * [perl #120426] small numbers shouldn't round to zero if they have extra floating digits
+ *
+ * XXX The flush-to-zero behaviour should be a Configure scan.
+ * To change the behaviour usually requires some system-specific
+ * incantation, though, like the below. */
+#ifdef __sgi
+# include <sys/fpu.h>
+# define PERL_SYS_FPU_INIT \
+ STMT_START { \
+ union fpc_csr csr; \
+ csr.fc_word = get_fpc_csr(); \
+ csr.fc_struct.flush = 0; \
+ set_fpc_csr(csr.fc_word); \
+ } STMT_END
+#endif
#ifndef PERL_SYS_FPU_INIT
# define PERL_SYS_FPU_INIT NOOP
#endif
#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
-#define PNf SVf
-#define PNfARG SVfARG
+#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 */
/* placeholder */
#endif
-#if defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)
+/* 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
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.
*/
# 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,
# if !defined(NV_NAN) && defined(LDBL_QNAN)
# define NV_NAN LDBL_QNAN
# endif
-# if !defined(NV_NAN) && defined(LDBL_SNAN)
-# define NV_NAN LDBL_SNAN
-# endif
#endif
#if !defined(NV_NAN) && defined(DBL_NAN)
# define NV_NAN (NV)DBL_NAN
#if !defined(NV_NAN) && defined(DBL_QNAN)
# define NV_NAN (NV)DBL_QNAN
#endif
-#if !defined(NV_NAN) && defined(DBL_SNAN)
-# define NV_NAN (NV)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
#endif
-#if !defined(NV_NAN) && defined(SNAN)
-# define NV_NAN (NV)SNAN
+#if !defined(NV_NAN) && defined(I_SUNMATH)
+# define NV_NAN (NV)quiet_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 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 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 */
+# ifdef USE_LOCALE_CTYPE
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
+ STMT_START { \
+ if (UNLIKELY(PL_warn_locale)) { \
+ _warn_problematic_locale(); \
+ } \
+ } STMT_END
+# else
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
+# endif
+
+
+ /* 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
#define RESTORE_NUMERIC_STANDARD() \
if (_was_standard) SET_NUMERIC_STANDARD();
-#define Atof my_atof
-
#else /* !USE_LOCALE_NUMERIC */
#define SET_NUMERIC_STANDARD() /**/
#define LOCK_NUMERIC_STANDARD()
#define UNLOCK_NUMERIC_STANDARD()
-#define Atof my_atof
-
#endif /* !USE_LOCALE_NUMERIC */
+#define Atof my_atof
+
#ifdef USE_QUADMATH
# define Perl_strtod(s, e) strtoflt128(s, e)
#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
/* 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 */
#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
+
/*
(KEEP THIS LAST IN perl.h!)
https://perl5.git.perl.org / perl5.git / blobdiff