grok_bin_oct_hex: Minor improvements to precision, speed

numeric.c

@@ -487,14 +487,21 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
           break;
     }
 
-    /* In overflows, this keeps track of how much to multiply the overflowed NV
-     * by as we continue to parse the remaining digits */
-    NV factor = 0.0;
+    /* The loop below accumulates the integral running total of the result,
+     * digit by digit.  If this total overflows, it adds that to an NV
+     * approximation, and starts looking at the next batch of digits, until
+     * they overflow, and so on.  This variable counts the number of digits
+     * seen in the current batch.  (The initial value is irrelevant, as the
+     * first batch will end up being multiplied by zero.) */
+    uint_fast8_t batch_digit_count = 0;
 
     bool overflowed = FALSE;
     NV value_nv = 0;
     const PERL_UINT_FAST8_T base = 1 << shift;  /* 2, 8, or 16 */
 
+    /* Value above which, the next digit processed would overflow */
+    UV max_div = UV_MAX >> shift;
+
     for (; s < e; s++) {
         if (generic_isCC_(*s, class_bit)) {
             /* Write it in this wonky order with a goto to attempt to get the
@@ -503,36 +510,35 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
                (khw suspects that adding a LIKELY() just above would do the
                same thing) */
           redo: ;
-
-            /* Make room for the next digit */
-            UV tentative_value = value << shift;
-
-            /* If shiftng back doesn't yield the previous value, it was
-             * because a bit got shifted off the left end, so overflowed.
-             * But if it worked, add the new digit. */
-            if (LIKELY((tentative_value >> shift) == value)) {
-                value = tentative_value | XDIGIT_VALUE(*s);
-                    /* Note XDIGIT_VALUE() is branchless, works on binary
-                     * and octal as well, so can be used here, without
-                     * slowing those down */
-                factor *= base;
+            if (LIKELY(value <= max_div)) {
+                /* Note XDIGIT_VALUE() is branchless, works on binary and
+                 * octal as well, so can be used here, without noticeably
+                 * slowing those down (it does have unnecessary shifts, ANDSs,
+                 * and additions for those) */
+                value = (value << shift) | XDIGIT_VALUE(*s);
+                batch_digit_count++;
                 continue;
             }
 
             /* Bah. We are about to overflow.  Instead, add the unoverflowed
              * value to an NV that contains an approximation to the correct
-             * value.  Each time through the loop we have increased 'factor' so
-             * that it gives how much the current approximation needs to
-             * effectively be shifted to make room for this new value */
-            value_nv *= factor;
+             * value.  Each time through the loop we have incremented
+             * 'batch_digit_count' so that it gives how many digits the
+             * current approximation needs to effectively be shifted to make
+             * room for this new value */
+#ifdef Perl_ldexp
+                value_nv = Perl_ldexp(value_nv, batch_digit_count * shift);
+#else
+                value_nv *= Perl_pow(base, batch_digit_count);
+#endif
             value_nv += (NV) value;
 
             /* Then we keep accumulating digits, until all are parsed.  We
              * start over using the current input value.  This will be added to
              * 'value_nv' eventually, either when all digits are gone, or we
              * have overflowed this fresh start. */
             value = XDIGIT_VALUE(*s);
-            factor = base;
+            batch_digit_count = 1;
 
             if (! overflowed) {
                 overflowed = TRUE;
@@ -551,14 +557,13 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
             continue;
         }
 
-        if (   *s == '_'
+        /* Handle non-trailing underscores when those are accepted */
+        if (   UNLIKELY(*s == '_')
             && s < e - 1
             && allow_underscores
             && generic_isCC_(s[1], class_bit)
-
-                /* Don't allow a leading underscore if the only-medial bit is
-                 * set */
             && (   LIKELY(s > s0)
+                   /* Including initial underscores if those are accepted */
                 || UNLIKELY(! (  input_flags
                                & PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES_ONLY))))
         {
@@ -567,14 +572,17 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
             /* To get here with the value so-far being 0 means we've only had
              * leading zeros, then an underscore.  We can continue with the
              * branchless switch() instead of this loop */
-            if (value == 0) {
+            if (UNLIKELY(value == 0)) {
                 goto redo_switch;
             }
             else {
                 goto redo;
             }
         }
 
+        /* We get here when done with the parse, or it got interrupted by a
+         * non-digit or a digit that is outside the bounds of the base, like a
+         * digit 2 in a binary number */
         if (*s) {
             if (   ! (input_flags & PERL_SCAN_SILENT_ILLDIGIT)
                 &&    ckWARN(WARN_DIGIT))
@@ -593,7 +601,8 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
                      * scanning as soon as non-octal characters are seen,
                      * complain only if someone seems to want to use the digits
                      * eight and nine.  Since we know it is not octal, then if
-                     * isDIGIT, must be an 8 or 9). */
+                     * isDIGIT, must be an 8 or 9). khw: XXX why not DWIM for
+                     * other bases as well? */
                     warner(packWARN(WARN_DIGIT),
                            "Illegal octal digit '%c' ignored", *s);
                 }
@@ -604,8 +613,9 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
             }
         }
 
+        /* Error, so quit parsing */
         break;
-    }
+    }   /* End of parsing loop */
 
     *len_p = s - start;
 
@@ -622,7 +632,11 @@ Perl_grok_bin_oct_hex(pTHX_ const char * const start,
     }
 
     /* Overflowed: Calculate the final overflow approximation */
-    value_nv *= factor;
+#ifdef Perl_ldexp
+        value_nv = Perl_ldexp(value_nv, batch_digit_count * shift);
+#else
+        value_nv *= Perl_pow(base, batch_digit_count);
+#endif
     value_nv += (NV) value;
 
     output_non_portable(base);