#else
+# ifdef USE_LONG_DOUBLE
+# undef M_E
+# undef M_LOG2E
+# undef M_LOG10E
+# undef M_LN2
+# undef M_LN10
+# undef M_PI
+# undef M_PI_2
+# undef M_PI_4
+# undef M_1_PI
+# undef M_2_PI
+# undef M_2_SQRTPI
+# undef M_SQRT2
+# undef M_SQRT1_2
+# define FLOAT_C(c) CAT2(c,L)
+# else
+# define FLOAT_C(c) (c)
+# endif
+
# ifndef M_E
-# define M_E 2.71828182845904523536028747135266250
+# define M_E FLOAT_C(2.71828182845904523536028747135266250)
# endif
# ifndef M_LOG2E
-# define M_LOG2E 1.44269504088896340735992468100189214
+# define M_LOG2E FLOAT_C(1.44269504088896340735992468100189214)
# endif
# ifndef M_LOG10E
-# define M_LOG10E 0.434294481903251827651128918916605082
+# define M_LOG10E FLOAT_C(0.434294481903251827651128918916605082)
# endif
# ifndef M_LN2
-# define M_LN2 0.693147180559945309417232121458176568
+# define M_LN2 FLOAT_C(0.693147180559945309417232121458176568)
# endif
# ifndef M_LN10
-# define M_LN10 2.30258509299404568401799145468436421
+# define M_LN10 FLOAT_C(2.30258509299404568401799145468436421)
# endif
# ifndef M_PI
-# define M_PI 3.14159265358979323846264338327950288
+# define M_PI FLOAT_C(3.14159265358979323846264338327950288)
# endif
# ifndef M_PI_2
-# define M_PI_2 1.57079632679489661923132169163975144
+# define M_PI_2 FLOAT_C(1.57079632679489661923132169163975144)
# endif
# ifndef M_PI_4
-# define M_PI_4 0.785398163397448309615660845819875721
+# define M_PI_4 FLOAT_C(0.785398163397448309615660845819875721)
# endif
# ifndef M_1_PI
-# define M_1_PI 0.318309886183790671537767526745028724
+# define M_1_PI FLOAT_C(0.318309886183790671537767526745028724)
# endif
# ifndef M_2_PI
-# define M_2_PI 0.636619772367581343075535053490057448
+# define M_2_PI FLOAT_C(0.636619772367581343075535053490057448)
# endif
# ifndef M_2_SQRTPI
-# define M_2_SQRTPI 1.12837916709551257389615890312154517
+# define M_2_SQRTPI FLOAT_C(1.12837916709551257389615890312154517)
# endif
# ifndef M_SQRT2
-# define M_SQRT2 1.41421356237309504880168872420969808
+# define M_SQRT2 FLOAT_C(1.41421356237309504880168872420969808)
# endif
# ifndef M_SQRT1_2
-# define M_SQRT1_2 0.707106781186547524400844362104849039
+# define M_SQRT1_2 FLOAT_C(0.707106781186547524400844362104849039)
# endif
#endif
/* XXX Beware old gamma() -- one cannot know whether that is the
* gamma or the log of gamma, that's why the new tgamma and lgamma.
- * Though also remember tgamma_r and lgamma_r. */
-
-/* XXX The truthiness of acosh() is the canary for all of the
- * C99 math. This is very likely wrong, especially in non-UNIX lands
- * like Win32 and VMS, but also older UNIXes have issues. For Win32,
- * and other non-fully-C99, we later do some undefines for these interfaces.
- *
- * But we are very trying very hard to avoid introducing separate Configure
- * symbols for all the 40-ish new math symbols. Especially since the set
- * of missing functions doesn't seem to follow any patterns. */
-
-#ifdef HAS_ACOSH
+ * Though also remember lgamma_r. */
/* Certain AIX releases have the C99 math, but not in long double.
* The <math.h> has them, e.g. __expl128, but no library has them!
*
* Also see the comments in hints/aix.sh about long doubles. */
-# if defined(USE_QUADMATH) && defined(I_QUADMATH)
-# define c99_acosh acoshq
-# define c99_asinh asinhq
-# define c99_atanh atanhq
-# define c99_cbrt cbrtq
-# define c99_copysign copysignq
-# define c99_erf erfq
-# define c99_erfc erfcq
+#if defined(USE_QUADMATH) && defined(I_QUADMATH)
+# define c99_acosh acoshq
+# define c99_asinh asinhq
+# define c99_atanh atanhq
+# define c99_cbrt cbrtq
+# define c99_copysign copysignq
+# define c99_erf erfq
+# define c99_erfc erfcq
/* no exp2q */
-# define c99_expm1 expm1q
-# define c99_fdim fdimq
-# define c99_fma fmaq
-# define c99_fmax fmaxq
-# define c99_fmin fminq
-# define c99_hypot hypotq
-# define c99_ilogb ilogbq
-# define c99_lgamma lgammaq
-# define c99_log1p log1pq
-# define c99_log2 log2q
+# define c99_expm1 expm1q
+# define c99_fdim fdimq
+# define c99_fma fmaq
+# define c99_fmax fmaxq
+# define c99_fmin fminq
+# define c99_hypot hypotq
+# define c99_ilogb ilogbq
+# define c99_lgamma lgammaq
+# define c99_log1p log1pq
+# define c99_log2 log2q
/* no logbq */
-/* no llrintq */
-/* no llroundq */
+# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
+# define c99_lrint llrintq
+# define c99_lround llroundq
+# else
# define c99_lrint lrintq
# define c99_lround lroundq
-# define c99_nan nanq
-# define c99_nearbyint nearbyintq
-# define c99_nextafter nextafterq
+# endif
+# define c99_nan nanq
+# define c99_nearbyint nearbyintq
+# define c99_nextafter nextafterq
/* no nexttowardq */
-# define c99_remainder remainderq
-# define c99_remquo remquoq
-# define c99_rint rintq
-# define c99_round roundq
-# define c99_scalbn scalbnq
-# define c99_signbit signbitq
-# define c99_tgamma tgammal
-# define c99_trunc truncq
-# define bessel_j0 j0q
-# define bessel_j1 j1q
-# define bessel_jn jnq
-# define bessel_y0 y0q
-# define bessel_y1 y1q
-# define bessel_yn ynq
-# elif defined(USE_LONG_DOUBLE) && \
- !defined(NO_C99_LONG_DOUBLE_MATH) && \
- defined(HAS_ILOGBL)
-/* There's already a symbol for ilogbl, we will use its truthiness
- * as the canary for all the *l variants being defined. */
-# define c99_acosh acoshl
-# define c99_asinh asinhl
-# define c99_atanh atanhl
-# define c99_cbrt cbrtl
-# define c99_copysign copysignl
-# define c99_erf erfl
-# define c99_erfc erfcl
-# define c99_exp2 exp2l
-# define c99_expm1 expm1l
-# define c99_fdim fdiml
-# define c99_fma fmal
-# define c99_fmax fmaxl
-# define c99_fmin fminl
-# define c99_hypot hypotl
-# define c99_ilogb ilogbl
-# define c99_lgamma lgammal
-# define c99_log1p log1pl
-# define c99_log2 log2l
-# define c99_logb logbl
-# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-# define c99_lrint llrintl
-# else
-# define c99_lrint lrintl
-# endif
-# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-# define c99_lround llroundl
-# else
-# define c99_lround lroundl
-# endif
-# define c99_nan nanl
-# define c99_nearbyint nearbyintl
-# define c99_nextafter nextafterl
-# define c99_nexttoward nexttowardl
-# define c99_remainder remainderl
-# define c99_remquo remquol
-# define c99_rint rintl
-# define c99_round roundl
-# define c99_scalbn scalbnl
-# ifdef HAS_SIGNBIT /* possibly bad assumption */
-# define c99_signbit signbitl
-# endif
-# define c99_tgamma tgammal
-# define c99_trunc truncl
+# define c99_remainder remainderq
+# define c99_remquo remquoq
+# define c99_rint rintq
+# define c99_round roundq
+# define c99_scalbn scalbnq
+# define c99_signbit signbitq
+# define c99_tgamma tgammaq
+# define c99_trunc truncq
+# define bessel_j0 j0q
+# define bessel_j1 j1q
+# define bessel_jn jnq
+# define bessel_y0 y0q
+# define bessel_y1 y1q
+# define bessel_yn ynq
+#elif defined(USE_LONG_DOUBLE) && \
+ (defined(HAS_FREXPL) || defined(HAS_ILOGBL)) && defined(HAS_SQRTL)
+/* Use some of the Configure scans for long double math functions
+ * as the canary for all the C99 *l variants being defined. */
+# define c99_acosh acoshl
+# define c99_asinh asinhl
+# define c99_atanh atanhl
+# define c99_cbrt cbrtl
+# define c99_copysign copysignl
+# define c99_erf erfl
+# define c99_erfc erfcl
+# define c99_exp2 exp2l
+# define c99_expm1 expm1l
+# define c99_fdim fdiml
+# define c99_fma fmal
+# define c99_fmax fmaxl
+# define c99_fmin fminl
+# define c99_hypot hypotl
+# define c99_ilogb ilogbl
+# define c99_lgamma lgammal
+# define c99_log1p log1pl
+# define c99_log2 log2l
+# define c99_logb logbl
+# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLRINTL)
+# define c99_lrint llrintl
+# elif defined(HAS_LRINTL)
+# define c99_lrint lrintl
+# endif
+# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLROUNDL)
+# define c99_lround llroundl
+# elif defined(HAS_LROUNDL)
+# define c99_lround lroundl
+# endif
+# define c99_nan nanl
+# define c99_nearbyint nearbyintl
+# define c99_nextafter nextafterl
+# define c99_nexttoward nexttowardl
+# define c99_remainder remainderl
+# define c99_remquo remquol
+# define c99_rint rintl
+# define c99_round roundl
+# define c99_scalbn scalbnl
+# ifdef HAS_SIGNBIT /* possibly bad assumption */
+# define c99_signbit signbitl
+# endif
+# define c99_tgamma tgammal
+# define c99_trunc truncl
+#else
+# define c99_acosh acosh
+# define c99_asinh asinh
+# define c99_atanh atanh
+# define c99_cbrt cbrt
+# define c99_copysign copysign
+# define c99_erf erf
+# define c99_erfc erfc
+# define c99_exp2 exp2
+# define c99_expm1 expm1
+# define c99_fdim fdim
+# define c99_fma fma
+# define c99_fmax fmax
+# define c99_fmin fmin
+# define c99_hypot hypot
+# define c99_ilogb ilogb
+# define c99_lgamma lgamma
+# define c99_log1p log1p
+# define c99_log2 log2
+# define c99_logb logb
+# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLRINT)
+# define c99_lrint llrint
# else
-# define c99_acosh acosh
-# define c99_asinh asinh
-# define c99_atanh atanh
-# define c99_cbrt cbrt
-# define c99_copysign copysign
-# define c99_erf erf
-# define c99_erfc erfc
-# define c99_exp2 exp2
-# define c99_expm1 expm1
-# define c99_fdim fdim
-# define c99_fma fma
-# define c99_fmax fmax
-# define c99_fmin fmin
-# define c99_hypot hypot
-# define c99_ilogb ilogb
-# define c99_lgamma lgamma
-# define c99_log1p log1p
-# define c99_log2 log2
-# define c99_logb logb
-# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-# define c99_lrint llrint
-# else
-# define c99_lrint lrint
-# endif
-# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-# define c99_lround llround
-# else
-# define c99_lround lround
-# endif
-# define c99_nan nan
-# define c99_nearbyint nearbyint
-# define c99_nextafter nextafter
-# define c99_nexttoward nexttoward
-# define c99_remainder remainder
-# define c99_remquo remquo
-# define c99_rint rint
-# define c99_round round
-# define c99_scalbn scalbn
+# define c99_lrint lrint
+# endif
+# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLROUND)
+# define c99_lround llround
+# else
+# define c99_lround lround
+# endif
+# define c99_nan nan
+# define c99_nearbyint nearbyint
+# define c99_nextafter nextafter
+# define c99_nexttoward nexttoward
+# define c99_remainder remainder
+# define c99_remquo remquo
+# define c99_rint rint
+# define c99_round round
+# define c99_scalbn scalbn
/* We already define Perl_signbit in perl.h. */
-# ifdef HAS_SIGNBIT
-# define c99_signbit signbit
-# endif
-# define c99_tgamma tgamma
-# define c99_trunc trunc
+# ifdef HAS_SIGNBIT
+# define c99_signbit signbit
# endif
+# define c99_tgamma tgamma
+# define c99_trunc trunc
+#endif
-# ifndef isunordered
-# ifdef Perl_isnan
-# define isunordered(x, y) (Perl_isnan(x) || Perl_isnan(y))
-# elif defined(HAS_UNORDERED)
-# define isunordered(x, y) unordered(x, y)
-# endif
+/* AIX xlc (__IBMC__) really doesn't have the following long double
+ * math interfaces (no __acoshl128 aka acoshl, etc.), see
+ * hints/aix.sh. These are in the -lc128 but fail to be found
+ * during dynamic linking/loading.
+ *
+ * XXX1 Better Configure scans
+ * XXX2 Is this xlc version dependent? */
+#if defined(USE_LONG_DOUBLE) && defined(__IBMC__)
+# undef c99_acosh
+# undef c99_asinh
+# undef c99_atanh
+# undef c99_cbrt
+# undef c99_copysign
+# undef c99_exp2
+# undef c99_expm1
+# undef c99_fdim
+# undef c99_fma
+# undef c99_fmax
+# undef c99_fmin
+# undef c99_hypot
+# undef c99_ilogb
+# undef c99_lrint
+# undef c99_lround
+# undef c99_log1p
+# undef c99_log2
+# undef c99_logb
+# undef c99_nan
+# undef c99_nearbyint
+# undef c99_nextafter
+# undef c99_nexttoward
+# undef c99_remainder
+# undef c99_remquo
+# undef c99_rint
+# undef c99_round
+# undef c99_scalbn
+# undef c99_tgamma
+# undef c99_trunc
+#endif
+
+#ifndef isunordered
+# ifdef Perl_isnan
+# define isunordered(x, y) (Perl_isnan(x) || Perl_isnan(y))
+# elif defined(HAS_UNORDERED)
+# define isunordered(x, y) unordered(x, y)
# endif
+#endif
/* XXX these isgreater/isnormal/isunordered macros definitions should
* be moved further in the file to be part of the emulations, so that
* platforms can e.g. #undef c99_isunordered and have it work like
* it does for the other interfaces. */
-# if !defined(isgreater) && defined(isunordered)
-# define isgreater(x, y) (!isunordered((x), (y)) && (x) > (y))
-# define isgreaterequal(x, y) (!isunordered((x), (y)) && (x) >= (y))
-# define isless(x, y) (!isunordered((x), (y)) && (x) < (y))
-# define islessequal(x, y) (!isunordered((x), (y)) && (x) <= (y))
-# define islessgreater(x, y) (!isunordered((x), (y)) && \
+#if !defined(isgreater) && defined(isunordered)
+# define isgreater(x, y) (!isunordered((x), (y)) && (x) > (y))
+# define isgreaterequal(x, y) (!isunordered((x), (y)) && (x) >= (y))
+# define isless(x, y) (!isunordered((x), (y)) && (x) < (y))
+# define islessequal(x, y) (!isunordered((x), (y)) && (x) <= (y))
+# define islessgreater(x, y) (!isunordered((x), (y)) && \
((x) > (y) || (y) > (x)))
-# endif
+#endif
/* Check both the Configure symbol and the macro-ness (like C99 promises). */
-# if defined(HAS_FPCLASSIFY) && defined(fpclassify)
-# define c99_fpclassify fpclassify
-# endif
+#if defined(HAS_FPCLASSIFY) && defined(fpclassify)
+# define c99_fpclassify fpclassify
+#endif
/* Like isnormal(), the isfinite(), isinf(), and isnan() are also C99
and also (sizeof-arg-aware) macros, but they are already well taken
care of by Configure et al, and defined in perl.h as
Perl_isfinite(), Perl_isinf(), and Perl_isnan(). */
-# ifdef isnormal
-# define c99_isnormal isnormal
-# endif
-# ifdef isgreater /* canary for all the C99 is*<cmp>* macros. */
-# define c99_isgreater isgreater
-# define c99_isgreaterequal isgreaterequal
-# define c99_isless isless
-# define c99_islessequal islessequal
-# define c99_islessgreater islessgreater
-# define c99_isunordered isunordered
-# endif
+#ifdef isnormal
+# define c99_isnormal isnormal
#endif
-
-/* If on legacy platforms, and not using gcc, some C99 math interfaces
- * might be missing, turn them off so that the emulations hopefully
- * kick in. This is admittedly nasty, and fragile, but the alternative
- * is to have Configure scans for all the 40+ interfaces.
- *
- * For some platforms, also the gcc implementations are missing
- * certain interfaces.
- *
- * In other words: if you have an incomplete (or broken) C99 math interface,
- * #undef the c99_foo here, and let the emulations kick in. */
-
-#ifdef __GNUC__
-
-/* using gcc */
-
-# if defined(__hpux) && (defined(__hppa) || defined(_PA_RISC))
-# undef c99_nexttoward
-# undef c99_tgamma
-# endif
-
-#else
-
-/* not using gcc */
-
-# if defined(_AIX53) || defined(_AIX61) /* AIX 7 has nexttoward */
-# undef c99_nexttoward
-# endif
-
-/* HP-UX on PA-RISC is missing certain C99 math functions,
- * but on IA64 (Integrity) these do exist, and even on
- * recent enough HP-UX (cc) releases. */
-# if defined(__hpux) && (defined(__hppa) || defined(_PA_RISC))
-/* lowest known release, could be lower */
-# if defined(__HP_cc) && __HP_cc >= 111120
-# undef c99_fma
-# undef c99_nexttoward
-# undef c99_tgamma
-# else
-# undef c99_exp2
-# undef c99_fdim
-# undef c99_fma
-# undef c99_fmax
-# undef c99_fmin
-# undef c99_fpclassify /* hpux 10.20 has fpclassify but different api */
-# undef c99_lrint
-# undef c99_lround
-# undef c99_nan
-# undef c99_nearbyint
-# undef c99_nexttoward
-# undef c99_remquo
-# undef c99_round
-# undef c99_scalbn
-# undef c99_tgamma
-# undef c99_trunc
-# endif
-# endif
-
-# if defined(__irix__)
-# undef c99_ilogb
-# undef c99_exp2
-# endif
-
-# if defined(__osf__) /* Tru64 */
-# undef c99_fdim
-# undef c99_fma
-# undef c99_fmax
-# undef c99_fmin
-# undef c99_fpclassify
-# undef c99_isfinite
-# undef c99_isinf
-/* Tru64 is missing isunordered but we have emulation. */
-# undef c99_lrint
-# undef c99_lround
-# undef c99_nan /* in libm, but seems broken (no proto, either) */
-# undef c99_nearbyint
-# undef c99_nexttoward
-# undef c99_remquo
-# undef c99_round
-# undef c99_scalbn
-# endif
-
+#ifdef isgreater /* canary for all the C99 is*<cmp>* macros. */
+# define c99_isgreater isgreater
+# define c99_isgreaterequal isgreaterequal
+# define c99_isless isless
+# define c99_islessequal islessequal
+# define c99_islessgreater islessgreater
+# define c99_isunordered isunordered
#endif
-/* NetBSD 5.1 appears to be missing:
-
- nexttoward nearbyint exp2 tgamma fma remquo
-
- */
-
-#if defined(__NetBSD__)
-# undef c99_nexttoward
-# undef c99_nearbyint
-# undef c99_exp2
-# undef c99_tgamma
-# undef c99_fma
-# undef c99_remquo
-# endif
-
-/* XXX Regarding C99 math.h, Android seems to be missing these:
-
- For API level < 13
- nan log2 nexttoward
-
- For API level < 18
- log2 nexttoward
-
- See https://android.googlesource.com/platform/development/+/b280e72a97736930063e947fe5fcda7a191e7b10/ndk/platforms/android-9/include/math.h
- */
+/* The Great Wall of Undef where according to the definedness of HAS_FOO symbols
+ * the corresponding c99_foo wrappers are undefined. This list doesn't include
+ * the isfoo() interfaces because they are either type-aware macros, or dealt
+ * separately, already in perl.h */
-#ifdef __ANDROID__
-# include <android/api-level.h>
-# if __ANDROID_API__ < 13
-# undef c99_nan
-# endif
-# if __ANDROID_API__ < 17
-# undef c99_log2
-# undef c99_nexttoward
-# endif
+#ifndef HAS_ACOSH
+# undef c99_acosh
#endif
-
-
-/* XXX Regarding C99 math.h, VMS seems to be missing these:
-
- lround nan nearbyint round scalbn llrint
- */
-
-#ifdef __VMS
-# undef c99_lround
-# undef c99_nan
-# undef c99_nearbyint
-# undef c99_round
-# undef c99_scalbn
-/* Have lrint but not llrint. */
-# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-# undef c99_lrint
-# endif
+#ifndef HAS_ASINH
+# undef c99_asinh
#endif
-
-/* XXX Regarding C99 math.h, Win32 seems to be missing these:
-
- erf erfc exp2 fdim fma fmax fmin fpclassify ilogb lgamma log1p log2 lrint
- remquo rint signbit tgamma trunc
-
- Win32 does seem to have these:
-
- acosh asinh atanh cbrt copysign cosh expm1 hypot log10 nan
- nearbyint nextafter nexttoward remainder round scalbn
-
- And the Bessel functions are defined like _this.
-*/
-
-#ifdef WIN32
+#ifndef HAS_ATANH
+# undef c99_atanh
+#endif
+#ifndef HAS_CBRT
+# undef c99_cbrt
+#endif
+#ifndef HAS_COPYSIGN
+# undef c99_copysign
+#endif
+#ifndef HAS_ERF
# undef c99_erf
+#endif
+#ifndef HAS_ERFC
# undef c99_erfc
+#endif
+#ifndef HAS_EXP2
# undef c99_exp2
+#endif
+#ifndef HAS_EXPM1
+# undef c99_expm1
+#endif
+#ifndef HAS_FDIM
# undef c99_fdim
+#endif
+#ifndef HAS_FMA
# undef c99_fma
+#endif
+#ifndef HAS_FMAX
# undef c99_fmax
+#endif
+#ifndef HAS_FMIN
# undef c99_fmin
+#endif
+#ifndef HAS_FPCLASSIFY
+# undef c99_fpclassify
+#endif
+#ifndef HAS_HYPOT
+# undef c99_hypot
+#endif
+#ifndef HAS_ILOGB
# undef c99_ilogb
+#endif
+#ifndef HAS_LGAMMA
# undef c99_lgamma
+#endif
+#ifndef HAS_LOG1P
# undef c99_log1p
+#endif
+#ifndef HAS_LOG2
# undef c99_log2
+#endif
+#ifndef HAS_LOGB
+# undef c99_logb
+#endif
+#ifndef HAS_LRINT
# undef c99_lrint
+#endif
+#ifndef HAS_LROUND
# undef c99_lround
+#endif
+#ifndef HAS_NAN
+# undef c99_nan
+#endif
+#ifndef HAS_NEARBYINT
+# undef c99_nearbyint
+#endif
+#ifndef HAS_NEXTAFTER
+# undef c99_nextafter
+#endif
+#ifndef HAS_NEXTTOWARD
+# undef c99_nexttoward
+#endif
+#ifndef HAS_REMAINDER
+# undef c99_remainder
+#endif
+#ifndef HAS_REMQUO
# undef c99_remquo
+#endif
+#ifndef HAS_RINT
# undef c99_rint
+#endif
+#ifndef HAS_ROUND
+# undef c99_round
+#endif
+#ifndef HAS_SCALBN
+# undef c99_scalbn
+#endif
+#ifndef HAS_SIGNBIT
# undef c99_signbit
+#endif
+#ifndef HAS_TGAMMA
# undef c99_tgamma
+#endif
+#ifndef HAS_TRUNC
# undef c99_trunc
+#endif
+
+#ifdef WIN32
/* Some APIs exist under Win32 with "underbar" names. */
# undef c99_hypot
#endif
-#ifdef __CYGWIN__
-# undef c99_nexttoward
-#endif
-
/* The Bessel functions: BSD, SVID, XPG4, and POSIX. But not C99. */
#if defined(HAS_J0) && !defined(bessel_j0)
# if defined(USE_LONG_DOUBLE) && defined(HAS_J0L)
#ifndef c99_fdim
static NV my_fdim(NV x, NV y)
{
- return x > y ? x - y : 0;
+ return (Perl_isnan(x) || Perl_isnan(y)) ? NV_NAN : (x > y ? x - y : 0);
}
# define c99_fdim my_fdim
#endif
+#ifndef c99_fma
+static NV my_fma(NV x, NV y, NV z)
+{
+ return (x * y) + z;
+}
+# define c99_fma my_fma
+#endif
+
#ifndef c99_fmax
static NV my_fmax(NV x, NV y)
{
# define c99_ilogb my_ilogb
#endif
-/* XXX lgamma -- non-trivial */
+/* tgamma and lgamma emulations based on
+ * http://www.johndcook.com/cpp_gamma.html,
+ * code placed in public domain.
+ *
+ * Note that these implementations (neither the johndcook originals
+ * nor these) do NOT set the global signgam variable. This is not
+ * necessarily a bad thing. */
+
+/* Note that the tgamma() and lgamma() implementations
+ * here depend on each other. */
+
+#if !defined(HAS_TGAMMA) || !defined(c99_tgamma)
+static NV my_tgamma(NV x);
+# define c99_tgamma my_tgamma
+# define USE_MY_TGAMMA
+#endif
+#if !defined(HAS_LGAMMA) || !defined(c99_lgamma)
+static NV my_lgamma(NV x);
+# define c99_lgamma my_lgamma
+# define USE_MY_LGAMMA
+#endif
+
+#ifdef USE_MY_TGAMMA
+static NV my_tgamma(NV x)
+{
+ const NV gamma = 0.577215664901532860606512090; /* Euler's gamma constant. */
+ if (Perl_isnan(x) || x < 0.0)
+ return NV_NAN;
+ if (x == 0.0 || x == NV_INF)
+ return x == -0.0 ? -NV_INF : NV_INF;
+
+ /* The function domain is split into three intervals:
+ * (0, 0.001), [0.001, 12), and (12, infinity) */
+
+ /* First interval: (0, 0.001)
+ * For small values, 1/tgamma(x) has power series x + gamma x^2,
+ * so in this range, 1/tgamma(x) = x + gamma x^2 with error on the order of x^3.
+ * The relative error over this interval is less than 6e-7. */
+ if (x < 0.001)
+ return 1.0 / (x * (1.0 + gamma * x));
+
+ /* Second interval: [0.001, 12) */
+ if (x < 12.0) {
+ double y = x; /* Working copy. */
+ int n = 0;
+ /* Numerator coefficients for approximation over the interval (1,2) */
+ static const NV p[] = {
+ -1.71618513886549492533811E+0,
+ 2.47656508055759199108314E+1,
+ -3.79804256470945635097577E+2,
+ 6.29331155312818442661052E+2,
+ 8.66966202790413211295064E+2,
+ -3.14512729688483675254357E+4,
+ -3.61444134186911729807069E+4,
+ 6.64561438202405440627855E+4
+ };
+ /* Denominator coefficients for approximation over the interval (1, 2) */
+ static const NV q[] = {
+ -3.08402300119738975254353E+1,
+ 3.15350626979604161529144E+2,
+ -1.01515636749021914166146E+3,
+ -3.10777167157231109440444E+3,
+ 2.25381184209801510330112E+4,
+ 4.75584627752788110767815E+3,
+ -1.34659959864969306392456E+5,
+ -1.15132259675553483497211E+5
+ };
+ NV num = 0.0;
+ NV den = 1.0;
+ NV z;
+ NV result;
+ int i;
+
+ if (x < 1.0)
+ y += 1.0;
+ else {
+ n = (int)Perl_floor(y) - 1;
+ y -= n;
+ }
+ z = y - 1;
+ for (i = 0; i < 8; i++) {
+ num = (num + p[i]) * z;
+ den = den * z + q[i];
+ }
+ result = num / den + 1.0;
+
+ if (x < 1.0) {
+ /* Use the identity tgamma(z) = tgamma(z+1)/z
+ * The variable "result" now holds tgamma of the original y + 1
+ * Thus we use y - 1 to get back the original y. */
+ result /= (y - 1.0);
+ }
+ else {
+ /* Use the identity tgamma(z+n) = z*(z+1)* ... *(z+n-1)*tgamma(z) */
+ for (i = 0; i < n; i++)
+ result *= y++;
+ }
+
+ return result;
+ }
+
+ /* Third interval: [12, +Inf) */
+#if LDBL_MANT_DIG == 113 /* IEEE quad prec */
+ if (x > 1755.548) {
+ return NV_INF;
+ }
+#else
+ if (x > 171.624) {
+ return NV_INF;
+ }
+#endif
+
+ return Perl_exp(c99_lgamma(x));
+}
+#endif
+
+#ifdef USE_MY_LGAMMA
+static NV my_lgamma(NV x)
+{
+ if (Perl_isnan(x))
+ return NV_NAN;
+ if (x <= 0 || x == NV_INF)
+ return NV_INF;
+ if (x == 1.0 || x == 2.0)
+ return 0;
+ if (x < 12.0)
+ return Perl_log(PERL_ABS(c99_tgamma(x)));
+ /* Abramowitz and Stegun 6.1.41
+ * Asymptotic series should be good to at least 11 or 12 figures
+ * For error analysis, see Whittiker and Watson
+ * A Course in Modern Analysis (1927), page 252 */
+ {
+ static const NV c[8] = {
+ 1.0/12.0,
+ -1.0/360.0,
+ 1.0/1260.0,
+ -1.0/1680.0,
+ 1.0/1188.0,
+ -691.0/360360.0,
+ 1.0/156.0,
+ -3617.0/122400.0
+ };
+ NV z = 1.0 / (x * x);
+ NV sum = c[7];
+ static const NV half_log_of_two_pi =
+ 0.91893853320467274178032973640562;
+ NV series;
+ int i;
+ for (i = 6; i >= 0; i--) {
+ sum *= z;
+ sum += c[i];
+ }
+ series = sum / x;
+ return (x - 0.5) * Perl_log(x) - x + half_log_of_two_pi + series;
+ }
+}
+#endif
#ifndef c99_log1p
static NV my_log1p(NV x)
/* XXX sinh (though c89) */
-#ifndef c99_tgamma
-# ifdef c99_lgamma
-static NV my_tgamma(NV x)
-{
- double l = c99_lgamma(x);
- return signgam * Perl_exp(l); /* XXX evil global signgam, need lgamma_r */
-}
-# define c99_tgamma my_tgamma
-/* XXX tgamma without lgamma -- non-trivial */
-# endif
-#endif
+/* tgamma -- see lgamma */
/* XXX tanh (though c89) */
# define c99_trunc my_trunc
#endif
+#undef NV_PAYLOAD_DEBUG
+
+/* NOTE: the NaN payload API implementation is hand-rolled, since the
+ * APIs are only proposed ones as of June 2015, so very few, if any,
+ * platforms have implementations yet, so HAS_SETPAYLOAD and such are
+ * unlikely to be helpful.
+ *
+ * XXX - if the core numification wants to actually generate
+ * the nan payload in "nan(123)", and maybe "nans(456)", for
+ * signaling payload", this needs to be moved to e.g. numeric.c
+ * (look for grok_infnan)
+ *
+ * Conversely, if the core stringification wants the nan payload
+ * and/or the nan quiet/signaling distinction, S_getpayload()
+ * from this file needs to be moved, to e.g. sv.c (look for S_infnan_2pv),
+ * and the (trivial) functionality of issignaling() copied
+ * (for generating "NaNS", or maybe even "NaNQ") -- or maybe there
+ * are too many formatting parameters for simple stringification?
+ */
+
+/* While it might make sense for the payload to be UV or IV,
+ * to avoid conversion loss, the proposed ISO interfaces use
+ * a floating point input, which is then truncated to integer,
+ * and only the integer part being used. This is workable,
+ * except for: (1) the conversion loss (2) suboptimal for
+ * 32-bit integer platforms. A workaround API for (2) and
+ * in general for bit-honesty would be an array of integers
+ * as the payload... but the proposed C API does nothing of
+ * the kind. */
+#if NVSIZE == UVSIZE
+# define NV_PAYLOAD_TYPE UV
+#else
+# define NV_PAYLOAD_TYPE NV
+#endif
+
+#ifdef LONGDOUBLE_DOUBLEDOUBLE
+# define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE / 2)
+#else
+# define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE)
+#endif
+
+static void S_setpayload(NV* nvp, NV_PAYLOAD_TYPE payload, bool signaling)
+{
+ dTHX;
+ static const U8 m[] = { NV_NAN_PAYLOAD_MASK };
+ static const U8 p[] = { NV_NAN_PAYLOAD_PERM };
+ UV a[(NVSIZE + UVSIZE - 1) / UVSIZE] = { 0 };
+ int i;
+ NV_PAYLOAD_SIZEOF_ASSERT(m);
+ NV_PAYLOAD_SIZEOF_ASSERT(p);
+ *nvp = NV_NAN;
+ /* Divide the input into the array in "base unsigned integer" in
+ * little-endian order. Note that the integer might be smaller than
+ * an NV (if UV is U32, for example). */
+#if NVSIZE == UVSIZE
+ a[0] = payload; /* The trivial case. */
+#else
+ {
+ NV t1 = c99_trunc(payload); /* towards zero (drop fractional) */
+#ifdef NV_PAYLOAD_DEBUG
+ Perl_warn(aTHX_ "t1 = %"NVgf" (payload %"NVgf")\n", t1, payload);
+#endif
+ if (t1 <= UV_MAX) {
+ a[0] = (UV)t1; /* Fast path, also avoids rounding errors (right?) */
+ } else {
+ /* UVSIZE < NVSIZE or payload > UV_MAX.
+ *
+ * This may happen for example if:
+ * (1) UVSIZE == 32 and common 64-bit double NV
+ * (32-bit system not using -Duse64bitint)
+ * (2) UVSIZE == 64 and the x86-style 80-bit long double NV
+ * (note that here the room for payload is actually the 64 bits)
+ * (3) UVSIZE == 64 and the 128-bit IEEE 764 quadruple NV
+ * (112 bits in mantissa, 111 bits room for payload)
+ *
+ * NOTE: this is very sensitive to correctly functioning
+ * fmod()/fmodl(), and correct casting of big-unsigned-integer to NV.
+ * If these don't work right, especially the low order bits
+ * are in danger. For example Solaris and AIX seem to have issues
+ * here, especially if using 32-bit UVs. */
+ NV t2;
+ for (i = 0, t2 = t1; i < (int)C_ARRAY_LENGTH(a); i++) {
+ a[i] = (UV)Perl_fmod(t2, (NV)UV_MAX);
+ t2 = Perl_floor(t2 / (NV)UV_MAX);
+ }
+ }
+ }
+#endif
+#ifdef NV_PAYLOAD_DEBUG
+ for (i = 0; i < (int)C_ARRAY_LENGTH(a); i++) {
+ Perl_warn(aTHX_ "a[%d] = 0x%"UVxf"\n", i, a[i]);
+ }
+#endif
+ for (i = 0; i < (int)sizeof(p); i++) {
+ if (m[i] && p[i] < sizeof(p)) {
+ U8 s = (p[i] % UVSIZE) << 3;
+ UV u = a[p[i] / UVSIZE] & ((UV)0xFF << s);
+ U8 b = (U8)((u >> s) & m[i]);
+ ((U8 *)(nvp))[i] &= ~m[i]; /* For NaNs with non-zero payload bits. */
+ ((U8 *)(nvp))[i] |= b;
+#ifdef NV_PAYLOAD_DEBUG
+ Perl_warn(aTHX_ "set p[%2d] = %02x (i = %d, m = %02x, s = %2d, b = %02x, u = %08"UVxf")\n", i, ((U8 *)(nvp))[i], i, m[i], s, b, u);
+#endif
+ a[p[i] / UVSIZE] &= ~u;
+ }
+ }
+ if (signaling) {
+ NV_NAN_SET_SIGNALING(nvp);
+ }
+#ifdef USE_LONG_DOUBLE
+# if LONG_DOUBLEKIND == 3 || LONG_DOUBLEKIND == 4
+ memset((char *)nvp + 10, '\0', LONG_DOUBLESIZE - 10); /* x86 long double */
+# endif
+#endif
+ for (i = 0; i < (int)C_ARRAY_LENGTH(a); i++) {
+ if (a[i]) {
+ Perl_warn(aTHX_ "payload lost bits (%"UVxf")", a[i]);
+ break;
+ }
+ }
+#ifdef NV_PAYLOAD_DEBUG
+ for (i = 0; i < NVSIZE; i++) {
+ PerlIO_printf(Perl_debug_log, "%02x ", ((U8 *)(nvp))[i]);
+ }
+ PerlIO_printf(Perl_debug_log, "\n");
+#endif
+}
+
+static NV_PAYLOAD_TYPE S_getpayload(NV nv)
+{
+ dTHX;
+ static const U8 m[] = { NV_NAN_PAYLOAD_MASK };
+ static const U8 p[] = { NV_NAN_PAYLOAD_PERM };
+ UV a[(NVSIZE + UVSIZE - 1) / UVSIZE] = { 0 };
+ int i;
+ NV payload;
+ NV_PAYLOAD_SIZEOF_ASSERT(m);
+ NV_PAYLOAD_SIZEOF_ASSERT(p);
+ payload = 0;
+ for (i = 0; i < (int)sizeof(p); i++) {
+ if (m[i] && p[i] < NVSIZE) {
+ U8 s = (p[i] % UVSIZE) << 3;
+ a[p[i] / UVSIZE] |= (UV)(((U8 *)(&nv))[i] & m[i]) << s;
+ }
+ }
+ for (i = (int)C_ARRAY_LENGTH(a) - 1; i >= 0; i--) {
+#ifdef NV_PAYLOAD_DEBUG
+ Perl_warn(aTHX_ "a[%d] = %"UVxf"\n", i, a[i]);
+#endif
+ payload *= UV_MAX;
+ payload += a[i];
+ }
+#ifdef NV_PAYLOAD_DEBUG
+ for (i = 0; i < NVSIZE; i++) {
+ PerlIO_printf(Perl_debug_log, "%02x ", ((U8 *)(&nv))[i]);
+ }
+ PerlIO_printf(Perl_debug_log, "\n");
+#endif
+ return payload;
+}
+
/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
metaconfig for future extension writers. We don't use them in POSIX.
(This is really sneaky :-) --AD
# define setuid(a) not_here("setuid")
# define setgid(a) not_here("setgid")
#endif /* NETWARE */
+#ifndef USE_LONG_DOUBLE
# define strtold(s1,s2) not_here("strtold")
+#endif /* USE_LONG_DOUBLE */
#else
# ifndef HAS_MKFIFO
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
"Calling POSIX::%"HEKf"() is deprecated",
HEKfARG(GvNAME_HEK(CvGV(cv))));
- hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
+ (void)hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
}
}
BOOT:
{
CV *cv;
- const char *file = __FILE__;
/* silence compiler warning about not_here() defined but not used */
/* Ensure we get the function, not a macro implementation. Like the C89
standard says we can... */
#undef isalnum
- cv = newXS("POSIX::isalnum", is_common, file);
+ cv = newXS_deffile("POSIX::isalnum", is_common);
XSANY.any_dptr = (any_dptr_t) &isalnum;
#undef isalpha
- cv = newXS("POSIX::isalpha", is_common, file);
+ cv = newXS_deffile("POSIX::isalpha", is_common);
XSANY.any_dptr = (any_dptr_t) &isalpha;
#undef iscntrl
- cv = newXS("POSIX::iscntrl", is_common, file);
+ cv = newXS_deffile("POSIX::iscntrl", is_common);
XSANY.any_dptr = (any_dptr_t) &iscntrl;
#undef isdigit
- cv = newXS("POSIX::isdigit", is_common, file);
+ cv = newXS_deffile("POSIX::isdigit", is_common);
XSANY.any_dptr = (any_dptr_t) &isdigit;
#undef isgraph
- cv = newXS("POSIX::isgraph", is_common, file);
+ cv = newXS_deffile("POSIX::isgraph", is_common);
XSANY.any_dptr = (any_dptr_t) &isgraph;
#undef islower
- cv = newXS("POSIX::islower", is_common, file);
+ cv = newXS_deffile("POSIX::islower", is_common);
XSANY.any_dptr = (any_dptr_t) &islower;
#undef isprint
- cv = newXS("POSIX::isprint", is_common, file);
+ cv = newXS_deffile("POSIX::isprint", is_common);
XSANY.any_dptr = (any_dptr_t) &isprint;
#undef ispunct
- cv = newXS("POSIX::ispunct", is_common, file);
+ cv = newXS_deffile("POSIX::ispunct", is_common);
XSANY.any_dptr = (any_dptr_t) &ispunct;
#undef isspace
- cv = newXS("POSIX::isspace", is_common, file);
+ cv = newXS_deffile("POSIX::isspace", is_common);
XSANY.any_dptr = (any_dptr_t) &isspace;
#undef isupper
- cv = newXS("POSIX::isupper", is_common, file);
+ cv = newXS_deffile("POSIX::isupper", is_common);
XSANY.any_dptr = (any_dptr_t) &isupper;
#undef isxdigit
- cv = newXS("POSIX::isxdigit", is_common, file);
+ cv = newXS_deffile("POSIX::isxdigit", is_common);
XSANY.any_dptr = (any_dptr_t) &isxdigit;
}
#endif
break;
default:
- Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
+ croak("Illegal alias %d for POSIX::W*", (int)ix);
}
OUTPUT:
RETVAL
/* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
* LC_MONETARY is already in the correct locale */
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
RETVAL = newHV();
sv_2mortal((SV*)RETVAL);
const struct lconv_offset *integers = lconv_integers;
const char *ptr = (const char *) lcbuf;
- do {
+ while (strings->name) {
/* This string may be controlled by either LC_NUMERIC, or
* LC_MONETARY */
bool is_utf8_locale
strlen(value),
/* We mark it as UTF-8 if a utf8 locale
- * and is valid, non-ascii UTF-8 */
+ * and is valid and variant under UTF-8 */
is_utf8_locale
- && ! is_ascii_string((U8 *) value, 0)
+ && ! is_invariant_string((U8 *) value, 0)
&& is_utf8_string((U8 *) value, 0)),
0);
- }
- } while ((++strings)->name);
+ }
+ strings++;
+ }
- do {
+ while (integers->name) {
const char value = *((const char *)(ptr + integers->offset));
if (value != CHAR_MAX)
(void) hv_store(RETVAL, integers->name,
strlen(integers->name), newSViv(value), 0);
- } while ((++integers)->name);
+ integers++;
+ }
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#endif /* HAS_LOCALECONV */
OUTPUT:
RETVAL
}
# ifdef LC_ALL
else if (category == LC_ALL) {
- SET_NUMERIC_LOCAL();
+ SET_NUMERIC_UNDERLYING();
}
# endif
}
/* Save retval since subsequent setlocale() calls may overwrite it. */
retval = savepv(retval);
- /* For locale == 0, we may have switched to NUMERIC_LOCAL. Switch back
- * */
+ /* For locale == 0, we may have switched to NUMERIC_UNDERLYING. Switch
+ * back */
if (locale == 0) {
SET_NUMERIC_STANDARD();
XSRETURN_PV(retval);
y0 = 29
y1 = 30
CODE:
+ PERL_UNUSED_VAR(x);
RETVAL = NV_NAN;
switch (ix) {
case 0:
#endif
break;
case 16:
- /* XXX lgamma_r -- the lgamma accesses a global variable (signgam),
+ /* XXX Note: the lgamma modifies a global variable (signgam),
* which is evil. Some platforms have lgamma_r, which has
- * extra parameter instead of the global variable. */
+ * extra output parameter instead of the global variable. */
#ifdef c99_lgamma
RETVAL = c99_lgamma(x);
#else
case 20:
#ifdef c99_logb
RETVAL = c99_logb(x);
+#elif defined(c99_log2) && FLT_RADIX == 2
+ RETVAL = Perl_floor(c99_log2(PERL_ABS(x)));
#else
not_here("logb");
#endif
RETVAL = Perl_tanh(x); /* C89 math */
break;
case 27:
- /* XXX tgamma_r -- the lgamma accesses a global variable (signgam),
- * which is evil. Some platforms have tgamma_r, which has
- * extra parameter instead of the global variable. */
#ifdef c99_tgamma
RETVAL = c99_tgamma(x);
#else
default: RETVAL = -1; break;
}
#else
+ PERL_UNUSED_VAR(x);
RETVAL = -1;
not_here("fesetround");
#endif
lround = 7
signbit = 8
CODE:
+ PERL_UNUSED_VAR(x);
RETVAL = -1;
switch (ix) {
case 0:
default:
#ifdef Perl_signbit
RETVAL = Perl_signbit(x);
+#else
+ RETVAL = (x < 0) || (x == -0.0);
#endif
break;
}
RETVAL
NV
+getpayload(nv)
+ NV nv
+ CODE:
+ RETVAL = S_getpayload(nv);
+ OUTPUT:
+ RETVAL
+
+void
+setpayload(nv, payload)
+ NV nv
+ NV payload
+ CODE:
+ S_setpayload(&nv, payload, FALSE);
+ OUTPUT:
+ nv
+
+void
+setpayloadsig(nv, payload)
+ NV nv
+ NV payload
+ CODE:
+ nv = NV_NAN;
+ S_setpayload(&nv, payload, TRUE);
+ OUTPUT:
+ nv
+
+int
+issignaling(nv)
+ NV nv
+ CODE:
+ RETVAL = Perl_isnan(nv) && NV_NAN_IS_SIGNALING(&nv);
+ OUTPUT:
+ RETVAL
+
+NV
copysign(x,y)
NV x
NV y
nexttoward = 13
remainder = 14
CODE:
+ PERL_UNUSED_VAR(x);
+ PERL_UNUSED_VAR(y);
RETVAL = NV_NAN;
switch (ix) {
case 0:
case 14:
default:
#ifdef c99_remainder
- RETVAL = c99_remainder(x, y);
+ RETVAL = c99_remainder(x, y);
#else
- not_here("remainder");
+ not_here("remainder");
#endif
break;
}
PUSHs(sv_2mortal(newSVnv(c99_remquo(x,y,&intvar))));
PUSHs(sv_2mortal(newSVnv(intvar)));
#else
+ PERL_UNUSED_VAR(x);
+ PERL_UNUSED_VAR(y);
not_here("remquo");
#endif
#ifdef c99_scalbn
RETVAL = c99_scalbn(x, y);
#else
+ PERL_UNUSED_VAR(x);
+ PERL_UNUSED_VAR(y);
RETVAL = NV_NAN;
not_here("scalbn");
#endif
NV z
CODE:
#ifdef c99_fma
+ PERL_UNUSED_VAR(x);
+ PERL_UNUSED_VAR(y);
+ PERL_UNUSED_VAR(z);
RETVAL = c99_fma(x, y, z);
-#else
- RETVAL = NV_NAN;
- not_here("fma");
#endif
OUTPUT:
RETVAL
NV
-nan(s = 0)
- char* s;
+nan(payload = 0)
+ NV payload
CODE:
-#ifdef c99_nan
- RETVAL = c99_nan(s ? s : "");
-#elif defined(NV_NAN)
- /* XXX if s != NULL, warn about unused argument,
- * or implement the nan payload setting. */
- RETVAL = NV_NAN;
+#ifdef NV_NAN
+ /* If no payload given, just return the default NaN.
+ * This makes a difference in platforms where the default
+ * NaN is not all zeros. */
+ if (items == 0) {
+ RETVAL = NV_NAN;
+ } else {
+ S_setpayload(&RETVAL, payload, FALSE);
+ }
+#elif defined(c99_nan)
+ {
+ STRLEN elen = my_snprintf(PL_efloatbuf, PL_efloatsize, "%g", nv);
+ if ((IV)elen == -1) {
+ RETVAL = NV_NAN;
+ } else {
+ RETVAL = c99_nan(PL_efloatbuf);
+ }
+ }
#else
not_here("nan");
#endif
ALIAS:
yn = 1
CODE:
+ PERL_UNUSED_VAR(x);
+ PERL_UNUSED_VAR(y);
RETVAL = NV_NAN;
switch (ix) {
case 0:
#ifdef bessel_jn
- RETVAL = bessel_jn(x, y);
+ RETVAL = bessel_jn(x, y);
#else
- not_here("jn");
+ not_here("jn");
#endif
break;
case 1:
default:
#ifdef bessel_yn
- RETVAL = bessel_yn(x, y);
+ RETVAL = bessel_yn(x, y);
#else
- not_here("yn");
+ not_here("yn");
#endif
break;
}
int fd1
int fd2
CODE:
+ if (fd1 >= 0 && fd2 >= 0) {
#ifdef WIN32
- /* RT #98912 - More Microsoft muppetry - failing to actually implemented
- the well known documented POSIX behaviour for a POSIX API.
- http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
- RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
+ /* RT #98912 - More Microsoft muppetry - failing to
+ actually implemented the well known documented POSIX
+ behaviour for a POSIX API.
+ http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
+ RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
#else
- RETVAL = dup2(fd1, fd2);
+ RETVAL = dup2(fd1, fd2);
#endif
+ } else {
+ SETERRNO(EBADF,RMS_IFI);
+ RETVAL = -1;
+ }
OUTPUT:
RETVAL
Off_t offset
int whence
CODE:
- Off_t pos = PerlLIO_lseek(fd, offset, whence);
- RETVAL = sizeof(Off_t) > sizeof(IV)
- ? newSVnv((NV)pos) : newSViv((IV)pos);
+ if (fd >= 0) {
+ Off_t pos = PerlLIO_lseek(fd, offset, whence);
+ RETVAL = sizeof(Off_t) > sizeof(IV)
+ ? newSVnv((NV)pos) : newSViv((IV)pos);
+ } else {
+ SETERRNO(EBADF,RMS_IFI);
+ RETVAL = newSViv(-1);
+ }
OUTPUT:
RETVAL
HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Calling POSIX::tmpnam() is deprecated");
- hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
+ (void)hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
}
}
len = strlen(tmpnam(SvPV(RETVAL, i)));
double num;
char *unparsed;
PPCODE:
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtod(str, &unparsed);
PUSHs(sv_2mortal(newSVnv(num)));
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
PUSHs(&PL_sv_undef);
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#ifdef HAS_STRTOLD
long double num;
char *unparsed;
PPCODE:
- STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
num = strtold(str, &unparsed);
PUSHs(sv_2mortal(newSVnv(num)));
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
PUSHs(&PL_sv_undef);
}
- RESTORE_NUMERIC_STANDARD();
+ RESTORE_LC_NUMERIC_STANDARD();
#endif
else
#endif
PUSHs(sv_2mortal(newSViv((IV)num)));
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
unsigned long num;
char *unparsed;
PPCODE:
+ PERL_UNUSED_VAR(str);
+ PERL_UNUSED_VAR(base);
num = strtoul(str, &unparsed, base);
#if IVSIZE <= LONGSIZE
if (num > IV_MAX)
else
#endif
PUSHs(sv_2mortal(newSViv((IV)num)));
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
close = 1
dup = 2
CODE:
- RETVAL = ix == 1 ? close(fd)
- : (ix < 1 ? tcdrain(fd) : dup(fd));
+ if (fd >= 0) {
+ RETVAL = ix == 1 ? close(fd)
+ : (ix < 1 ? tcdrain(fd) : dup(fd));
+ } else {
+ SETERRNO(EBADF,RMS_IFI);
+ RETVAL = -1;
+ }
OUTPUT:
RETVAL
tcflush = 1
tcsendbreak = 2
CODE:
- RETVAL = ix == 1 ? tcflush(fd, action)
- : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
+ if (fd >= 0 && action >= 0) {
+ RETVAL = ix == 1 ? tcflush(fd, action)
+ : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
+ } else {
+ SETERRNO(EBADF,RMS_IFI);
+ RETVAL = -1;
+ }
OUTPUT:
RETVAL
STRLEN len = strlen(buf);
sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
if (SvUTF8(fmt)
- || (! is_ascii_string((U8*) buf, len)
+ || (! is_invariant_string((U8*) buf, len)
&& is_utf8_string((U8*) buf, len)
#ifdef USE_LOCALE_TIME
&& _is_cur_LC_category_utf8(LC_TIME)
#ifdef HAS_CUSERID
RETVAL = cuserid(s);
#else
+ PERL_UNUSED_VAR(s);
RETVAL = 0;
not_here("cuserid");
#endif
* but consistent with CORE::chown() */
RETVAL = lchown(path, uid, gid);
#else
+ PERL_UNUSED_VAR(uid);
+ PERL_UNUSED_VAR(gid);
+ PERL_UNUSED_VAR(path);
RETVAL = not_here("lchown");
#endif
OUTPUT:
https://perl5.git.perl.org / perl5.git / blobdiff