In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/afabfeb3299724b02541bbc9ebf0aeba14e9be17?hp=867a901b7ec194e3895eb595338d0d0ea4fc783f>
- Log ----------------------------------------------------------------- commit afabfeb3299724b02541bbc9ebf0aeba14e9be17 Author: Jarkko Hietaniemi <[email protected]> Date: Fri Sep 30 07:35:53 2016 -0400 vax-netbsd: do not export inf/nan which we do not have M ext/POSIX/Makefile.PL commit 94f8a1479e2e1b1c4f62f6378f3f5740d0d8a965 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 29 06:47:13 2016 -0400 vax-netbsd: POSIX: skip t/math.t tests needing inf/nan M ext/POSIX/t/math.t commit effb4c81d3f000336be65e784b94beca8df3f62f Author: Jarkko Hietaniemi <[email protected]> Date: Tue Sep 27 19:07:40 2016 -0400 vax-netbsd: POSIX: skip inf/nan parts M ext/POSIX/POSIX.xs commit 84e4d7a5a350bcabe4046cd9ad66280ec7872705 Author: Jarkko Hietaniemi <[email protected]> Date: Tue Sep 27 18:40:46 2016 -0400 vax-netbsd: POSIX: fenv.h is work-in-progress Given that fenv.h seems very IEEE-754 oriented, it's likely to stay that way for a while. M ext/POSIX/POSIX.xs commit a5dc248451d2c0fcd7fc58e4d50eef8fa4a68e3d Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 29 17:57:05 2016 -0400 vax-netbsd: avoid NV_INF/NV_NAN uses M numeric.c M pp.c commit 9ee3aea9e965410ea479b576440660f883dd5f86 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 29 08:23:12 2016 -0400 vax-netbsd: inf/nan only if IEEE 754 M perl.h ----------------------------------------------------------------------- Summary of changes: ext/POSIX/Makefile.PL | 14 +-- ext/POSIX/POSIX.xs | 80 +++++++++++++++-- ext/POSIX/t/math.t | 170 ++++++++++++++++++++---------------- numeric.c | 7 ++ perl.h | 234 +++++++++++++++++++++++++------------------------- pp.c | 4 + 6 files changed, 307 insertions(+), 202 deletions(-) diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index a6e870c..56b8e53 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -92,11 +92,15 @@ END #endif '}); -push @names, - {name=>"INFINITY", type=>"NV", value=>"NV_INF", not_constant=>1}, - {name=>"NAN", type=>"NV", value=>"NV_NAN", not_constant=>1}, - {name=>"Inf", type=>"NV", value=>"NV_INF", not_constant=>1}, - {name=>"NaN", type=>"NV", value=>"NV_NAN", not_constant=>1}; +unless ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11) { + push @names, + {name=>"INFINITY", type=>"NV", value=>"NV_INF", not_constant=>1}, + {name=>"NAN", type=>"NV", value=>"NV_NAN", not_constant=>1}, + {name=>"Inf", type=>"NV", value=>"NV_INF", not_constant=>1}, + {name=>"NaN", type=>"NV", value=>"NV_NAN", not_constant=>1}; +} push @names, {name=>$_, type=>"UV"} foreach (qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index d962541..672807a 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -17,6 +17,9 @@ #define PERLIO_NOT_STDIO 1 #include "perl.h" #include "XSUB.h" + +static int not_here(const char *s); + #if defined(PERL_IMPLICIT_SYS) # undef signal # undef open @@ -35,8 +38,10 @@ #include <float.h> #endif #ifdef I_FENV +#if !(defined(__vax__) && defined(__NetBSD__)) #include <fenv.h> #endif +#endif #ifdef I_LIMITS #include <limits.h> #endif @@ -704,7 +709,11 @@ static NV my_expm1(NV x) #ifndef c99_fdim static NV my_fdim(NV x, NV y) { +#ifdef NV_NAN return (Perl_isnan(x) || Perl_isnan(y)) ? NV_NAN : (x > y ? x - y : 0); +#else + return (x > y ? x - y : 0); +#endif } # define c99_fdim my_fdim #endif @@ -720,11 +729,13 @@ static NV my_fma(NV x, NV y, NV z) #ifndef c99_fmax static NV my_fmax(NV x, NV y) { +#ifdef NV_NAN if (Perl_isnan(x)) { return Perl_isnan(y) ? NV_NAN : y; } else if (Perl_isnan(y)) { return x; } +#endif return x > y ? x : y; } # define c99_fmax my_fmax @@ -733,11 +744,13 @@ static NV my_fmax(NV x, NV y) #ifndef c99_fmin static NV my_fmin(NV x, NV y) { +#ifdef NV_NAN if (Perl_isnan(x)) { return Perl_isnan(y) ? NV_NAN : y; } else if (Perl_isnan(y)) { return x; } +#endif return x < y ? x : y; } # define c99_fmin my_fmin @@ -768,8 +781,10 @@ static NV my_hypot(NV x, NV y) x = PERL_ABS(x); /* Take absolute values. */ if (y == 0) return x; +#ifdef NV_INF if (Perl_isnan(y)) return NV_INF; +#endif y = PERL_ABS(y); if (x < y) { /* Swap so that y is less. */ t = x; @@ -816,10 +831,14 @@ static NV my_lgamma(NV x); static NV my_tgamma(NV x) { const NV gamma = 0.577215664901532860606512090; /* Euler's gamma constant. */ +#ifdef NV_NAN if (Perl_isnan(x) || x < 0.0) return NV_NAN; +#endif +#ifdef NV_INF if (x == 0.0 || x == NV_INF) return x == -0.0 ? -NV_INF : NV_INF; +#endif /* The function domain is split into three intervals: * (0, 0.001), [0.001, 12), and (12, infinity) */ @@ -891,6 +910,7 @@ static NV my_tgamma(NV x) return result; } +#ifdef NV_INF /* Third interval: [12, +Inf) */ #if LDBL_MANT_DIG == 113 /* IEEE quad prec */ if (x > 1755.548) { @@ -901,6 +921,7 @@ static NV my_tgamma(NV x) return NV_INF; } #endif +#endif return Perl_exp(c99_lgamma(x)); } @@ -909,10 +930,14 @@ static NV my_tgamma(NV x) #ifdef USE_MY_LGAMMA static NV my_lgamma(NV x) { +#ifdef NV_NAN if (Perl_isnan(x)) return NV_NAN; +#endif +#ifdef NV_INF if (x <= 0 || x == NV_INF) return NV_INF; +#endif if (x == 1.0 || x == 2.0) return 0; if (x < 12.0) @@ -953,10 +978,14 @@ static NV my_log1p(NV x) { /* http://www.johndcook.com/cpp_log_one_plus_x.html -- public domain. * Taylor series, the first four terms (the last term quartic). */ +#ifdef NV_NAN if (x < -1.0) return NV_NAN; +#endif +#ifdef NV_INF if (x == -1.0) return -NV_INF; +#endif if (PERL_ABS(x) > 1e-4) return Perl_log(1.0 + x); else @@ -1032,7 +1061,7 @@ static NV my_rint(NV x) case FE_TOWARDZERO: return MY_ROUND_TRUNC(x); case FE_DOWNWARD: return MY_ROUND_DOWN(x); case FE_UPWARD: return MY_ROUND_UP(x); - default: return NV_NAN; + default: break; } #elif defined(HAS_FPGETROUND) switch (fpgetround()) { @@ -1040,11 +1069,10 @@ static NV my_rint(NV x) case FP_RZ: return MY_ROUND_TRUNC(x); case FP_RM: return MY_ROUND_DOWN(x); case FE_RP: return MY_ROUND_UP(x); - default: return NV_NAN; + default: break; } -#else - return NV_NAN; #endif + not_here("rint"); } #endif @@ -1118,6 +1146,8 @@ static NV my_trunc(NV x) # define c99_trunc my_trunc #endif +#ifdef NV_NAN + #undef NV_PAYLOAD_DEBUG /* NOTE: the NaN payload API implementation is hand-rolled, since the @@ -1283,6 +1313,8 @@ static NV_PAYLOAD_TYPE S_getpayload(NV nv) return payload; } +#endif /* #ifdef NV_NAN */ + /* 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 @@ -2305,7 +2337,11 @@ acos(x) y1 = 30 CODE: PERL_UNUSED_VAR(x); +#ifdef NV_NAN RETVAL = NV_NAN; +#else + RETVAL = 0; +#endif switch (ix) { case 0: RETVAL = Perl_acos(x); /* C89 math */ @@ -2611,7 +2647,12 @@ NV getpayload(nv) NV nv CODE: +#ifdef DOUBLE_HAS_NAN RETVAL = S_getpayload(nv); +#else + PERL_UNUSED_VAR(nv); + not_here("getpayload"); +#endif OUTPUT: RETVAL @@ -2620,7 +2661,13 @@ setpayload(nv, payload) NV nv NV payload CODE: +#ifdef DOUBLE_HAS_NAN S_setpayload(&nv, payload, FALSE); +#else + PERL_UNUSED_VAR(nv); + PERL_UNUSED_VAR(payload); + not_here("setpayload"); +#endif OUTPUT: nv @@ -2629,8 +2676,14 @@ setpayloadsig(nv, payload) NV nv NV payload CODE: +#ifdef DOUBLE_HAS_NAN nv = NV_NAN; S_setpayload(&nv, payload, TRUE); +#else + PERL_UNUSED_VAR(nv); + PERL_UNUSED_VAR(payload); + not_here("setpayloadsig"); +#endif OUTPUT: nv @@ -2638,7 +2691,12 @@ int issignaling(nv) NV nv CODE: +#ifdef DOUBLE_HAS_NAN RETVAL = Perl_isnan(nv) && NV_NAN_IS_SIGNALING(&nv); +#else + PERL_UNUSED_VAR(nv); + not_here("issignaling"); +#endif OUTPUT: RETVAL @@ -2664,7 +2722,11 @@ copysign(x,y) CODE: PERL_UNUSED_VAR(x); PERL_UNUSED_VAR(y); +#ifdef NV_NAN RETVAL = NV_NAN; +#else + RETVAL = 0; +#endif switch (ix) { case 0: #ifdef c99_copysign @@ -2858,9 +2920,13 @@ nan(payload = 0) } #elif defined(c99_nan) { - STRLEN elen = my_snprintf(PL_efloatbuf, PL_efloatsize, "%g", nv); + STRLEN elen = my_snprintf(PL_efloatbuf, PL_efloatsize, "%g", payload); if ((IV)elen == -1) { +#ifdef NV_NAN RETVAL = NV_NAN; +#else + not_here("nan"); +#endif } else { RETVAL = c99_nan(PL_efloatbuf); } @@ -2878,7 +2944,11 @@ jn(x,y) ALIAS: yn = 1 CODE: +#ifdef NV_NAN RETVAL = NV_NAN; +#else + RETVAL = 0; +#endif switch (ix) { case 0: #ifdef bessel_jn diff --git a/ext/POSIX/t/math.t b/ext/POSIX/t/math.t index ea0c0e3..47841fc 100644 --- a/ext/POSIX/t/math.t +++ b/ext/POSIX/t/math.t @@ -59,6 +59,9 @@ SKIP: { skip "no fpclassify", 4 unless $Config{d_fpclassify}; is(fpclassify(1), FP_NORMAL, "fpclassify 1"); is(fpclassify(0), FP_ZERO, "fpclassify 0"); + skip("no inf/nan", 2) if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11); is(fpclassify(INFINITY), FP_INFINITE, "fpclassify INFINITY"); is(fpclassify(NAN), FP_NAN, "fpclassify NAN"); } @@ -96,17 +99,22 @@ SKIP: { is(ilogb(255), 7, "ilogb 255"); is(ilogb(256), 8, "ilogb 256"); ok(isfinite(1), "isfinite 1"); - ok(!isfinite(Inf), "isfinite Inf"); - ok(!isfinite(NaN), "isfinite NaN"); - ok(isinf(INFINITY), "isinf INFINITY"); - ok(isinf(Inf), "isinf Inf"); - ok(!isinf(NaN), "isinf NaN"); ok(!isinf(42), "isinf 42"); - ok(isnan(NAN), "isnan NAN"); - ok(isnan(NaN), "isnan NaN"); - ok(!isnan(Inf), "isnan Inf"); ok(!isnan(42), "isnan Inf"); - cmp_ok(nan(), '!=', nan(), 'nan'); + SKIP: { + skip("no inf/nan", 9) if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11); + ok(!isfinite(Inf), "isfinite Inf"); + ok(!isfinite(NaN), "isfinite NaN"); + ok(isinf(INFINITY), "isinf INFINITY"); + ok(isinf(Inf), "isinf Inf"); + ok(!isinf(NaN), "isinf NaN"); + ok(isnan(NAN), "isnan NAN"); + ok(isnan(NaN), "isnan NaN"); + ok(!isnan(Inf), "isnan Inf"); + cmp_ok(nan(), '!=', nan(), 'nan'); + } near(log1p(2), 1.09861228866811, "log1p", 1e-9); near(log1p(1e-6), 9.99999500000333e-07, "log1p", 1e-9); near(log2(8), 3, "log2", 1e-9); @@ -129,10 +137,16 @@ SKIP: { ok(isless(1, 2), "isless 1 2"); ok(!isless(2, 1), "isless 2 1"); ok(!isless(1, 1), "isless 1 1"); - ok(!isless(1, NaN), "isless 1 NaN"); ok(isgreater(2, 1), "isgreater 2 1"); ok(islessequal(1, 1), "islessequal 1 1"); - ok(isunordered(1, NaN), "isunordered 1 NaN"); + + SKIP: { + skip("no inf/nan", 2) if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11); + ok(!isless(1, NaN), "isless 1 NaN"); + ok(isunordered(1, NaN), "isunordered 1 NaN"); + } near(erf(0.5), 0.520499877813047, "erf 0.5", 1.5e-7); near(erf(1), 0.842700792949715, "erf 1", 1.5e-7); @@ -150,66 +164,71 @@ SKIP: { near(lgamma(5.5), 3.95781396761872, "lgamma 5.5", 1.5e-7); near(lgamma(9), 10.6046029027452, "lgamma 9", 1.5e-7); - # These don't work on old mips/hppa platforms because == Inf (or == -Inf). - # ok(isnan(setpayload(0)), "setpayload zero"); - # is(getpayload(setpayload(0)), 0, "setpayload + getpayload (zero)"); - # - # These don't work on most platforms because == Inf (or == -Inf). - # ok(isnan(setpayloadsig(0)), "setpayload zero"); - # is(getpayload(setpayloadsig(0)), 0, "setpayload + getpayload (zero)"); - - # Verify that the payload set be setpayload() - # (1) still is a nan - # (2) but the payload can be retrieved - # (3) but is not signaling - my $x = 0; - setpayload($x, 0x12345); - ok(isnan($x), "setpayload + isnan"); - is(getpayload($x), 0x12345, "setpayload + getpayload"); - ok(!issignaling($x), "setpayload + issignaling"); - - # Verify that the signaling payload set be setpayloadsig() - # (1) still is a nan - # (2) but the payload can be retrieved - # (3) and is signaling - setpayloadsig($x, 0x12345); - ok(isnan($x), "setpayloadsig + isnan"); - is(getpayload($x), 0x12345, "setpayloadsig + getpayload"); SKIP: { - # https://rt.perl.org/Ticket/Display.html?id=125710 - # In the 32-bit x86 ABI cannot preserve the signaling bit - # (the x87 simply does not preserve that). But using the - # 80-bit extended format aka long double, the bit is preserved. - # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57484 - my $could_be_x86_32 = - # This is a really weak test: there are other 32-bit - # little-endian platforms than just Intel (some embedded - # processors, for example), but we use this just for not - # bothering with the test if things look iffy. - # We could, say, $Config{ccsymbols} =~ /\b__[xi][3-7]86=1\b/, - # but that feels quite shaky. - $Config{byteorder} =~ /1234/ && - $Config{longdblkind} == 3 && - $Config{ptrsize} == 4; - skip($^O, 1) if $could_be_x86_32 && !$Config{uselongdouble}; - ok(issignaling($x), "setpayloadsig + issignaling"); - } + skip("no inf/nan", 19) if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11); + # These don't work on old mips/hppa platforms + # because nan with payload zero == Inf (or == -Inf). + # ok(isnan(setpayload(0)), "setpayload zero"); + # is(getpayload(setpayload(0)), 0, "setpayload + getpayload (zero)"); + # + # These don't work on most platforms because == Inf (or == -Inf). + # ok(isnan(setpayloadsig(0)), "setpayload zero"); + # is(getpayload(setpayloadsig(0)), 0, "setpayload + getpayload (zero)"); - # Try a payload more than one byte. - is(getpayload(nan(0x12345)), 0x12345, "nan + getpayload"); + # Verify that the payload set be setpayload() + # (1) still is a nan + # (2) but the payload can be retrieved + # (3) but is not signaling + my $x = 0; + setpayload($x, 0x12345); + ok(isnan($x), "setpayload + isnan"); + is(getpayload($x), 0x12345, "setpayload + getpayload"); + ok(!issignaling($x), "setpayload + issignaling"); - # Try payloads of 2^k, most importantly at and beyond 2^32. These - # tests will fail if NV is just 32-bit float, but that Should Not - # Happen (tm). - is(getpayload(nan(2**31)), 2**31, "nan + getpayload 2**31"); - is(getpayload(nan(2**32)), 2**32, "nan + getpayload 2**32"); - is(getpayload(nan(2**33)), 2**33, "nan + getpayload 2**33"); + # Verify that the signaling payload set be setpayloadsig() + # (1) still is a nan + # (2) but the payload can be retrieved + # (3) and is signaling + setpayloadsig($x, 0x12345); + ok(isnan($x), "setpayloadsig + isnan"); + is(getpayload($x), 0x12345, "setpayloadsig + getpayload"); + SKIP: { + # https://rt.perl.org/Ticket/Display.html?id=125710 + # In the 32-bit x86 ABI cannot preserve the signaling bit + # (the x87 simply does not preserve that). But using the + # 80-bit extended format aka long double, the bit is preserved. + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57484 + my $could_be_x86_32 = + # This is a really weak test: there are other 32-bit + # little-endian platforms than just Intel (some embedded + # processors, for example), but we use this just for not + # bothering with the test if things look iffy. + # We could, say, $Config{ccsymbols} =~ /\b__[xi][3-7]86=1\b/, + # but that feels quite shaky. + $Config{byteorder} =~ /1234/ && + $Config{longdblkind} == 3 && + $Config{ptrsize} == 4; + skip($^O, 1) if $could_be_x86_32 && !$Config{uselongdouble}; + ok(issignaling($x), "setpayloadsig + issignaling"); + } + + # Try a payload more than one byte. + is(getpayload(nan(0x12345)), 0x12345, "nan + getpayload"); + + # Try payloads of 2^k, most importantly at and beyond 2^32. These + # tests will fail if NV is just 32-bit float, but that Should Not + # Happen (tm). + is(getpayload(nan(2**31)), 2**31, "nan + getpayload 2**31"); + is(getpayload(nan(2**32)), 2**32, "nan + getpayload 2**32"); + is(getpayload(nan(2**33)), 2**33, "nan + getpayload 2**33"); - # Payloads just lower than 2^k. - is(getpayload(nan(2**31-1)), 2**31-1, "nan + getpayload 2**31-1"); - is(getpayload(nan(2**32-1)), 2**32-1, "nan + getpayload 2**32-1"); + # Payloads just lower than 2^k. + is(getpayload(nan(2**31-1)), 2**31-1, "nan + getpayload 2**31-1"); + is(getpayload(nan(2**32-1)), 2**32-1, "nan + getpayload 2**32-1"); - # Payloads not divisible by two (and larger than 2**32). + # Payloads not divisible by two (and larger than 2**32). SKIP: { # solaris gets 10460353202 from getpayload() when it should @@ -230,17 +249,18 @@ SKIP: { # probably just by blind luck. skip($^O, 1) if $^O eq 'solaris'; is(getpayload(nan(3**21)), 3**21, "nan + getpayload 3**21"); - } - is(getpayload(nan(4294967311)), 4294967311, "nan + getpayload prime"); + } + is(getpayload(nan(4294967311)), 4294967311, "nan + getpayload prime"); - # Truncates towards zero. - is(getpayload(nan(1234.567)), 1234, "nan (trunc) + getpayload"); + # Truncates towards zero. + is(getpayload(nan(1234.567)), 1234, "nan (trunc) + getpayload"); - # Not signaling. - ok(!issignaling(0), "issignaling zero"); - ok(!issignaling(+Inf), "issignaling +Inf"); - ok(!issignaling(-Inf), "issignaling -Inf"); - ok(!issignaling(NaN), "issignaling NaN"); + # Not signaling. + ok(!issignaling(0), "issignaling zero"); + ok(!issignaling(+Inf), "issignaling +Inf"); + ok(!issignaling(-Inf), "issignaling -Inf"); + ok(!issignaling(NaN), "issignaling NaN"); + } } # SKIP done_testing(); diff --git a/numeric.c b/numeric.c index 5fc3df3..0c73749 100644 --- a/numeric.c +++ b/numeric.c @@ -574,6 +574,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send) { const char* s = *sp; int flags = 0; +#if defined(NV_INF) || defined(NV_NAN) bool odh = FALSE; /* one-dot-hash: 1.#INF */ PERL_ARGS_ASSERT_GROK_INFNAN; @@ -798,6 +799,9 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send) while (s < send && isSPACE(*s)) s++; +#else + PERL_UNUSED_ARG(send); +#endif /* #if defined(NV_INF) || defined(NV_NAN) */ *sp = s; return flags; } @@ -1422,11 +1426,13 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) /* the max number we can accumulate in a UV, and still safely do 10*N+9 */ #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10)) +#if defined(NV_INF) || defined(NV_NAN) { const char* endp; if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value))) return (char*)endp; } +#endif /* we accumulate digits into an integer; when this becomes too * large, we add the total to NV and start again */ @@ -1549,6 +1555,7 @@ This is also the logical inverse of Perl_isfinite(). bool Perl_isinfnan(NV nv) { + PERL_UNUSED_ARG(nv); #ifdef Perl_isinf if (Perl_isinf(nv)) return TRUE; diff --git a/perl.h b/perl.h index 454304b..628315f 100644 --- a/perl.h +++ b/perl.h @@ -5721,126 +5721,10 @@ EXTCONST bool PL_valid_types_NV_set[]; * In C89 we need to initialize the member declared first. * * With the U8_NV version you will want to have inner braces, - * while with the NV_U8 use just the NV.*/ + * while with the NV_U8 use just the NV. */ #define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; } #define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; } -#ifdef DOINIT - -/* PL_inf and PL_nan initialization. - * - * For inf and nan initialization the ultimate fallback is dividing - * one or zero by zero: however, some compilers will warn or even fail - * on divide-by-zero, but hopefully something earlier will work. - * - * If you are thinking of using HUGE_VAL for infinity, or using - * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)), - * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX, - * and the math functions might be just generating DBL_MAX, or even zero. - * - * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF). - * Though logically correct, some compilers (like Visual C 2003) - * falsely misoptimize that to zero (x-x is always zero, right?) - * - * Finally, note that not all floating point formats define Inf (or NaN). - * For the infinity a large number may be used instead. Operations that - * under the IEEE floating point would return Inf or NaN may return - * either large numbers (positive or negative), or they may cause - * a floating point exception or some other fault. - */ - -/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */ -GCC_DIAG_IGNORE(-Wc++-compat) - -# ifdef USE_QUADMATH -/* Cannot use HUGE_VALQ for PL_inf because not a compile-time - * constant. */ -INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q }; -# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) -INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } }; -# elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES) -INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } }; -# else -# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE) -# if defined(LDBL_INFINITY) -INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY }; -# elif defined(LDBL_INF) -INFNAN_NV_U8_DECL PL_inf = { LDBL_INF }; -# elif defined(INFINITY) -INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY }; -# elif defined(INF) -INFNAN_NV_U8_DECL PL_inf = { (NV)INF }; -# else -INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */ -# endif -# else -# if defined(DBL_INFINITY) -INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY }; -# elif defined(DBL_INF) -INFNAN_NV_U8_DECL PL_inf = { DBL_INF }; -# elif defined(INFINITY) /* C99 */ -INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY }; -# elif defined(INF) -INFNAN_NV_U8_DECL PL_inf = { (NV)INF }; -# else -INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */ -# endif -# endif -# endif - -# ifdef USE_QUADMATH -/* Cannot use nanq("0") for PL_nan because not a compile-time - * constant. */ -INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q }; -# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) -INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } }; -# elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES) -INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } }; -# else -# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE) -# if defined(LDBL_NAN) -INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN }; -# elif defined(LDBL_QNAN) -INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN }; -# elif defined(NAN) -INFNAN_NV_U8_DECL PL_nan = { (NV)NAN }; -# else -INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */ -# endif -# else -# if defined(DBL_NAN) -INFNAN_NV_U8_DECL PL_nan = { DBL_NAN }; -# elif defined(DBL_QNAN) -INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN }; -# elif defined(NAN) /* C99 */ -INFNAN_NV_U8_DECL PL_nan = { (NV)NAN }; -# else -INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */ -# endif -# endif -# endif - -GCC_DIAG_RESTORE - -#else - -INFNAN_NV_U8_DECL PL_inf; -INFNAN_NV_U8_DECL PL_nan; - -#endif - -/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h), - * we will define NV_INF/NV_NAN as the nv part of the global const - * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN - * might not be a compile-time constant, in which case it cannot be - * used to initialize PL_inf/PL_nan above. */ -#ifndef NV_INF -# define NV_INF PL_inf.nv -#endif -#ifndef NV_NAN -# define NV_NAN PL_nan.nv -#endif - /* if these never got defined, they need defaults */ #ifndef PERL_SET_CONTEXT # define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) @@ -6964,6 +6848,122 @@ extern void moncontrol(int); #ifdef DOUBLE_HAS_NAN +#ifdef DOINIT + +/* PL_inf and PL_nan initialization. + * + * For inf and nan initialization the ultimate fallback is dividing + * one or zero by zero: however, some compilers will warn or even fail + * on divide-by-zero, but hopefully something earlier will work. + * + * If you are thinking of using HUGE_VAL for infinity, or using + * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)), + * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX, + * and the math functions might be just generating DBL_MAX, or even zero. + * + * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF). + * Though logically correct, some compilers (like Visual C 2003) + * falsely misoptimize that to zero (x-x is always zero, right?) + * + * Finally, note that not all floating point formats define Inf (or NaN). + * For the infinity a large number may be used instead. Operations that + * under the IEEE floating point would return Inf or NaN may return + * either large numbers (positive or negative), or they may cause + * a floating point exception or some other fault. + */ + +/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */ +GCC_DIAG_IGNORE(-Wc++-compat) + +# ifdef USE_QUADMATH +/* Cannot use HUGE_VALQ for PL_inf because not a compile-time + * constant. */ +INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q }; +# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) +INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } }; +# elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES) +INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } }; +# else +# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE) +# if defined(LDBL_INFINITY) +INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY }; +# elif defined(LDBL_INF) +INFNAN_NV_U8_DECL PL_inf = { LDBL_INF }; +# elif defined(INFINITY) +INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY }; +# elif defined(INF) +INFNAN_NV_U8_DECL PL_inf = { (NV)INF }; +# else +INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */ +# endif +# else +# if defined(DBL_INFINITY) +INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY }; +# elif defined(DBL_INF) +INFNAN_NV_U8_DECL PL_inf = { DBL_INF }; +# elif defined(INFINITY) /* C99 */ +INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY }; +# elif defined(INF) +INFNAN_NV_U8_DECL PL_inf = { (NV)INF }; +# else +INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */ +# endif +# endif +# endif + +# ifdef USE_QUADMATH +/* Cannot use nanq("0") for PL_nan because not a compile-time + * constant. */ +INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q }; +# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) +INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } }; +# elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES) +INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } }; +# else +# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE) +# if defined(LDBL_NAN) +INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN }; +# elif defined(LDBL_QNAN) +INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN }; +# elif defined(NAN) +INFNAN_NV_U8_DECL PL_nan = { (NV)NAN }; +# else +INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */ +# endif +# else +# if defined(DBL_NAN) +INFNAN_NV_U8_DECL PL_nan = { DBL_NAN }; +# elif defined(DBL_QNAN) +INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN }; +# elif defined(NAN) /* C99 */ +INFNAN_NV_U8_DECL PL_nan = { (NV)NAN }; +# else +INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */ +# endif +# endif +# endif + +GCC_DIAG_RESTORE + +#else + +INFNAN_NV_U8_DECL PL_inf; +INFNAN_NV_U8_DECL PL_nan; + +#endif + +/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h), + * we will define NV_INF/NV_NAN as the nv part of the global const + * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN + * might not be a compile-time constant, in which case it cannot be + * used to initialize PL_inf/PL_nan above. */ +#ifndef NV_INF +# define NV_INF PL_inf.nv +#endif +#ifndef NV_NAN +# define NV_NAN PL_nan.nv +#endif + /* NaNs (not-a-numbers) can carry payload bits, in addition to * "nan-ness". Part of the payload is the quiet/signaling bit. * To back up a bit (harhar): diff --git a/pp.c b/pp.c index baf48b9..837b67b 100644 --- a/pp.c +++ b/pp.c @@ -2965,7 +2965,11 @@ PP(pp_sin) { SV * const arg = TOPs; const NV value = SvNV_nomg(arg); +#ifdef NV_NAN NV result = NV_NAN; +#else + NV result = 0.0; +#endif if (neg_report) { /* log or sqrt */ if ( #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) -- Perl5 Master Repository
