X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d074b8ed828ac1f755cafa043f09e0eba8226c51..f03a9d388af16900bace7cd0767491dfc4c14ae0:/perl.h diff --git a/perl.h b/perl.h index adb1f24..7353dd9 100644 --- a/perl.h +++ b/perl.h @@ -28,6 +28,17 @@ # include "config.h" #endif +/* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined + * because the __STDC_VERSION__ became a thing only with C90. Therefore, + * with gcc, HAS_C99 will never become true as long as we use -std=c89. + + * NOTE 2: headers lie. Do not expect that if HAS_C99 gets to be true, + * all the C99 features are there and are correct. */ +#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ + defined(_STDC_C99) +# define HAS_C99 1 +#endif + /* See L for detailed notes on * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ @@ -129,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 @@ -298,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 @@ -307,18 +318,19 @@ /* gcc -Wall: * for silencing unused variables that are actually used most of the time, - * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs + * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs, + * or variables/arguments that are used only in certain configurations. */ #ifndef PERL_UNUSED_ARG # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ # include # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) # else -# define PERL_UNUSED_ARG(x) ((void)x) +# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) # endif #endif #ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)x) +# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) #endif #if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT) @@ -692,6 +704,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 @@ -700,6 +721,10 @@ # endif #endif +#ifdef I_STDINT +# include +#endif + #include #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ @@ -742,6 +767,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 @@ -1112,14 +1141,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) @@ -1205,6 +1226,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 @@ -1219,6 +1241,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 @@ -1248,19 +1271,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 @@ -1546,6 +1572,10 @@ EXTERN_C char *crypt(const char *, const char *); #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END +#ifdef USE_QUADMATH +# define my_snprintf Perl_my_snprintf +# define PERL_MY_SNPRINTF_GUARDED +#else #if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS # define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; }) @@ -1557,7 +1587,10 @@ EXTERN_C char *crypt(const char *, const char *); # define my_snprintf Perl_my_snprintf # define PERL_MY_SNPRINTF_GUARDED #endif +#endif +/* There is no quadmath_vsnprintf, and therefore my_vsnprintf() + * dies if called under USE_QUADMATH. */ #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS # define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; }) @@ -1737,11 +1770,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 @@ -1834,105 +1865,162 @@ typedef NVTYPE NV; # include #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 # endif -# define NV_DIG LDBL_DIG -# ifdef LDBL_MANT_DIG -# define NV_MANT_DIG LDBL_MANT_DIG -# endif -# ifdef LDBL_MIN -# define NV_MIN LDBL_MIN -# endif -# ifdef LDBL_MAX -# define NV_MAX LDBL_MAX -# endif -# ifdef LDBL_MIN_EXP -# define NV_MIN_EXP LDBL_MIN_EXP -# endif -# ifdef LDBL_MAX_EXP -# define NV_MAX_EXP LDBL_MAX_EXP -# endif -# ifdef LDBL_MIN_10_EXP -# define NV_MIN_10_EXP LDBL_MIN_10_EXP -# endif -# ifdef LDBL_MAX_10_EXP -# define NV_MAX_10_EXP LDBL_MAX_10_EXP -# endif -# ifdef LDBL_EPSILON -# define NV_EPSILON LDBL_EPSILON -# endif -# ifdef LDBL_MAX -# define NV_MAX LDBL_MAX +# if defined(LDBL_DIG) +# define NV_DIG LDBL_DIG +# ifdef LDBL_MANT_DIG +# define NV_MANT_DIG LDBL_MANT_DIG +# endif +# ifdef LDBL_MIN +# define NV_MIN LDBL_MIN +# endif +# ifdef LDBL_MAX +# define NV_MAX LDBL_MAX +# endif +# ifdef LDBL_MIN_EXP +# define NV_MIN_EXP LDBL_MIN_EXP +# endif +# ifdef LDBL_MAX_EXP +# define NV_MAX_EXP LDBL_MAX_EXP +# endif +# ifdef LDBL_MIN_10_EXP +# define NV_MIN_10_EXP LDBL_MIN_10_EXP +# endif +# ifdef LDBL_MAX_10_EXP +# define NV_MAX_10_EXP LDBL_MAX_10_EXP +# endif +# ifdef LDBL_EPSILON +# define NV_EPSILON LDBL_EPSILON +# endif +# ifdef LDBL_MAX +# define NV_MAX LDBL_MAX /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ -# else -# ifdef HUGE_VALL -# define NV_MAX HUGE_VALL # else -# ifdef HUGE_VAL -# define NV_MAX ((NV)HUGE_VAL) +# ifdef HUGE_VALL +# define NV_MAX HUGE_VALL # endif # endif # endif -# ifdef HAS_SQRTL +# if defined(HAS_SQRTL) +# define Perl_acos acosl +# define Perl_asin asinl +# define Perl_atan atanl +# define Perl_atan2 atan2l +# define Perl_ceil ceill # define Perl_cos cosl -# define Perl_sin sinl -# define Perl_sqrt sqrtl +# define Perl_cosh coshl # define Perl_exp expl -# define Perl_log logl -# define Perl_atan2 atan2l -# define Perl_pow powl +/* no Perl_fabs, but there's PERL_ABS */ # define Perl_floor floorl -# define Perl_ceil ceill # define Perl_fmod fmodl +# define Perl_log logl +# define Perl_log10 log10l +# define Perl_pow powl +# define Perl_sin sinl +# define Perl_sinh sinhl +# define Perl_sqrt sqrtl +# define Perl_tan tanl +# define Perl_tanh tanhl # endif /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ -# ifdef HAS_MODFL -# define Perl_modf(x,y) modfl(x,y) +# ifndef Perl_modf +# ifdef HAS_MODFL +# define Perl_modf(x,y) modfl(x,y) /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no prototype in */ -# ifndef HAS_MODFL_PROTO +# ifndef HAS_MODFL_PROTO EXTERN_C long double modfl(long double, long double *); -# endif -# else -# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL) +# endif +# elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL) extern long double Perl_my_modfl(long double x, long double *ip); # define Perl_modf(x,y) Perl_my_modfl(x,y) # endif # endif -# ifdef HAS_FREXPL -# define Perl_frexp(x,y) frexpl(x,y) -# else -# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL) - extern long double Perl_my_frexpl(long double x, int *e); -# define Perl_frexp(x,y) Perl_my_frexpl(x,y) +# ifndef Perl_frexp +# ifdef HAS_FREXPL +# define Perl_frexp(x,y) frexpl(x,y) +# else +# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL) +extern long double Perl_my_frexpl(long double x, int *e); +# define Perl_frexp(x,y) Perl_my_frexpl(x,y) +# endif # endif # endif -# ifdef HAS_LDEXPL -# define Perl_ldexp(x, y) ldexpl(x,y) -# else -# if defined(HAS_SCALBNL) && FLT_RADIX == 2 -# define Perl_ldexp(x,y) scalbnl(x,y) +# ifndef Perl_ldexp +# ifdef HAS_LDEXPL +# define Perl_ldexp(x, y) ldexpl(x,y) +# else +# if defined(HAS_SCALBNL) && FLT_RADIX == 2 +# define Perl_ldexp(x,y) scalbnl(x,y) +# endif # endif # endif # ifndef Perl_isnan -# ifdef HAS_ISNANL +# if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99)) # define Perl_isnan(x) isnanl(x) # endif # endif # ifndef Perl_isinf -# if defined(HAS_ISINFL) +# if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99)) # define Perl_isinf(x) isinfl(x) +# elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN) +# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) # endif # endif # ifndef Perl_isfinite -# ifdef HAS_ISFINITEL -# define Perl_isfinite(x) isfinitel(x) -# elif defined(HAS_FINITEL) -# define Perl_isfinite(x) finitel(x) -# endif +# 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 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 @@ -1967,29 +2055,120 @@ EXTERN_C long double modfl(long double, long double *); # define NV_MAX HUGE_VAL # endif # endif + +/* These math interfaces are C89. */ +# define Perl_acos acos +# define Perl_asin asin +# define Perl_atan atan +# define Perl_atan2 atan2 +# define Perl_ceil ceil # define Perl_cos cos -# define Perl_sin sin -# define Perl_sqrt sqrt +# define Perl_cosh cosh # define Perl_exp exp -# define Perl_log log -# define Perl_atan2 atan2 -# define Perl_pow pow +/* no Perl_fabs, but there's PERL_ABS */ # define Perl_floor floor -# define Perl_ceil ceil # define Perl_fmod fmod +# define Perl_log log +# define Perl_log10 log10 +# define Perl_pow pow +# define Perl_sin sin +# define Perl_sinh sinh +# define Perl_sqrt sqrt +# define Perl_tan tan +# define Perl_tanh tanh + # define Perl_modf(x,y) modf(x,y) # define Perl_frexp(x,y) frexp(x,y) # define Perl_ldexp(x,y) ldexp(x,y) + +# ifndef Perl_isnan +# ifdef HAS_ISNAN +# define Perl_isnan(x) isnan(x) +# endif +# endif +# ifndef Perl_isinf +# if defined(HAS_ISINF) +# define Perl_isinf(x) isinf(x) +# elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN) +# define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX) +# endif +# endif +# ifndef Perl_isfinite +# ifdef HAS_ISFINITE +# define Perl_isfinite(x) isfinite(x) +# elif defined(HAS_FINITE) +# define Perl_isfinite(x) finite(x) +# endif +# endif #endif -/* Solaris and IRIX have fpclass/fpclassl, but they are using - * an enum typedef, not cpp symbols, and Configure doesn't detect that. - * Define one symbol also as a cpp symbol so we can detect it. */ -#if defined(__sun) || defined(__irix__) /* XXX Configure test instead */ -# define FP_SNAN FP_SNAN +/* fpclassify(): C99. It is supposed to be a macro that switches on +* the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/ +#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) +# include +# if defined(FP_INFINITE) && defined(FP_NAN) +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# elif defined(FP_PLUS_INF) && defined(FP_QNAN) +/* Some versions of HP-UX (10.20) have (only) fpclassify() but which is + * actually not the C99 fpclassify, with its own set of return defines. */ +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif #endif +/* fp_classify(): Legacy: VMS, maybe Unicos? The values, however, + * are identical to the C99 fpclassify(). */ +#if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY) +# include +# ifdef __VMS + /* FP_INFINITE and others are here rather than in math.h as C99 stipulates */ +# include + /* oh, and the isnormal macro has a typo in it! */ +# undef isnormal +# define isnormal(x) Perl_fp_class_norm(x) +# endif +# if defined(FP_INFINITE) && defined(FP_NAN) +# define Perl_fp_class(x) fp_classify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif +#endif + +/* Feel free to check with me for the SGI manpages, SGI testing, + * etcetera, if you want to try getting this to work with IRIX. + * + * - Allen */ + +/* fpclass(): SysV, at least Solaris and some versions of IRIX. */ #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) +/* Solaris and IRIX have fpclass/fpclassl, but they are using + * an enum typedef, not cpp symbols, and Configure doesn't detect that. + * Define some symbols also as cpp symbols so we can detect them. */ +# if defined(__sun) || defined(__irix__) /* XXX Configure test instead */ +# define FP_PINF FP_PINF +# define FP_QNAN FP_QNAN +# endif # include # ifdef I_IEEFP # include @@ -2002,7 +2181,7 @@ EXTERN_C long double modfl(long double, long double *); # else # define Perl_fp_class(x) fpclass(x) # endif -# ifdef FP_CLASS_SNAN +# if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN) # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) @@ -2013,7 +2192,7 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) -# elif defined(FP_SNAN) +# elif defined(FP_PINF) && defined(FP_QNAN) # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF) @@ -2024,70 +2203,75 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM) # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO) # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ # endif #endif -/* Feel free to check with me for the SGI manpages, SGI testing, - * etcetera, if you want to try getting this to work with IRIX. - * - * - Allen */ - -#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) +/* fp_class(): Legacy: at least Tru64, some versions of IRIX. */ +#if !defined(Perl_fp_class) && (defined(HAS_FP_CLASS)||defined(HAS_FP_CLASSL)) # include # if !defined(FP_SNAN) && defined(I_FP_CLASS) # include # endif -# ifdef __irix__ /* XXX Configure test instead */ -# ifdef USE_LONG_DOUBLE -# define Perl_fp_class(x) fp_class_l(x) +# if defined(FP_POS_INF) && defined(FP_QNAN) +# ifdef __irix__ /* XXX Configure test instead */ +# ifdef USE_LONG_DOUBLE +# define Perl_fp_class(x) fp_class_l(x) +# else +# define Perl_fp_class(x) fp_class_d(x) +# endif # else -# define Perl_fp_class(x) fp_class_d(x) +# if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL) +# define Perl_fp_class(x) fp_classl(x) +# else +# define Perl_fp_class(x) fp_class(x) +# endif +# endif +# if defined(FP_POS_INF) && defined(FP_QNAN) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ # endif -# else -# define Perl_fp_class(x) fp_class(x) # endif -# define Perl_fp_class_snan(x) (fp_class(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (fp_class(x)==FP_QNAN) -# define Perl_fp_class_ninf(x) (fp_class(x)==FP_NEG_INF) -# define Perl_fp_class_pinf(x) (fp_class(x)==FP_POS_INF) -# define Perl_fp_class_nnorm(x) (fp_class(x)==FP_NEG_NORM) -# define Perl_fp_class_pnorm(x) (fp_class(x)==FP_POS_NORM) -# define Perl_fp_class_ndenorm(x) (fp_class(x)==FP_NEG_DENORM) -# define Perl_fp_class_pdenorm(x) (fp_class(x)==FP_POS_DENORM) -# define Perl_fp_class_nzero(x) (fp_class(x)==FP_NEG_ZERO) -# define Perl_fp_class_pzero(x) (fp_class(x)==FP_POS_ZERO) -#endif - -#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) -# include -# define Perl_fp_class(x) fpclassify(x) -# define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE) -# define Perl_fp_class_snan(x) (fp_classify(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (fp_classify(x)==FP_QNAN) -# define Perl_fp_class_norm(x) (fp_classify(x)==FP_NORMAL) -# define Perl_fp_class_denorm(x) (fp_classify(x)==FP_SUBNORMAL) -# define Perl_fp_class_zero(x) (fp_classify(x)==FP_ZERO) #endif +/* class(), _class(): Legacy: AIX. */ #if !defined(Perl_fp_class) && defined(HAS_CLASS) # include -# ifndef _cplusplus -# define Perl_fp_class(x) class(x) -# else -# define Perl_fp_class(x) _class(x) +# if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF) +# ifndef _cplusplus +# define Perl_fp_class(x) class(x) +# else +# define Perl_fp_class(x) _class(x) +# endif +# if defined(FP_PLUS_INF) && defined(FP_NANQ) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif # endif -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) #endif +/* Win32: _fpclass(), _isnan(), _finite(). */ #ifdef WIN32 # ifndef Perl_isnan # define Perl_isnan(x) _isnan(x) @@ -2096,9 +2280,11 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_isfinite(x) _finite(x) # endif # ifndef Perl_fp_class_snan +/* No simple way to #define Perl_fp_class because _fpclass() + * returns a set of bits. */ # define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) # define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) -# define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_QNAN|_FPCLASS_QNAN)) +# define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN)) # define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF)) # define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF)) # define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF)) @@ -2144,49 +2330,68 @@ EXTERN_C long double modfl(long double, long double *); (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) #endif +#ifdef UNDER_CE +int isnan(double d); +#endif + #ifndef Perl_isnan -# ifdef HAS_ISNAN -# define Perl_isnan(x) isnan((double)x) +# ifdef Perl_fp_class_nan +# define Perl_isnan(x) Perl_fp_class_nan(x) # else -# ifdef Perl_fp_class_nan -# define Perl_isnan(x) Perl_fp_class_nan(x) +# ifdef HAS_UNORDERED +# define Perl_isnan(x) unordered((x), 0.0) # else -# ifdef HAS_UNORDERED -# define Perl_isnan(x) unordered((x), 0.0) -# else -# define Perl_isnan(x) ((x)!=(x)) -# endif +# define Perl_isnan(x) ((x)!=(x)) # endif # endif #endif -#ifdef UNDER_CE -int isnan(double d); +#ifndef Perl_isinf +# ifdef Perl_fp_class_inf +# define Perl_isinf(x) Perl_fp_class_inf(x) +# endif #endif #ifndef Perl_isfinite -# ifdef HAS_ISFINITE -# define Perl_isfinite(x) isfinite((double)x) +# if defined(HAS_ISFINITE) && !defined(isfinite) +# define Perl_isfinite(x) isfinite((double)(x)) # elif defined(HAS_FINITE) -# define Perl_isfinite(x) finite((double)x) +# define Perl_isfinite(x) finite((double)(x)) # elif defined(Perl_fp_class_finite) # define Perl_isfinite(x) Perl_fp_class_finite(x) -# elif defined(Perl_is_inf) && defined(Perl_is_nan) -# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x)) # else -/* NaN*0 is NaN, [+-]Inf*0 is NaN, zero for anything else. */ +/* For the infinities the multiplication returns nan, + * for the nan the multiplication also returns nan, + * for everything else (that is, finite) zero should be returned. */ # define Perl_isfinite(x) (((x) * 0) == 0) # endif #endif #ifndef Perl_isinf -# if defined(Perl_fp_class_inf) -# define Perl_isinf(x) Perl_fp_class_inf(x) -# elif defined(Perl_isfinite) && defined(Perl_isnan) +# if defined(Perl_isfinite) && defined(Perl_isnan) # define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) # endif #endif +/* We need Perl_isfinitel (ends with ell) (if available) even when + * not USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags) + * needs that. */ +#if defined(HAS_LONG_DOUBLE) && !defined(Perl_isfinitel) +/* If isfinite() is a macro and looks like we have C99, + * we assume it's the type-aware C99 isfinite(). */ +# if defined(HAS_ISFINITE) && defined(isfinite) && defined(HAS_C99) +# define Perl_isfinitel(x) isfinite(x) +# elif defined(HAS_ISFINITEL) +# define Perl_isfinitel(x) isfinitel(x) +# elif defined(HAS_FINITEL) +# define Perl_isfinitel(x) finitel(x) +# elif defined(HAS_INFL) && defined(HAS_NANL) +# define Perl_isfinitel(x) !(isinfl(x)||isnanl(x)) +# else +# define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */ +# endif +#endif + /* The default is to use Perl's own atof() implementation (in numeric.c). * Usually that is the one to use but for some platforms (e.g. UNICOS) * it is however best to use the native implementation of atof. @@ -2394,6 +2599,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; @@ -2402,6 +2608,7 @@ typedef struct svop SVOP; typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; +typedef struct methop METHOP; #ifdef PERL_CORE typedef struct opslab OPSLAB; @@ -2451,12 +2658,12 @@ 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) @@ -2473,6 +2680,10 @@ typedef SV PADNAME; # define PERL_SAWAMPERSAND #endif +#if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS) +# error PERL_DEBUG_READONLY_OPS only works with ithreads +#endif + #include "handy.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) @@ -2694,6 +2905,23 @@ typedef SV PADNAME; # 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 +# 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 @@ -3185,6 +3413,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 @@ -3245,7 +3476,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 @@ -3276,6 +3510,27 @@ typedef pthread_key_t perl_key; /* placeholder */ #endif +#if defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L) +/* static_assert is a macro defined in in C11 or a compiler + builtin in C++11. +*/ +# 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 */ @@ -3286,13 +3541,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) @@ -3786,6 +4041,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 @@ -3868,6 +4124,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) @@ -3910,11 +4167,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. */ @@ -3979,6 +4236,10 @@ char *strcpy(), *strcat(); #ifdef I_MATH # include +# ifdef __VMS + /* isfinite and others are here rather than in math.h as C99 stipulates */ +# include +# endif #else START_EXTERN_C double exp (double); @@ -3999,13 +4260,23 @@ END_EXTERN_C # if !defined(NV_INF) && defined(HUGE_VAL) # define NV_INF HUGE_VAL # endif -# ifndef NV_NAN -# define NV_NAN (NV_INF-NV_INF) -# 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 !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY) -# define NV_INF LDBL_INFINITY +/* 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 @@ -4016,17 +4287,40 @@ END_EXTERN_C #if !defined(NV_INF) && defined(INF) # define NV_INF (NV)INF #endif -#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) -# define NV_INF (NV)HUGE_VALL +#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) && defined(HUGE_VAL) -# define NV_INF (NV)HUGE_VAL +#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 @@ -4043,18 +4337,30 @@ END_EXTERN_C #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) && defined(NAN) -# define NV_NAN (NV)NAN +#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) && defined(NV_INF) -# define NV_NAN (NV_INF-NV_INF) +#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) @@ -4304,12 +4610,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[] @@ -4329,7 +4636,7 @@ EXTCONST char PL_no_dir_func[] 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[] @@ -4805,6 +5112,9 @@ EXTCONST char PL_bincompat_options[] = # ifdef USE_PERLIO " USE_PERLIO" # endif +# ifdef USE_QUADMATH + " USE_QUADMATH" +# endif # ifdef USE_REENTRANT_API " USE_REENTRANT_API" # endif @@ -4951,8 +5261,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 */ @@ -4974,6 +5284,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))) @@ -5213,6 +5533,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 @@ -5223,14 +5563,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 @@ -5398,19 +5731,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 */ @@ -5448,6 +5781,45 @@ 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 */ +# 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 @@ -5462,6 +5834,10 @@ 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 @@ -5577,7 +5953,9 @@ typedef struct am_table_short AMTS; #endif /* !USE_LOCALE_NUMERIC */ -#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) +#ifdef USE_QUADMATH +# define Perl_strtod(s, e) strtoflt128(s, e) +#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) # if defined(HAS_STRTOLD) # define Perl_strtod(s, e) strtold(s, e) # elif defined(HAS_STRTOD) @@ -5777,8 +6155,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. @@ -6008,31 +6388,69 @@ 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_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 + +#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 +# 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 */ + /* (KEEP THIS LAST IN perl.h!)