In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1bee6aebe39da1a4d681e8ea1b9d0329898a8407?hp=624c42e21a507311daed2012be92ca7adec9b65f>
- Log ----------------------------------------------------------------- commit 1bee6aebe39da1a4d681e8ea1b9d0329898a8407 Author: Jarkko Hietaniemi <[email protected]> Date: Mon Aug 15 17:49:51 2016 -0400 Test data mistake was masked by mistaken fractional matching (Affected only double-double.) M t/op/sprintf2.t commit dd1645173d8209e05c419b0f3edc9b1c0f9643a8 Author: Jarkko Hietaniemi <[email protected]> Date: Mon Aug 15 17:52:17 2016 -0400 Do not deploy the fractional matching without fractions M t/op/sprintf2.t commit de1a8b537348227e83c8efd15d3cb36d9ac646f5 Author: Jarkko Hietaniemi <[email protected]> Date: Wed Aug 17 21:37:07 2016 -0400 Test subnormals with quadmath M t/op/sprintf2.t commit b28053d1f063cb783e73b0596d1f58a21681fda6 Author: Jarkko Hietaniemi <[email protected]> Date: Wed Aug 17 21:16:16 2016 -0400 Define Perl_fp_class() for quadmath More importantly, define Perl_fp_class_denorm() so that hexfp subnormals work with printf %a. M perl.h commit f40ac91c3b9891b83f3d253861009c290584b646 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 14 22:52:40 2016 -0400 Handle subnormals of x86 80-bit M perl.h M sv.c M t/op/sprintf2.t commit f5a466613ec0b74a224adb5b7da6da0a74713596 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 14 19:59:32 2016 -0400 Use library testing for subnormality ...instead of implementing it brokenly Continuing work on rt.perl.org #128843 M sv.c M t/op/sprintf2.t ----------------------------------------------------------------------- Summary of changes: perl.h | 7 +++++++ sv.c | 65 ++++++++++++++++++++++++++++++++++++++------------------- t/op/sprintf2.t | 53 +++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 98 insertions(+), 27 deletions(-) diff --git a/perl.h b/perl.h index 23b6431..b7c866a 100644 --- a/perl.h +++ b/perl.h @@ -2022,6 +2022,12 @@ extern long double Perl_my_frexpl(long double x, int *e); # define Perl_isinf(x) isinfq(x) # define Perl_isnan(x) isnanq(x) # define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) +# define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1) +# define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3) +# define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4) +# define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2) +# define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0) #else # define NV_DIG DBL_DIG # ifdef DBL_MANT_DIG @@ -6897,6 +6903,7 @@ extern void moncontrol(int); # define LONGDOUBLE_X86_80_BIT # ifdef USE_LONG_DOUBLE # undef NV_IMPLICIT_BIT +# define NV_X86_80_BIT # endif # endif diff --git a/sv.c b/sv.c index 8991c12..c4cac80 100644 --- a/sv.c +++ b/sv.c @@ -10978,8 +10978,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, * are being extracted from (either directly from the long double in-memory * presentation, or from the uquad computed via frexp+ldexp). frexp also * is used to update the exponent. The subnormal is set to true - * for IEEE 754 subnormals/denormals. The vhex is the pointer to - * the beginning of the output buffer (of VHEX_SIZE). + * for IEEE 754 subnormals/denormals (including the x86 80-bit format). + * The vhex is the pointer to the beginning of the output buffer of VHEX_SIZE. * * The tricky part is that S_hextract() needs to be called twice: * the first time with vend as NULL, and the second time with vend as @@ -11030,9 +11030,10 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, for (ix = a; ix >= b; ix--) { HEXTRACT_BYTE(ix); } #define HEXTRACT_BYTES_BE(a, b) \ for (ix = a; ix <= b; ix++) { HEXTRACT_BYTE(ix); } +#define HEXTRACT_GET_SUBNORMAL(nv) *subnormal = Perl_fp_class_denorm(nv) #define HEXTRACT_IMPLICIT_BIT(nv) \ STMT_START { \ - if (!(*subnormal = (HEXTRACT_EXPONENT_BITS() == 0))) { \ + if (!*subnormal) { \ if (vend) *v++ = ((nv) == 0.0) ? 0 : 1; else v++; \ } \ } STMT_END @@ -11070,7 +11071,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, /* The bytes 13..0 are the mantissa/fraction, * the 15,14 are the sign+exponent. */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() (nvp[14] | (nvp[15] & 0x7F) << 8) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); # undef HEXTRACT_HAS_TOP_NYBBLE HEXTRACT_BYTES_LE(13, 0); @@ -11080,7 +11081,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, /* The bytes 2..15 are the mantissa/fraction, * the 0,1 are the sign+exponent. */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() ((nvp[0] & 0x7F) << 8 | nvp[1]) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); # undef HEXTRACT_HAS_TOP_NYBBLE HEXTRACT_BYTES_BE(2, 15); @@ -11089,10 +11090,12 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, * significand, 15 bits of exponent, 1 bit of sign. No implicit bit. * NVSIZE can be either 12 (ILP32, Solaris x86) or 16 (LP64, Linux * and OS X), meaning that 2 or 6 bytes are empty padding. */ - /* The bytes 7..0 are the mantissa/fraction */ + /* The bytes 0..1 are the sign+exponent, + * the bytes 2..9 are the mantissa/fraction. */ const U8* nvp = (const U8*)(&nv); # undef HEXTRACT_HAS_IMPLICIT_BIT # undef HEXTRACT_HAS_TOP_NYBBLE + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_BYTES_LE(7, 0); # elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN /* Does this format ever happen? (Wikipedia says the Motorola @@ -11102,6 +11105,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, const U8* nvp = (const U8*)(&nv); # undef HEXTRACT_HAS_IMPLICIT_BIT # undef HEXTRACT_HAS_TOP_NYBBLE + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_BYTES_BE(0, 7); # else # define HEXTRACT_FALLBACK @@ -11137,21 +11141,21 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, # ifdef HEXTRACT_LITTLE_ENDIAN /* 0 1 2 3 4 5 6 7 (MSB = 7, LSB = 0, 6+7 = exponent+sign) */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() (nvp[6] | (nvp[7] & 0x7F) << 4) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); HEXTRACT_TOP_NYBBLE(6); HEXTRACT_BYTES_LE(5, 0); # elif defined(HEXTRACT_BIG_ENDIAN) /* 7 6 5 4 3 2 1 0 (MSB = 7, LSB = 0, 6+7 = exponent+sign) */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() (nvp[1] | (nvp[0] & 0x7F) << 4) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); HEXTRACT_TOP_NYBBLE(1); HEXTRACT_BYTES_BE(2, 7); # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE /* 4 5 6 7 0 1 2 3 (MSB = 7, LSB = 0, 6:7 = nybble:exponent:sign) */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() (nvp[2] | (nvp[3] & 0x7F) << 4) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); HEXTRACT_TOP_NYBBLE(2); /* 6 */ HEXTRACT_BYTE(1); /* 5 */ @@ -11163,7 +11167,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE /* 3 2 1 0 7 6 5 4 (MSB = 7, LSB = 0, 7:6 = sign:exponent:nybble) */ const U8* nvp = (const U8*)(&nv); -# define HEXTRACT_EXPONENT_BITS() (nvp[5] | (nvp[4] & 0x7F) << 4) + HEXTRACT_GET_SUBNORMAL(nv); HEXTRACT_IMPLICIT_BIT(nv); HEXTRACT_TOP_NYBBLE(5); /* 6 */ HEXTRACT_BYTE(6); /* 5 */ @@ -11180,6 +11184,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, # endif #endif /* #if defined(USE_LONG_DOUBLE) && (NVSIZE > DOUBLESIZE) #else */ # ifdef HEXTRACT_FALLBACK + HEXTRACT_GET_SUBNORMAL(nv); # undef HEXTRACT_HAS_TOP_NYBBLE /* Meaningless, but consistent. */ /* The fallback is used for the double-double format, and * for unknown long double formats, and for unknown double @@ -12437,15 +12442,25 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p #if NVSIZE > DOUBLESIZE # ifdef HEXTRACT_HAS_IMPLICIT_BIT /* In this case there is an implicit bit, - * and therefore the exponent is shifted by one, - * unless this is a subnormal/denormal. */ - if (!subnormal) { - exponent--; - } + * and therefore the exponent is shifted by one. */ + exponent--; # else - /* In this case there is no implicit bit, - * and the exponent is shifted by the first xdigit. */ - exponent -= 4; +# ifdef NV_X86_80_BIT + if (subnormal) { + /* The subnormals of the x86-80 have a base exponent of -16382, + * (while the physical exponent bits are zero) but the frexp() + * returned the scientific-style floating exponent. We want + * to map the last one as: + * -16831..-16384 -> -16382 (the last normal is 0x1p-16382) + * -16835..-16388 -> -16384 + * since we want to keep the first hexdigit + * as one of the [8421]. */ + exponent = -4 * ( (exponent + 1) / -4) - 2; + } else { + exponent -= 4; + } +# endif + /* TBD: other non-implicit-bit platforms than the x86-80. */ # endif #endif @@ -12486,10 +12501,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p #endif if (subnormal) { +#ifndef NV_X86_80_BIT if (vfnz[0] > 1) { - /* We need to right shift the hex nybbles so - * that the output of the subnormal starts - * from the first true bit. */ + /* IEEE 754 subnormals (but not the x86 80-bit): + * we want "normalize" the subnormal, + * so we need to right shift the hex nybbles + * so that the output of the subnormal starts + * from the first true bit. (Another, equally + * valid, policy would be to dump the subnormal + * nybbles as-is, to display the "physical" layout.) */ int i, n; U8 *vshr; /* Find the ceil(log2(v[0])) of @@ -12505,6 +12525,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p vlnz++; } } +#endif v0 = vfnz; } else { v0 = vhex; @@ -12553,7 +12574,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p /* If the overflow goes all the * way to the front, we need to * insert 0x1 in front, and adjust - * the argument. */ + * the exponent. */ Move(v0, v0 + 1, vn, char); *v0 = 0x1; exponent += 4; diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index c690189..8b9931f 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -220,7 +220,7 @@ if ($Config{nvsize} == 8 && [ '%a', '0.25', '0x1p-2' ], [ '%a', '0.75', '0x1.8p-1' ], [ '%a', '3.14', '0x1.91eb851eb851eb851eb851eb85p+1' ], - [ '%a', '-1', '-0x0p+0' ], + [ '%a', '-1', '-0x1p+0' ], [ '%a', '-3.14', '-0x1.91eb851eb851eb851eb851eb85p+1' ], [ '%a', '0.1', '0x1.999999999999999999999999998p-4' ], [ '%a', '1/7', '0x1.249249249249249249249249248p-3' ], @@ -629,7 +629,7 @@ for my $t (@hexfloat) { ok($ok, "'$format' '$arg' -> '$result' cf '$expected'"); next; } - unless ($ok) { + if (!$ok && $result =~ /\./ && $expected =~ /\./) { # It seems that there can be difference in the last bits: # [perl #122578] # got "0x1.5bf0a8b14576ap+1" @@ -788,6 +788,12 @@ my @subnormals = ( [ '3e-322', '%.1a', '0x1.ep-1069' ], [ '3e-323', '%.1a', '0x1.8p-1072' ], [ '3e-324', '%.1a', '0x1.0p-1074' ], + [ '0x1.fffffffffffffp-1022', '%a', '0x1.fffffffffffffp-1022' ], + [ '0x0.fffffffffffffp-1022', '%a', '0x1.ffffffffffffep-1023' ], + [ '0x0.7ffffffffffffp-1022', '%a', '0x1.ffffffffffffcp-1024' ], + [ '0x0.3ffffffffffffp-1022', '%a', '0x1.ffffffffffff8p-1025' ], + [ '0x0.1ffffffffffffp-1022', '%a', '0x1.ffffffffffffp-1026' ], + [ '0x0.0ffffffffffffp-1022', '%a', '0x1.fffffffffffep-1027' ], ); SKIP: { @@ -799,7 +805,9 @@ SKIP: { $Config{doublekind} == 4)); for my $t (@subnormals) { - my $s = sprintf($t->[1], $t->[0]); + # Note that "0x1p+2" is not considered numeric, + # since neither is "0x12", hence the eval. + my $s = sprintf($t->[1], eval $t->[0]); is($s, $t->[2], "subnormal @$t got $s"); } @@ -851,13 +859,28 @@ SKIP: { # x86 80-bit long-double tests for # rt.perl.org #128843, #128888, #128889, #128890, #128893, #128909 SKIP: { - skip("non-80-bit-long-double", 12) + skip("non-80-bit-long-double", 17) unless ($Config{uselongdouble} && ($Config{nvsize} == 16 || $Config{nvsize} == 12) && ($Config{longdblkind} == 3 || $Config{longdblkind} == 4)); - is(sprintf("%.4a", 3e-320), "0xb.dc09p-1065", "[rt.perl.org #128843]"); + { + # The last normal for this format. + is(sprintf("%a", eval '0x1p-16382'), "0x8p-16385", "[rt.perl.org #128843]"); + + # The subnormals cause "exponent underflow" warnings, + # but that is not why we are here. + local $SIG{__WARN__} = sub { + die "$0: $_[0]" unless $_[0] =~ /exponent underflow/; + }; + + is(sprintf("%a", eval '0x1p-16383'), "0x4p-16382", "[rt.perl.org #128843]"); + is(sprintf("%a", eval '0x1p-16384'), "0x2p-16382", "[rt.perl.org #128843]"); + is(sprintf("%a", eval '0x1p-16385'), "0x1p-16382", "[rt.perl.org #128843]"); + is(sprintf("%a", eval '0x1p-16386'), "0x8p-16386", "[rt.perl.org #128843]"); + is(sprintf("%a", eval '0x1p-16387'), "0x4p-16386", "[rt.perl.org #128843]"); + } is(sprintf("%.0a", 1.03125), "0x8p-3", "[rt.perl.org #128888]"); is(sprintf("%.*a", -1, 1.03125), "0x8.4p-3", "[rt.perl.org #128889]"); is(sprintf("%.1a", 0x8.18p+0), "0x8.2p+0", "[rt.perl.org #128890]"); @@ -871,4 +894,24 @@ SKIP: { is(sprintf("%.0a", 1.9999999999999999999), "0x1p+1"); } +# quadmath tests for rt.perl.org #128843 +SKIP: { + skip "need quadmath", 7, unless $Config{usequadmath}; + + is(sprintf("%a", eval '0x1p-16382'), '0x1p-16382'); # last normal + + local $SIG{__WARN__} = sub { + die "$0: $_[0]" unless $_[0] =~ /exponent underflow/; + }; + + is(sprintf("%a", eval '0x1p-16383'), '0x1p-16383'); + is(sprintf("%a", eval '0x1p-16384'), '0x1p-16384'); + + is(sprintf("%a", eval '0x1p-16491'), '0x1p-16491'); + is(sprintf("%a", eval '0x1p-16492'), '0x1p-16492'); + is(sprintf("%a", eval '0x1p-16493'), '0x1p-16493'); # last denormal + + is(sprintf("%a", eval '0x1p-16494'), '0x1p-16494'); # underflow +} + done_testing(); -- Perl5 Master Repository
