X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8d98ede7e1cbbb475ae22272175fac5115496ffa..5d288d736c2758c27a5943647f4a524f0e93a642:/perl.h diff --git a/perl.h b/perl.h index 140569e..8e81724 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 */ @@ -307,21 +318,22 @@ /* 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 -#ifdef USE_ITHREADS +#if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT) # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) #else # define PERL_UNUSED_CONTEXT @@ -384,21 +396,32 @@ * * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011; * clang only pretends to be GCC 4.2, but still supports push/pop. + * + * Note on usage: on non-gcc (or lookalike, like clang) compilers + * one cannot use these at file (global) level without warnings + * since they are defined as empty, which leads into the terminating + * semicolon being left alone on a line: + * ; + * which makes compilers mildly cranky. Therefore at file level one + * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE_FILE *without* + * the semicolons. + * + * (A dead-on-arrival solution would be to try to define the macros as + * NOOP or dNOOP, those don't work both inside functions and outside.) */ -#if defined(__clang) || \ +#if defined(__clang__) || defined(__clang) || \ (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406) -# define GCC_DIAG_DO_PRAGMA_(x) _Pragma (#x) - +# define GCC_DIAG_PRAGMA(x) _Pragma (#x) +/* clang has "clang diagnostic" pragmas, but also understands gcc. */ # define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \ - GCC_DIAG_DO_PRAGMA_(GCC diagnostic ignored #x) + GCC_DIAG_PRAGMA(GCC diagnostic ignored #x) # define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop") #else # define GCC_DIAG_IGNORE(w) # define GCC_DIAG_RESTORE #endif - #define NOOP /*EMPTY*/(void)0 /* cea2e8a9dd23747f accidentally lost the comment originally from the first check in of thread.h, explaining why we need dNOOP at all: */ @@ -689,21 +712,11 @@ # endif #endif -#ifdef USE_NEXT_CTYPE +#ifdef I_STDINT +# include +#endif -#if NX_CURRENT_COMPILER_RELEASE >= 500 -# include -#else -# if NX_CURRENT_COMPILER_RELEASE >= 400 -# include -# else /* NX_CURRENT_COMPILER_RELEASE < 400 */ -# include -# endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ -#endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */ - -#else /* !USE_NEXT_CTYPE */ #include -#endif /* USE_NEXT_CTYPE */ #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ #undef METHOD @@ -737,6 +750,9 @@ # if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY) # define USE_LOCALE_MONETARY # endif +# if !defined(NO_LOCALE_TIME) && defined(LC_TIME) +# define USE_LOCALE_TIME +# endif # ifndef WIN32 /* No wrapper except on Windows */ # define my_setlocale(a,b) setlocale(a,b) # endif @@ -893,6 +909,11 @@ EXTERN_C int usleep(unsigned int); # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) #endif +/* ptrdiff_t is C11, so undef it under pedantic builds */ +#ifdef PERL_GCC_PEDANTIC +# undef HAS_PTRDIFF_T +#endif + #ifndef __SYMBIAN32__ # if defined(I_STRING) || defined(__cplusplus) # include @@ -930,7 +951,7 @@ EXTERN_C int usleep(unsigned int); # define CHECK_MALLOC_TAINT(newval) \ CHECK_MALLOC_TOO_LATE_FOR_( \ if (newval) { \ - panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\ + PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\ exit(1); }) # define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \ if (doing_taint(argc,argv,env)) { \ @@ -1341,10 +1362,6 @@ EXTERN_C char *crypt(const char *, const char *); /* Configure already sets Direntry_t */ #if defined(I_DIRENT) # include - /* NeXT needs dirent + sys/dir.h */ -# if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__)) -# include -# endif #else # ifdef I_SYS_NDIR # include @@ -1543,12 +1560,14 @@ EXTERN_C char *crypt(const char *, const char *); * that should be true only if the snprintf()/vsnprintf() are true * to the standard. */ +#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 + #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, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; }) +# define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; }) # define PERL_MY_SNPRINTF_GUARDED # else -# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__) +# define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__) # endif #else # define my_snprintf Perl_my_snprintf @@ -1557,16 +1576,47 @@ EXTERN_C char *crypt(const char *, const char *); #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, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) +# define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; }) # define PERL_MY_VSNPRINTF_GUARDED # else -# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__) +# define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__) # endif #else # define my_vsnprintf Perl_my_vsnprintf # define PERL_MY_VSNPRINTF_GUARDED #endif +/* You will definitely need to use the PERL_MY_SNPRINTF_POST_GUARD() + * or PERL_MY_VSNPRINTF_POST_GUARD() if you otherwise decide to ignore + * the result of my_snprintf() or my_vsnprintf(). (No, you should not + * completely ignore it: otherwise you cannot know whether your output + * was too long.) + * + * int len = my_sprintf(buf, max, ...); + * PERL_MY_SNPRINTF_POST_GUARD(len, max); + * + * The trick is that in certain platforms [a] the my_sprintf() already + * contains the sanity check, while in certain platforms [b] it needs + * to be done as a separate step. The POST_GUARD is that step-- in [a] + * platforms the POST_GUARD actually does nothing since the check has + * already been done. Watch out for the max being the same in both calls. + * + * If you actually use the snprintf/vsnprintf return value already, + * you assumedly are checking its validity somehow. But you can + * insert the POST_GUARD() also in that case. */ + +#ifndef PERL_MY_SNPRINTF_GUARDED +# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf) +#else +# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) +#endif + +#ifndef PERL_MY_VSNPRINTF_GUARDED +# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf) +#else +# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) +#endif + #ifdef HAS_STRLCAT # define my_strlcat strlcat #else @@ -1643,7 +1693,8 @@ typedef UVTYPE UV; # endif #endif -#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1) +#define Size_t_MAX (~(Size_t)0) +#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1) #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) @@ -1813,6 +1864,12 @@ typedef NVTYPE NV; # 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 @@ -1835,16 +1892,26 @@ typedef NVTYPE NV; # endif # endif # ifdef HAS_SQRTL +/* These math interfaces are the long double cousins of the C89 math. */ +# 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 @@ -1854,11 +1921,9 @@ typedef NVTYPE NV; # ifndef HAS_MODFL_PROTO EXTERN_C long double modfl(long double, long double *); # endif -# else -# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL) +# 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) @@ -1868,16 +1933,28 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_frexp(x,y) Perl_my_frexpl(x,y) # 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) +# 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 -# ifdef HAS_FINITEL -# define Perl_isinf(x) !(finitel(x)||Perl_isnan(x)) +# if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99)) +# define Perl_isinf(x) isinfl(x) +# elif defined(LDBL_MAX) +# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) # endif # endif +# ifndef Perl_isfinite +# define Perl_isfinite(x) Perl_isfinitel(x) +# endif #else # define NV_DIG DBL_DIG # ifdef DBL_MANT_DIG @@ -1889,6 +1966,12 @@ EXTERN_C long double modfl(long double, long double *); # ifdef DBL_MAX # define NV_MAX DBL_MAX # endif +# ifdef DBL_MIN_EXP +# define NV_MIN_EXP DBL_MIN_EXP +# endif +# ifdef DBL_MAX_EXP +# define NV_MAX_EXP DBL_MAX_EXP +# endif # ifdef DBL_MIN_10_EXP # define NV_MIN_10_EXP DBL_MIN_10_EXP # endif @@ -1906,30 +1989,121 @@ 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) +# 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 -/* rumor has it that Win32 has _fpclass() */ +/* 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 -/* SGI has fpclassl... but not with the same result values, - * and it's via a typedef (not via #define), so will need to redo Configure - * to use. Not worth the trouble, IMO, at least until the below is used - * more places. Also has fp_class_l, BTW, via fp_class.h. 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 */ +/* 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 # endif @@ -1937,134 +2111,221 @@ EXTERN_C long double modfl(long double, long double *); # include # endif # if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL) -# define Perl_fp_class() fpclassl(x) +# define Perl_fp_class(x) fpclassl(x) # else -# define Perl_fp_class() fpclass(x) +# define Perl_fp_class(x) fpclass(x) # endif -# 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_nan(x) (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) -# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) -# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) -# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM||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) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO) -#endif - -#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) -# include -# if !defined(FP_SNAN) && defined(I_FP_CLASS) -# include +# 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) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) +# 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_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) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PINF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NNORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PNORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NDENORM) +# 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 -# define Perl_fp_class(x) fp_class(x) -# 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_nan(x) (fp_class(x)==FP_SNAN||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_inf(x) (fp_class(x)==FP_NEG_INF||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_norm(x) (fp_class(x)==FP_NEG_NORM||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_denorm(x) (fp_class(x)==FP_NEG_DENORM||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) -# define Perl_fp_class_zero(x) (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO) #endif -#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) +/* fp_class(): Legacy: at least Tru64, some versions of IRIX. */ +#if !defined(Perl_fp_class) && (defined(HAS_FP_CLASS)||defined(HAS_FP_CLASSL)) # include -# define Perl_fp_class(x) fpclassify(x) -# define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN) -# define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE) -# 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) +# if !defined(FP_SNAN) && defined(I_FP_CLASS) +# include +# endif +# 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 +# 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 +# endif #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_nan(x) (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN) -# 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_inf(x) (Perl_fp_class(x)==FP_MINUS_INF||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_norm(x) (Perl_fp_class(x)==FP_MINUS_NORM||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_denorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM||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) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO) -#endif - -/* rumor has it that Win32 has _isnan() */ +#endif -#ifndef Perl_isnan -# ifdef HAS_ISNAN -# define Perl_isnan(x) isnan((NV)x) -# else -# ifdef Perl_fp_class_nan -# define Perl_isnan(x) Perl_fp_class_nan(x) -# else -# ifdef HAS_UNORDERED -# define Perl_isnan(x) unordered((x), 0.0) -# else -# define Perl_isnan(x) ((x)!=(x)) -# endif -# endif -# endif +/* Win32: _fpclass(), _isnan(), _finite(). */ +#ifdef WIN32 +# ifndef Perl_isnan +# define Perl_isnan(x) _isnan(x) +# endif +# ifndef Perl_isfinite +# 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_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)) +# define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN) +# define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN) +# define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN)) +# define Perl_fp_class_ndenorm(x) (_fpclass(x) & _FPCLASS_ND) +# define Perl_fp_class_pdenorm(x) (_fpclass(x) & _FPCLASS_PD) +# define Perl_fp_class_denorm(x) (_fpclass(x) & (_FPCLASS_ND|_FPCLASS_PD)) +# define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ) +# define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ) +# define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ)) +# endif +#endif + +#if !defined(Perl_fp_class_inf) && \ + defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf) +# define Perl_fp_class_inf(x) \ + (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x)) +#endif + +#if !defined(Perl_fp_class_nan) && \ + defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan) +# define Perl_fp_class_nan(x) \ + (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x)) +#endif + +#if !defined(Perl_fp_class_zero) && \ + defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero) +# define Perl_fp_class_zero(x) \ + (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x)) +#endif + +#if !defined(Perl_fp_class_norm) && \ + defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm) +# define Perl_fp_class_norm(x) \ + (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x)) +#endif + +#if !defined(Perl_fp_class_denorm) && \ + defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm) +# define Perl_fp_class_denorm(x) \ + (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) #endif #ifdef UNDER_CE int isnan(double d); #endif -#ifndef Perl_isinf -# ifdef HAS_ISINF -# define Perl_isinf(x) isinf((NV)x) +#ifndef Perl_isnan +# ifdef Perl_fp_class_nan +# define Perl_isnan(x) Perl_fp_class_nan(x) # else -# ifdef Perl_fp_class_inf -# define Perl_isinf(x) Perl_fp_class_inf(x) +# ifdef HAS_UNORDERED +# define Perl_isnan(x) unordered((x), 0.0) # else -# define Perl_isinf(x) ((x)==NV_INF) +# define Perl_isnan(x) ((x)!=(x)) # endif # endif #endif +#ifndef Perl_isinf +# ifdef Perl_fp_class_inf +# define Perl_isinf(x) Perl_fp_class_inf(x) +# endif +#endif + #ifndef Perl_isfinite -# ifdef HAS_FINITE -# define Perl_isfinite(x) finite((NV)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)) +# elif defined(Perl_fp_class_finite) +# define Perl_isfinite(x) Perl_fp_class_finite(x) # else -# ifdef HAS_ISFINITE -# define Perl_isfinite(x) isfinite(x) -# else -# ifdef Perl_fp_class_finite -# define Perl_isfinite(x) Perl_fp_class_finite(x) -# else -# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x)) -# endif -# endif +/* 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_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. @@ -2269,11 +2530,6 @@ int isnan(double d); typedef MEM_SIZE STRLEN; -#ifdef PERL_MAD -typedef struct token TOKEN; -typedef struct madprop MADPROP; -typedef struct nexttoken NEXTTOKE; -#endif typedef struct op OP; typedef struct cop COP; typedef struct unop UNOP; @@ -2582,6 +2838,8 @@ typedef SV PADNAME; #endif /* +=head1 Miscellaneous Functions + =for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv Provides system-specific tune up of the C runtime environment necessary to run Perl interpreters. This should be called only once, before creating @@ -2696,9 +2954,6 @@ freeing any remaining Perl interpreters. # else # ifdef I_MACH_CTHREADS # include -# if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC) -# define MUTEX_INIT_CALLS_MALLOC -# endif typedef cthread_t perl_os_thread; typedef mutex_t perl_mutex; typedef condition_t perl_cond; @@ -3308,13 +3563,6 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #endif #include "perly.h" -#ifdef PERL_MAD -struct nexttoken { - YYSTYPE next_val; /* value of next token, if any */ - I32 next_type; /* type of next token */ - MADPROP *next_mad; /* everything else about that token */ -}; -#endif /* macros to define bit-fields in structs. */ #ifndef PERL_BITFIELD8 @@ -3807,6 +4055,8 @@ Gid_t getegid (void); "\", line %d", STRINGIFY(what), __LINE__), \ (void) 0))) +/* assert() gets defined if DEBUGGING (and I_ASSERT). + * If no DEBUGGING, the has not been included. */ #ifndef assert # define assert(what) Perl_assert(what) #endif @@ -3868,6 +4118,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); @@ -3884,8 +4138,27 @@ START_EXTERN_C END_EXTERN_C #endif -#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY) -# define NV_INF LDBL_INFINITY +#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 @@ -3896,17 +4169,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 @@ -3923,26 +4219,37 @@ 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) +# 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(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ -char *crypt (); /* Maybe more hosts will need the unprototyped version */ -# else -# if !defined(WIN32) && !defined(VMS) +# if !defined(WIN32) && !defined(VMS) #ifndef crypt char *crypt (const char*, const char*); #endif -# endif /* !WIN32 */ -# endif /* !NeXT && !__NeXT__ */ +# endif /* !WIN32 */ # ifndef DONT_DECLARE_STD # ifndef getenv char *getenv (const char*); @@ -4144,19 +4451,9 @@ typedef OP* (*PPADDR_t[]) (pTHX); typedef bool (*destroyable_proc_t) (pTHX_ SV *sv); typedef void (*despatch_signals_proc_t) (pTHX); -/* NeXT has problems with crt0.o globals */ -#if defined(__DYNAMIC__) && \ - (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN)) -# if defined(NeXT) || defined(__NeXT) -# include -# define environ (*environ_pointer) -EXT char *** environ_pointer; -# else -# if defined(PERL_DARWIN) && defined(PERL_CORE) -# include /* for the env array */ -# define environ (*_NSGetEnviron()) -# endif -# endif +#if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE) +# include /* for the env array */ +# define environ (*_NSGetEnviron()) #else /* VMS and some other platforms don't use the environ array */ # ifdef USE_ENVIRON_ARRAY @@ -4633,15 +4930,15 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_GLOBAL_STRUCT " PERL_GLOBAL_STRUCT" # endif +# ifdef PERL_GLOBAL_STRUCT_PRIVATE + " PERL_GLOBAL_STRUCT_PRIVATE" +# endif # ifdef PERL_IMPLICIT_CONTEXT " PERL_IMPLICIT_CONTEXT" # endif # ifdef PERL_IMPLICIT_SYS " PERL_IMPLICIT_SYS" # endif -# ifdef PERL_MAD - " PERL_MAD" -# endif # ifdef PERL_MICRO " PERL_MICRO" # endif @@ -4687,6 +4984,9 @@ EXTCONST char PL_bincompat_options[] = # ifdef USE_LOCALE_NUMERIC " USE_LOCALE_NUMERIC" # endif +# ifdef USE_LOCALE_TIME + " USE_LOCALE_TIME" +# endif # ifdef USE_LONG_DOUBLE " USE_LONG_DOUBLE" # endif @@ -4784,6 +5084,7 @@ typedef enum { XATTRBLOCK, XATTRTERM, XTERMBLOCK, + XBLOCKTERM, XPOSTDEREF, XTERMORDORDOR /* evil hack */ /* update exp_name[] in toke.c if adding to this enum */ @@ -4794,12 +5095,18 @@ typedef enum { However, bitops store HINT_INTEGER in their op_private. NOTE: The typical module using these has the bit value hard-coded, so don't - blindly change the values of these */ + blindly change the values of these. + + If we run out of bits, the 2 locale ones could be combined. The PARTIAL one + is for "use locale 'FOO'" which excludes some categories. It requires going + to %^H to find out which are in and which are out. This could be extended + for the normal case of a plain HINT_LOCALE, so that %^H would be used for + any locale form. */ #define HINT_INTEGER 0x00000001 /* integer pragma */ #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ #define HINT_LOCALE 0x00000004 /* locale pragma */ #define HINT_BYTES 0x00000008 /* bytes pragma */ -#define HINT_LOCALE_NOT_CHARS 0x00000010 /* locale ':not_characters' pragma */ +#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset of categories */ #define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */ #define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */ @@ -5054,12 +5361,6 @@ struct tempsym; /* defined in pp_pack.c */ #if !defined(PERL_FOR_X2P) # include "embedvar.h" #endif -#ifndef PERL_MAD -# undef PL_madskills -# undef PL_xmlfp -# define PL_madskills 0 -# define PL_xmlfp 0 -#endif /* Now include all the 'global' variables * If we don't have threads or multiple interpreters @@ -5086,10 +5387,6 @@ END_EXTERN_C In particular, need the relevant *ish file included already, as it may define HAVE_INTERP_INTERN */ #include "embed.h" -#ifndef PERL_MAD -# undef op_getmad -# define op_getmad(arg,pegop,slot) NOOP -#endif #ifndef PERL_GLOBAL_STRUCT START_EXTERN_C @@ -5303,24 +5600,58 @@ typedef struct am_table_short AMTS; #define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS)) #define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID)) +#ifdef USE_LOCALE +/* These locale things are all subject to change */ /* Returns TRUE if the plain locale pragma without a parameter is in effect */ -#define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE) +# define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE) /* Returns TRUE if either form of the locale pragma is in effect */ -#define IN_SOME_LOCALE_FORM_RUNTIME \ - cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS)) +# define IN_SOME_LOCALE_FORM_RUNTIME \ + cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) -#define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE) -#define IN_SOME_LOCALE_FORM_COMPILETIME \ - cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS)) +# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE) +# define IN_SOME_LOCALE_FORM_COMPILETIME \ + cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) -#define IN_LOCALE \ +# define IN_LOCALE \ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) -#define IN_SOME_LOCALE_FORM \ +# define IN_SOME_LOCALE_FORM \ (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \ : IN_SOME_LOCALE_FORM_RUNTIME) +# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME +# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME + +# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL) +# define IN_LC_PARTIAL_RUNTIME \ + cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL) + +# define IN_LC_COMPILETIME(category) \ + (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \ + && _is_in_locale_category(TRUE, (category)))) +# define IN_LC_RUNTIME(category) \ + (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \ + && _is_in_locale_category(FALSE, (category)))) +# define IN_LC(category) \ + (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) + +#else /* No locale usage */ +# define IN_LOCALE_RUNTIME 0 +# define IN_SOME_LOCALE_FORM_RUNTIME 0 +# define IN_LOCALE_COMPILETIME 0 +# define IN_SOME_LOCALE_FORM_COMPILETIME 0 +# define IN_LOCALE 0 +# define IN_SOME_LOCALE_FORM 0 +# define IN_LC_ALL_COMPILETIME 0 +# define IN_LC_ALL_RUNTIME 0 +# define IN_LC_PARTIAL_COMPILETIME 0 +# define IN_LC_PARTIAL_RUNTIME 0 +# define IN_LC_COMPILETIME(category) 0 +# define IN_LC_RUNTIME(category) 0 +# define IN_LC(category) 0 +#endif + #ifdef USE_LOCALE_NUMERIC /* These macros are for toggling between the underlying locale (LOCAL) and the @@ -5335,18 +5666,24 @@ typedef struct am_table_short AMTS; * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before * these were called */ +#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_SOME_LOCALE_FORM) { \ - if (! PL_numeric_local) { \ - SET_NUMERIC_LOCAL(); \ + if (IN_LC(LC_NUMERIC)) { \ + if (_NOT_IN_NUMERIC_LOCAL) { \ + set_numeric_local(); \ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ } \ } \ else { \ - if (! PL_numeric_standard) { \ + if (_NOT_IN_NUMERIC_STANDARD) { \ SET_NUMERIC_STANDARD(); \ _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \ } \ @@ -5364,35 +5701,46 @@ typedef struct am_table_short AMTS; /* The next two macros set unconditionally. These should be rarely used, and * only after being sure that this is what is needed */ #define SET_NUMERIC_STANDARD() \ - STMT_START { if (! PL_numeric_standard) set_numeric_standard(); \ + STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \ } STMT_END #define SET_NUMERIC_LOCAL() \ - STMT_START { if (! PL_numeric_local) set_numeric_local(); } STMT_END + STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \ + 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 = PL_numeric_local; \ - if (was_local) SET_NUMERIC_STANDARD(); +#define STORE_NUMERIC_LOCAL_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 = PL_numeric_standard && IN_SOME_LOCALE_FORM; \ - if (was_standard) SET_NUMERIC_LOCAL(); +#define STORE_NUMERIC_STANDARD_SET_LOCAL() \ + bool _was_standard = _NOT_IN_NUMERIC_LOCAL \ + && 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 = PL_numeric_standard; \ - if (was_standard) SET_NUMERIC_LOCAL(); +#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \ + bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \ + if (_was_standard) set_numeric_local(); + +/* Lock to the C locale until unlock is called */ +#define LOCK_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard) \ + PL_numeric_standard = 2) + +#define UNLOCK_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard == 2) \ + PL_numeric_standard = 1) #define RESTORE_NUMERIC_LOCAL() \ - if (was_local) SET_NUMERIC_LOCAL(); + if (_was_local) set_numeric_local(); #define RESTORE_NUMERIC_STANDARD() \ - if (was_standard) SET_NUMERIC_STANDARD(); + if (_was_standard) SET_NUMERIC_STANDARD(); #define Atof my_atof @@ -5410,13 +5758,23 @@ typedef struct am_table_short AMTS; #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 Atof my_atof -#define IN_LOCALE_RUNTIME 0 -#define IN_LOCALE_COMPILETIME 0 #endif /* !USE_LOCALE_NUMERIC */ +#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) +# if defined(HAS_STRTOLD) +# define Perl_strtod(s, e) strtold(s, e) +# elif defined(HAS_STRTOD) +# define Perl_strtod(s, e) (NV)strtod(s, e) /* Unavoidable loss. */ +# endif +#elif defined(HAS_STRTOD) +# define Perl_strtod(s, e) strtod(s, e) +#endif + #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \ (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef __hpux @@ -5708,6 +6066,7 @@ int flock(int fd, int op); #define IS_NUMBER_NEG 0x08 /* leading minus sign */ #define IS_NUMBER_INFINITY 0x10 /* this is big */ #define IS_NUMBER_NAN 0x20 /* this is not */ +#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */ #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) @@ -5717,6 +6076,9 @@ int flock(int fd, int op); #define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */ #define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large numbers which are <= UV_MAX */ +#define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow trailing + and set IS_NUMBER_TRAILING */ + /* Output flags: */ #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */