X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a21eb52b1988ec2828792ad77f68a17dda3e6feb..b69687e78b78ef51f5520c3e8f5eb4c151a89eae:/perl.h diff --git a/perl.h b/perl.h index e6e1320..bcfeee9 100644 --- a/perl.h +++ b/perl.h @@ -140,15 +140,15 @@ # 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 @@ -231,7 +231,7 @@ Perl_pregfree(aTHX_ (prog)) #define CALLREGFREE_PVT(prog) \ - if(prog) RX_ENGINE(prog)->free(aTHX_ (prog)) + if(prog) RX_ENGINE(prog)->rxfree(aTHX_ (prog)) #define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv)) @@ -309,7 +309,7 @@ #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 @@ -496,26 +496,6 @@ # endif #endif -/* Some platforms require marking function declarations - * for them to be exportable. Used in perlio.h, proto.h - * is handled either by the makedef.pl or by defining the - * PERL_CALLCONV to be something special. See also the - * definition of XS() in XSUB.h. */ -#ifndef PERL_EXPORT_C -# ifdef __cplusplus -# define PERL_EXPORT_C extern "C" -# else -# define PERL_EXPORT_C extern -# endif -#endif -#ifndef PERL_XS_EXPORT_C -# ifdef __cplusplus -# define PERL_XS_EXPORT_C extern "C" -# else -# define PERL_XS_EXPORT_C -# endif -#endif - #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) # ifndef PERL_USE_GCC_BRACE_GROUPS # define PERL_USE_GCC_BRACE_GROUPS @@ -704,6 +684,15 @@ # 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 #else @@ -758,6 +747,10 @@ # 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 #ifdef I_SYS_PARAM @@ -1128,14 +1121,6 @@ EXTERN_C int usleep(unsigned int); # 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 # if defined(USE_SOCKS) && defined(I_SOCKS) @@ -1221,6 +1206,7 @@ EXTERN_C char *crypt(const char *, const char *); # 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 @@ -1235,6 +1221,7 @@ EXTERN_C char *crypt(const char *, const char *); # define SS_IVCHAN 0 # define SS_NORMAL 0 # define SS_NOPRIV 0 +# define SS_BUFFEROVF 0 #endif #ifdef WIN32 @@ -1264,19 +1251,22 @@ EXTERN_C char *crypt(const char *, const char *); #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 @@ -1760,11 +1750,9 @@ typedef UVTYPE UV; #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 @@ -1871,22 +1859,7 @@ typedef NVTYPE NV; # ifdef I_SUNMATH # include # endif -# if defined(USE_QUADMATH) && defined(I_QUADMATH) -# include -# 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 @@ -1921,33 +1894,7 @@ typedef NVTYPE NV; # 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 @@ -2016,6 +1963,42 @@ extern long double Perl_my_frexpl(long double x, int *e); # ifndef Perl_isfinite # define Perl_isfinite(x) Perl_isfinitel(x) # endif +#elif defined(USE_QUADMATH) && defined(I_QUADMATH) +# include +# 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 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 @@ -2594,6 +2577,7 @@ typedef MEM_SIZE STRLEN; 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; @@ -2652,24 +2636,20 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t; 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) -# define PERL_NEW_COPY_ON_WRITE +/* enable PERL_COPY_ON_WRITE by default */ +#if !defined(PERL_COPY_ON_WRITE) && !defined(PERL_NO_COW) +# define PERL_COPY_ON_WRITE #endif -#if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE) -# if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE) -# error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive -# else +#ifdef PERL_COPY_ON_WRITE # define PERL_ANY_COW -# endif #else # define PERL_SAWAMPERSAND #endif @@ -2679,6 +2659,7 @@ typedef SV PADNAME; #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) @@ -2911,6 +2892,26 @@ typedef SV PADNAME; 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 +# 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 @@ -3407,6 +3408,9 @@ typedef pthread_key_t perl_key; #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 @@ -3467,7 +3471,10 @@ typedef pthread_key_t perl_key; # 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 #endif @@ -3475,9 +3482,9 @@ typedef pthread_key_t perl_key; appropriate to call return. In either case, include the lint directive. */ #ifdef HASATTRIBUTE_NORETURN -# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ +# define NORETURN_FUNCTION_END NOT_REACHED; #else -# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ return 0 +# define NORETURN_FUNCTION_END NOT_REACHED; return 0 #endif /* Some OS warn on NULL format to printf */ @@ -3498,6 +3505,40 @@ typedef pthread_key_t perl_key; /* 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 in C11 or a compiler + builtin in C++11. +*/ +/* IBM XL C V11 does not support _Static_assert, no matter what 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 */ @@ -3508,13 +3549,13 @@ typedef pthread_key_t perl_key; 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) @@ -3617,6 +3658,30 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #endif /* threading */ #endif /* AIX */ +#ifndef PERL_CALLCONV +# ifdef __cplusplus +# define PERL_CALLCONV extern "C" +# else +# define PERL_CALLCONV +# endif +#endif +#ifndef PERL_CALLCONV_NO_RET +# define PERL_CALLCONV_NO_RET PERL_CALLCONV +#endif + +/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that + dont have a noreturn as a declaration specifier +*/ +#ifndef PERL_STATIC_NO_RET +# define PERL_STATIC_NO_RET STATIC +#endif +/* PERL_STATIC_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE on + builds that dont have a noreturn as a declaration specifier +*/ +#ifndef PERL_STATIC_INLINE_NO_RET +# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE +#endif + #if !defined(OS2) # include "iperlsys.h" #endif @@ -3940,8 +4005,7 @@ Gid_t getegid (void); #define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 -#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal - that something was done? */ +#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) @@ -4008,6 +4072,7 @@ Gid_t getegid (void); # 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 @@ -4090,6 +4155,7 @@ Gid_t getegid (void); # 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) @@ -4132,11 +4198,11 @@ Gid_t getegid (void); /* 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 has not been included. */ @@ -4221,112 +4287,6 @@ START_EXTERN_C 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 - * 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. */ - -#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) -# if !defined(NV_INF) && defined(LDBL_INFINITY) -# define NV_INF LDBL_INFINITY -# endif -# if !defined(NV_INF) && defined(INFINITYL) -# define NV_INF INFINITYL -# endif -#endif -#if !defined(NV_INF) && defined(DBL_INFINITY) -# define NV_INF (NV)DBL_INFINITY -#endif -#if !defined(NV_INF) && defined(INFINITY) -# define NV_INF (NV)INFINITY -#endif -#if !defined(NV_INF) && defined(INF) -# define NV_INF (NV)INF -#endif -#if !defined(NV_INF) -# if INTSIZE == 4 -/* At this point we assume the IEEE 754 floating point (and of course, - * we also assume a floating point format that can encode an infinity). - * We will coerce an int32 (which will encode the infinity) into - * a 32-bit float, which will then be cast into NV. - * - * Note that we intentionally use a float and 32-bit int, instead of - * shifting a small integer into a full IV, and from that into a full - * NV, because: - * - * (1) an IV might not be wide enough to cover all the bits of an NV. - * (2) the exponent part (including the infinity and nan bits) of a NV - * might be wider than just 16 bits. - * - * Below the NV_NAN logic has similar __PL_nan_u fallback, the only - * difference being the int32 constant being coerced. */ -# define __PL_inf_float_int32 0x7F800000 -static const union { unsigned int __i; float __f; } __PL_inf_u = - { __PL_inf_float_int32 }; -# define NV_INF ((NV)(__PL_inf_u.__f)) -# endif -#endif -#if !defined(NV_INF) -# define NV_INF ((NV)1.0/0.0) /* Some compilers will warn. */ -#endif - -#if !defined(NV_NAN) && defined(USE_LONG_DOUBLE) -# if !defined(NV_NAN) && defined(LDBL_NAN) -# define NV_NAN LDBL_NAN -# endif -# if !defined(NV_NAN) && defined(NANL) -# define NV_NAN NANL -# endif -# 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 -#endif -#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 -#endif -#if !defined(NV_NAN) -# if INTSIZE == 4 -/* See the discussion near __PL_inf_u. */ -# define __PL_nan_float_int32 0x7FC00000 -static const union { unsigned int __i; float __f; } __PL_nan_u = - { __PL_nan_float_int32 }; -# define NV_NAN ((NV)(__PL_nan_u.__f)) -# endif -#endif -#if !defined(NV_NAN) -# define NV_NAN ((NV)0.0/0.0) /* Some compilers will warn. */ -#endif -/* Do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF). - * Though IEEE-754-logically correct, some compilers (like Visual C 2003) - * falsely misoptimize that to zero (x-x is zero, right?) */ - #ifndef __cplusplus # if !defined(WIN32) && !defined(VMS) #ifndef crypt @@ -4575,12 +4535,13 @@ EXTCONST char PL_warn_nl[] 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[] @@ -5031,9 +4992,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_NEED_TIMESBASE " PERL_NEED_TIMESBASE" # endif -# ifdef PERL_OLD_COPY_ON_WRITE - " PERL_OLD_COPY_ON_WRITE" -# endif # ifdef PERL_POISON " PERL_POISON" # endif @@ -5225,8 +5183,8 @@ typedef enum { #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 */ @@ -5248,6 +5206,16 @@ typedef enum { (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))) @@ -5403,31 +5371,6 @@ struct tempsym; /* defined in pp_pack.c */ #include "thread.h" #include "pp.h" -#ifndef PERL_CALLCONV -# ifdef __cplusplus -# define PERL_CALLCONV extern "C" -# else -# define PERL_CALLCONV -# endif -#endif -#ifndef PERL_CALLCONV_NO_RET -# define PERL_CALLCONV_NO_RET PERL_CALLCONV -#endif - -/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that - dont have a noreturn as a declaration specifier -*/ -#ifndef PERL_STATIC_NO_RET -# define PERL_STATIC_NO_RET STATIC -#endif -/* PERL_STATIC_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE on - builds that dont have a noreturn as a declaration specifier -*/ -#ifndef PERL_STATIC_INLINE_NO_RET -# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE -#endif - - #undef PERL_CKDEF #undef PERL_PPDEF #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); @@ -5437,6 +5380,14 @@ struct tempsym; /* defined in pp_pack.c */ # include "malloc_ctl.h" #endif +/* + * This provides a layer of functions and macros to ensure extensions will + * get to use the same RTL functions as the core. + */ +#if defined(WIN32) +# include "win32iop.h" +#endif + #include "proto.h" /* this has structure inits, so it cannot be included before here */ @@ -5487,6 +5438,26 @@ END_EXTERN_C #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 @@ -5497,14 +5468,7 @@ EXTCONST runops_proc_t PL_runops_std 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 @@ -5554,6 +5518,123 @@ EXTCONST bool PL_valid_types_NV_set[]; #endif +/* In C99 we could use designated (named field) union initializers. + * In C89 we need to initialize the member declared first. + * + * 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 + * 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 + +#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 /* if these never got defined, they need defaults */ #ifndef PERL_SET_CONTEXT @@ -5672,19 +5753,19 @@ typedef struct am_table_short AMTS; #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 */ @@ -5722,6 +5803,54 @@ typedef struct am_table_short AMTS; # 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) \ + 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)); \ + } \ + } STMT_END + +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \ + STMT_START { /* Check if to warn before doing the conversion work */\ + 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", \ + (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 @@ -5736,52 +5865,136 @@ typedef struct am_table_short AMTS; # 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 -/* These macros are for toggling between the underlying locale (LOCAL) and the - * C locale. */ +/* These macros are for toggling between the underlying locale (UNDERLYING or + * LOCAL) and the C locale (STANDARD). + +=head1 Locale-related functions and macros + +=for apidoc Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION + +This macro should be used as a statement. It declares a private variable +(whose name begins with an underscore) that is needed by the other macros in +this section. Failing to include this correctly should lead to a syntax error. +For compatibility with C89 C compilers it should be placed in a block before +any executable statements. + +=for apidoc Am|void|STORE_LC_NUMERIC_FORCE_TO_UNDERLYING + +This is used by XS code that that is C locale-aware to force the +locale for category C to be what perl thinks is the current +underlying locale. (The perl interpreter could be wrong about what the +underlying locale actually is if some C or XS code has called the C library +function L behind its back; calling L before calling +this macro will update perl's records.) + +A call to L must have been made to +declare at compile time a private variable used by this macro. This macro +should be called as a single statement, not an expression, but with an empty +argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); + ... + RESTORE_LC_NUMERIC(); + ... + } + +The private variable is used to save the current locale state, so +that the requisite matching call to L can restore it. + +=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED + +This is used to help wrap XS or C code that that is C locale-aware. +This locale category is generally kept set to the C locale by Perl for +backwards compatibility, and because most XS code that reads floating point +values can cope only with the decimal radix character being a dot. + +This macro makes sure the current C state is set properly, to be +aware of locale if the call to the XS or C code from the Perl program is +from within the scope of a S>; or to ignore locale if the call is +instead from outside such scope. + +This macro is the start of wrapping the C or XS code; the wrap ending is done +by calling the L macro after the operation. Otherwise +the state can be changed that will adversely affect other XS code. + +A call to L must have been made to +declare at compile time a private variable used by this macro. This macro +should be called as a single statement, not an expression, but with an empty +argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + STORE_LC_NUMERIC_SET_TO_NEEDED(); + ... + RESTORE_LC_NUMERIC(); + ... + } + +=for apidoc Am|void|RESTORE_LC_NUMERIC + +This is used in conjunction with one of the macros +L +and +L + +to properly restore the C state. -/* The first set makes sure that the locale is set to C unless within a 'use - * locale's scope; otherwise to the default locale. A function pointer is - * used, which can be declared separately by - * DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED, followed by the actual - * setting (using STORE_LC_NUMERIC_SET_TO_NEEDED()), or the two can be combined - * into one call DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(). - * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before - * these were called */ +A call to L must have been made to +declare at compile time a private variable used by this macro and the two +C ones. This macro should be called as a single statement, not an +expression, but with an empty argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + RESTORE_LC_NUMERIC(); + ... + } + +=cut + +*/ #define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard) /* We can lock the category to stay in the C locale, making requests to the - * contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */ -#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2) - -#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \ - void (*_restore_LC_NUMERIC_function)(pTHX) = NULL; - -#define STORE_LC_NUMERIC_SET_TO_NEEDED() \ - if (IN_LC(LC_NUMERIC)) { \ - if (_NOT_IN_NUMERIC_LOCAL) { \ - set_numeric_local(); \ - _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; \ - } \ + * 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 DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ + void (*_restore_LC_NUMERIC_function)(pTHX) = NULL + +#define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + if (IN_LC(LC_NUMERIC)) { \ + if (_NOT_IN_NUMERIC_UNDERLYING) { \ + set_numeric_local(); \ + _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; \ + } \ } -#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \ - DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \ - STORE_LC_NUMERIC_SET_TO_NEEDED(); - -#define RESTORE_LC_NUMERIC() \ - if (_restore_LC_NUMERIC_function) { \ - _restore_LC_NUMERIC_function(aTHX); \ +#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 @@ -5790,66 +6003,87 @@ typedef struct am_table_short AMTS; STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \ } STMT_END -#define SET_NUMERIC_LOCAL() \ - STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \ +#define SET_NUMERIC_UNDERLYING() \ + STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \ set_numeric_local(); } 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_NUMERIC_LOCAL_SET_STANDARD() \ - bool _was_local = _NOT_IN_NUMERIC_STANDARD; \ +#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \ + bool _was_local = _NOT_IN_NUMERIC_STANDARD; \ if (_was_local) set_numeric_standard(); /* Doesn't change to underlying locale unless within the scope of some form of * 'use locale'. This is the usual desired behavior. */ -#define STORE_NUMERIC_STANDARD_SET_LOCAL() \ - bool _was_standard = _NOT_IN_NUMERIC_LOCAL \ - && IN_LC(LC_NUMERIC); \ +#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \ + bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \ + && IN_LC(LC_NUMERIC); \ if (_was_standard) set_numeric_local(); /* Rarely, we want to change to the underlying locale even outside of 'use * locale'. This is principally in the POSIX:: functions */ -#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \ - bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \ - if (_was_standard) set_numeric_local(); +#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \ + if (_NOT_IN_NUMERIC_UNDERLYING) { \ + set_numeric_local(); \ + _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ + } /* Lock to the C locale until unlock is called */ -#define LOCK_NUMERIC_STANDARD() \ - (__ASSERT_(PL_numeric_standard) \ +#define LOCK_LC_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard) \ PL_numeric_standard = 2) -#define UNLOCK_NUMERIC_STANDARD() \ - (__ASSERT_(PL_numeric_standard == 2) \ +#define UNLOCK_LC_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard == 2) \ PL_numeric_standard = 1) -#define RESTORE_NUMERIC_LOCAL() \ +#define RESTORE_LC_NUMERIC_UNDERLYING() \ if (_was_local) set_numeric_local(); -#define RESTORE_NUMERIC_STANDARD() \ - if (_was_standard) SET_NUMERIC_STANDARD(); - -#define Atof my_atof +#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_LOCAL() /**/ +#define SET_NUMERIC_STANDARD() +#define SET_NUMERIC_UNDERLYING() #define IS_NUMERIC_RADIX(a, b) (0) -#define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ -#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ -#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() -#define RESTORE_NUMERIC_LOCAL() /**/ -#define RESTORE_NUMERIC_STANDARD() /**/ -#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED +#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 DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() #define RESTORE_LC_NUMERIC() -#define LOCK_NUMERIC_STANDARD() -#define UNLOCK_NUMERIC_STANDARD() +#define LOCK_LC_NUMERIC_STANDARD() +#define UNLOCK_LC_NUMERIC_STANDARD() + +#endif /* !USE_LOCALE_NUMERIC */ #define Atof my_atof -#endif /* !USE_LOCALE_NUMERIC */ +/* Back-compat names */ +#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \ + DECLARATION_FOR_LC_NUMERIC_MANIPULATION +#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \ + DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \ + STORE_LC_NUMERIC_SET_TO_NEEDED(); +#define LOCK_NUMERIC_STANDARD() LOCK_LC_NUMERIC_STANDARD() +#define RESTORE_NUMERIC_LOCAL() RESTORE_LC_NUMERIC_UNDERLYING() +#define RESTORE_NUMERIC_STANDARD() RESTORE_LC_NUMERIC_STANDARD() +#define SET_NUMERIC_LOCAL() SET_NUMERIC_UNDERLYING() +#define STORE_NUMERIC_LOCAL_SET_STANDARD() \ + STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() +#define STORE_NUMERIC_STANDARD_SET_LOCAL() \ + STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() +#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \ + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +#define UNLOCK_NUMERIC_STANDARD() UNLOCK_LC_NUMERIC_STANDARD() + + #ifdef USE_QUADMATH # define Perl_strtod(s, e) strtoflt128(s, e) @@ -6053,8 +6287,10 @@ typedef struct am_table_short AMTS; /* 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. @@ -6150,7 +6386,7 @@ int flock(int fd, int op); 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 */ @@ -6284,31 +6520,435 @@ extern void moncontrol(int); * 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_PRETTY_ELLIPSES 0x000002 +#define PERL_PV_PRETTY_LTGT 0x000004 +#define PERL_PV_PRETTY_EXACTSIZE 0x000008 -#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 +#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_UNI 0x0100 -#define PERL_PV_ESCAPE_UNI_DETECT 0x0200 -#define PERL_PV_ESCAPE_NONASCII 0x0400 - -#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 */ + +#ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */ +# if defined(DOUBLE_LITTLE_ENDIAN) +# define NV_LITTLE_ENDIAN +# elif defined(DOUBLE_BIG_ENDIAN) +# define NV_BIG_ENDIAN +# elif defined(DOUBLE_MIX_ENDIAN) /* stretch */ +# define NV_MIX_ENDIAN +# endif +#elif 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 + +/* NaNs (not-a-numbers) can carry payload bits, in addition to + * "nan-ness". Part of the payload is the quiet/signaling bit. + * To back up a bit (harhar): + * + * For IEEE 754 64-bit formats [1]: + * + * s 000 (mantissa all-zero) zero + * s 000 (mantissa non-zero) subnormals (denormals) + * s 001 ... 7fe normals + * s 7ff q nan + * + * For IEEE 754 128-bit formats: + * + * s 0000 (mantissa all-zero) zero + * s 0000 (mantissa non-zero) subnormals (denormals) + * s 0001 ... 7ffe normals + * s 7fff q nan + * + * [1] this looks like big-endian, but applies equally to little-endian. + * + * s = Sign bit. Yes, zeros and nans can have negative sign, + * the interpretation is application-specific. + * + * q = Quietness bit, the interpretation is platform-specific. + * Most platforms have the most significant bit being one + * meaning quiet, but some (older mips, hppa) have the msb + * being one meaning signaling. Note that the above means + * that on most platforms there cannot be signaling nan with + * zero payload because that is identical with infinity; + * while conversely on older mips/hppa there cannot be a quiet nan + * because that is identical with infinity. + * + * Moreover, whether there is any behavioral difference + * between quiet and signaling NaNs, depends on the platform. + * + * x86 80-bit extended precision is different, the mantissa bits: + * + * 63 62 61 30387+ pre-387 visual c + * -------- ---- -------- -------- + * 0 0 0 invalid infinity + * 0 0 1 invalid snan + * 0 1 0 invalid snan + * 0 1 1 invalid snan + * 1 0 0 infinity snan 1.#INF + * 1 0 1 snan 1.#SNAN + * 1 1 0 qnan -1.#IND (x86 chooses this to negative) + * 1 1 1 qnan 1.#QNAN + * + * This means that in this format there are 61 bits available + * for the nan payload. + * + * In all platforms, the payload bytes (and bits, some of them are + * often in a partial byte) themselves can be either all zero (x86), + * all one (sparc or mips), or a mixture: in IEEE 754 128-bit double + * or in a double-double, the first half of the payload can follow the + * native double, while in the second half the payload can be all + * zeros. (Therefore the mask for payload bits is not necessarily + * identical to bit complement of the NaN.) Another way of putting + * this: the payload for the default NaN might not be zero. + * + * For the x86 80-bit long doubles, the trailing bytes (the 80 bits + * being 'packaged' in either 12 or 16 bytes) can be whatever random + * garbage. + * + * Furthermore, the semantics of the sign bit on NaNs are platform-specific. + * On normal floats, the sign bit being on means negative. But this may, + * or may not, be reverted on NaNs: in other words, the default NaN might + * have the sign bit on, and therefore look like negative if you look + * at it at the bit level. + * + * NaN payloads are not propagated even on copies, or in arithmetics. + * They *might* be, according to some rules, on your particular + * cpu/os/compiler/libraries, but no guarantees. + * + * To summarize, on most platforms, and for 64-bit doubles + * (using big-endian ordering here): + * + * [7FF8000000000000..7FFFFFFFFFFFFFFF] quiet + * [FFF8000000000000..FFFFFFFFFFFFFFFF] quiet + * [7FF0000000000001..7FF7FFFFFFFFFFFF] signaling + * [FFF0000000000001..FFF7FFFFFFFFFFFF] signaling + * + * The C99 nan() is supposed to generate *quiet* NaNs. + * + * Note the asymmetry: + * The 7FF0000000000000 is positive infinity, + * the FFF0000000000000 is negative infinity. + */ + +/* NVMANTBITS is the number of _real_ mantissa bits in an NV. + * For the standard IEEE 754 fp this number is usually one less that + * *DBL_MANT_DIG because of the implicit (aka hidden) bit, which isn't + * real. For the 80-bit extended precision formats (x86*), the number + * of mantissa bits... depends. For normal floats, it's 64. But for + * the inf/nan, it's different (zero for inf, 61 for nan). + * NVMANTBITS works for normal floats. */ + +/* We do not want to include the quiet/signaling bit. */ +#define NV_NAN_BITS (NVMANTBITS - 1) + +#if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 13 +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 2 +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 7 +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 2 +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 13 +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 1 +# else +# error "Unexpected long double format" +# endif +#else +# ifdef USE_QUADMATH +# ifdef NV_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 13 +# elif defined(NV_BIG_ENDIAN) +# define NV_NAN_QS_BYTE_OFFSET 2 +# else +# error "Unexpected quadmath format" +# endif +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 2 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 1 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 6 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 1 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 13 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN +# define NV_NAN_QS_BYTE_OFFSET 2 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE +# define NV_NAN_QS_BYTE_OFFSET 2 /* bytes 4 5 6 7 0 1 2 3 (MSB 7) */ +# 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 +# error "Unexpected double format" +# endif +#endif +/* NV_NAN_QS_BYTE is the byte to test for the quiet/signaling */ +#define NV_NAN_QS_BYTE(nvp) (((U8*)(nvp))[NV_NAN_QS_BYTE_OFFSET]) +/* NV_NAN_QS_BIT is the bit to test in the NV_NAN_QS_BYTE_OFFSET + * for the quiet/signaling */ +#if defined(USE_LONG_DOUBLE) && \ + (LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN) +# define NV_NAN_QS_BIT_SHIFT 6 /* 0x40 */ +#elif defined(USE_LONG_DOUBLE) && \ + (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN) +# define NV_NAN_QS_BIT_SHIFT 3 /* 0x08, but not via NV_NAN_BITS */ +#else +# define NV_NAN_QS_BIT_SHIFT ((NV_NAN_BITS) % 8) /* usually 3, or 0x08 */ +#endif +#define NV_NAN_QS_BIT (1 << (NV_NAN_QS_BIT_SHIFT)) +/* NV_NAN_QS_BIT_OFFSET is the bit offset from the beginning of a NV + * (bytes ordered big-endianly) for the quiet/signaling bit + * for the quiet/signaling */ +#define NV_NAN_QS_BIT_OFFSET \ + (8 * (NV_NAN_QS_BYTE_OFFSET) + (NV_NAN_QS_BIT_SHIFT)) +/* NV_NAN_QS_QUIET (always defined) is one if the NV_NAN_QS_QS_BIT being + * on/one indicates quiet NaN. NV_NAN_QS_SIGNALING (also always defined) + * is on/one if the NV_NAN_QS_BIT being one indicates signaling NaN. */ +#define NV_NAN_QS_QUIET \ + ((NV_NAN_QS_BYTE(PL_nan.u8) & NV_NAN_QS_BIT) == NV_NAN_QS_BIT) +#define NV_NAN_QS_SIGNALING (!(NV_NAN_QS_QUIET)) +#define NV_NAN_QS_TEST(nvp) (NV_NAN_QS_BYTE(nvp) & NV_NAN_QS_BIT) +/* NV_NAN_IS_QUIET() returns true if the NV behind nvp is a NaN, + * whether it is a quiet NaN, NV_NAN_IS_SIGNALING() if a signaling NaN. + * Note however that these do not check whether the nvp is a NaN. */ +#define NV_NAN_IS_QUIET(nvp) \ + (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? NV_NAN_QS_BIT : 0)) +#define NV_NAN_IS_SIGNALING(nvp) \ + (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? 0 : NV_NAN_QS_BIT)) +#define NV_NAN_SET_QUIET(nvp) \ + (NV_NAN_QS_QUIET ? \ + (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT) : \ + (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT)) +#define NV_NAN_SET_SIGNALING(nvp) \ + (NV_NAN_QS_QUIET ? \ + (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT) : \ + (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT)) +#define NV_NAN_QS_XOR(nvp) (NV_NAN_QS_BYTE(nvp) ^= NV_NAN_QS_BIT) + +/* NV_NAN_PAYLOAD_MASK: masking the nan payload bits. + * + * NV_NAN_PAYLOAD_PERM: permuting the nan payload bytes. + * 0xFF means "don't go here".*/ + +/* Shorthands to avoid typoses. */ +#define NV_NAN_PAYLOAD_PERM_0_TO_7 \ + 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7 +#define NV_NAN_PAYLOAD_PERM_7_TO_0 \ + 0x7, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 +#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00 +#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE \ + NV_NAN_PAYLOAD_PERM_0_TO_7, \ + 0x8, 0x9, 0xa, 0xb, 0xc, 0xd, 0xFF, 0xFF +#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE \ + 0x00, 0x00, 0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff +#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE \ + 0xFF, 0xFF, 0xd, 0xc, 0xb, 0xa, 0x9, 0x8, \ + NV_NAN_PAYLOAD_PERM_7_TO_0 +#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00 +#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE \ + 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0xFF +#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE \ + 0x00, 0x07, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff +#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE \ + 0xFF, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0 + +#if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN +# if LONG_DOUBLESIZE == 10 +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF +# elif LONG_DOUBLESIZE == 12 +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF, 0xFF, 0xFF +# elif LONG_DOUBLESIZE == 16 +# define NV_NAN_PAYLOAD_MASK \ + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \ + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_0_TO_7, \ + 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF +# else +# error "Unexpected x86 80-bit little-endian long double format" +# endif +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN +# if LONG_DOUBLESIZE == 10 +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF +# elif LONG_DOUBLESIZE == 12 +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF, 0xFF, 0xFF +# elif LONG_DOUBLESIZE == 16 +# define NV_NAN_PAYLOAD_MASK \ + 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \ + 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_7_TO_0, \ + 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF +# else +# error "Unexpected x86 80-bit big-endian long double format" +# endif +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN +/* For double-double we assume only the first double is used for NaN. */ +# define NV_NAN_PAYLOAD_MASK \ + NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE +# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN +# define NV_NAN_PAYLOAD_MASK \ + NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE +# define NV_NAN_PAYLOAD_PERM \ + NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE +# else +# error "Unexpected long double format" +# endif +#else +# ifdef USE_QUADMATH /* quadmath is not long double */ +# ifdef NV_LITTLE_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# elif defined(NV_BIG_ENDIAN) +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# else +# error "Unexpected quadmath format" +# endif +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00 +# define NV_NAN_PAYLOAD_PERM 0x0, 0x1, 0x2, 0xFF +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN +# define NV_NAN_PAYLOAD_MASK 0x00, 0x07, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0xFF, 0x2, 0x1, 0x0 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN +# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE +# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00, 0xff, 0xff, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0x4, 0x5, 0x6, 0xFF, 0x0, 0x1, 0x2, 0x3 +# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE +# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0xff, 0xff, 0x00, 0x07, 0xff, 0xff +# define NV_NAN_PAYLOAD_PERM 0x3, 0x2, 0x1, 0x0, 0xFF, 0x6, 0x5, 0x4 +# else +# error "Unexpected double format" +# endif +#endif /* (KEEP THIS LAST IN perl.h!) @@ -6362,11 +7002,5 @@ extern void moncontrol(int); #endif /* Include guard */ /* - * Local variables: - * c-indentation-style: bsd - * c-basic-offset: 4 - * indent-tabs-mode: nil - * End: - * * ex: set ts=8 sts=4 sw=4 et: */