This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Handle subnormals of x86 80-bit
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 15 Aug 2016 02:52:40 +0000 (22:52 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Thu, 18 Aug 2016 02:13:36 +0000 (22:13 -0400)
perl.h
sv.c
t/op/sprintf2.t

diff --git a/perl.h b/perl.h
index 23b6431..cd081eb 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -6897,6 +6897,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 26b86c4..c4cac80 100644 (file)
--- 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
@@ -12442,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
 
@@ -12491,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
@@ -12510,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;
@@ -12558,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;
index 4538081..11f12a3 100644 (file)
@@ -859,16 +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", 15)
+    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]");
-    is(sprintf("%a", eval '0x1.ffffp-2000'), "0xf.fff8p-2003", "[rt.perl.org #128843]");
-    is(sprintf("%.3a", eval '0x1.ffffp-2000'), "0x1.000p-1999", "[rt.perl.org #128843]");
-    is(sprintf("%.2a", eval '0x1.ffffp-2000'), "0x1.00p-1999", "[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]");