This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/ebcdic.pl: Fix bug in decoding some high code points
[perl5.git] / numeric.c
index 37a1029..db8197c 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -29,6 +29,107 @@ values, including such things as replacements for the OS's atof() function
 #define PERL_IN_NUMERIC_C
 #include "perl.h"
 
 #define PERL_IN_NUMERIC_C
 #include "perl.h"
 
+#ifdef Perl_strtod
+
+PERL_STATIC_INLINE NV
+S_strtod(pTHX_ const char * const s, char ** e)
+{
+    DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+    NV result;
+
+    STORE_LC_NUMERIC_SET_TO_NEEDED();
+
+#  ifdef USE_QUADMATH
+
+    result = strtoflt128(s, e);
+
+#  elif defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE)    \
+                             && defined(USE_LONG_DOUBLE)
+#    if defined(__MINGW64_VERSION_MAJOR)
+      /***********************************************
+       We are unable to use strtold because of
+        https://sourceforge.net/p/mingw-w64/bugs/711/
+        &
+        https://sourceforge.net/p/mingw-w64/bugs/725/
+
+       but __mingw_strtold is fine.
+      ***********************************************/
+
+    result = __mingw_strtold(s, e);
+
+#    else
+
+    result = strtold(s, e);
+
+#    endif
+#  elif defined(HAS_STRTOD)
+
+    result = strtod(s, e);
+
+#  else
+#    error No strtod() equivalent found
+#  endif
+
+    RESTORE_LC_NUMERIC();
+
+    return result;
+}
+
+#endif  /* #ifdef Perl_strtod */
+
+/*
+
+=for apidoc my_strtod
+
+This function is equivalent to the libc strtod() function, and is available
+even on platforms that lack plain strtod().  Its return value is the best
+available precision depending on platform capabilities and F<Configure>
+options.
+
+It properly handles the locale radix character, meaning it expects a dot except
+when called from within the scope of S<C<use locale>>, in which case the radix
+character should be that specified by the current locale.
+
+The synonym Strtod() may be used instead.
+
+=cut
+
+*/
+
+NV
+Perl_my_strtod(const char * const s, char **e)
+{
+    dTHX;
+
+    PERL_ARGS_ASSERT_MY_STRTOD;
+
+#ifdef Perl_strtod
+
+    return S_strtod(aTHX_ s, e);
+
+#else
+
+    {
+        NV result;
+        char ** end_ptr = NULL;
+
+        *end_ptr = my_atof2(s, &result);
+        if (e) {
+            *e = *end_ptr;
+        }
+
+        if (! *end_ptr) {
+            result = 0.0;
+        }
+
+        return result;
+    }
+
+#endif
+
+}
+
+
 U32
 Perl_cast_ulong(NV f)
 {
 U32
 Perl_cast_ulong(NV f)
 {
@@ -39,7 +140,7 @@ Perl_cast_ulong(NV f)
     if (f < U32_MAX_P1_HALF)
       return (U32) f;
     f -= U32_MAX_P1_HALF;
     if (f < U32_MAX_P1_HALF)
       return (U32) f;
     f -= U32_MAX_P1_HALF;
-    return ((U32) f) | (1 + U32_MAX >> 1);
+    return ((U32) f) | (1 + (U32_MAX >> 1));
 #else
     return (U32) f;
 #endif
 #else
     return (U32) f;
 #endif
@@ -57,7 +158,7 @@ Perl_cast_i32(NV f)
     if (f < U32_MAX_P1_HALF)
       return (I32)(U32) f;
     f -= U32_MAX_P1_HALF;
     if (f < U32_MAX_P1_HALF)
       return (I32)(U32) f;
     f -= U32_MAX_P1_HALF;
-    return (I32)(((U32) f) | (1 + U32_MAX >> 1));
+    return (I32)(((U32) f) | (1 + (U32_MAX >> 1)));
 #else
     return (I32)(U32) f;
 #endif
 #else
     return (I32)(U32) f;
 #endif
@@ -76,7 +177,7 @@ Perl_cast_iv(NV f)
     if (f < UV_MAX_P1_HALF)
       return (IV)(UV) f;
     f -= UV_MAX_P1_HALF;
     if (f < UV_MAX_P1_HALF)
       return (IV)(UV) f;
     f -= UV_MAX_P1_HALF;
-    return (IV)(((UV) f) | (1 + UV_MAX >> 1));
+    return (IV)(((UV) f) | (1 + (UV_MAX >> 1)));
 #else
     return (IV)(UV) f;
 #endif
 #else
     return (IV)(UV) f;
 #endif
@@ -94,7 +195,7 @@ Perl_cast_uv(NV f)
     if (f < UV_MAX_P1_HALF)
       return (UV) f;
     f -= UV_MAX_P1_HALF;
     if (f < UV_MAX_P1_HALF)
       return (UV) f;
     f -= UV_MAX_P1_HALF;
-    return ((UV) f) | (1 + UV_MAX >> 1);
+    return ((UV) f) | (1 + (UV_MAX >> 1));
 #else
     return (UV) f;
 #endif
 #else
     return (UV) f;
 #endif
@@ -107,24 +208,30 @@ Perl_cast_uv(NV f)
 
 converts a string representing a binary number to numeric form.
 
 
 converts a string representing a binary number to numeric form.
 
-On entry I<start> and I<*len> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
 The scan stops at the end of the string, or the first invalid character.
 The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
 invalid character will also trigger a warning.
 invalid character will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
 
 If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
 
 If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>.  If the value is > UV_MAX C<grok_bin>
-returns UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
+and nothing is written to C<*result>.  If the value is > C<UV_MAX>, C<grok_bin>
+returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
 is NULL).
 
 is NULL).
 
-The binary number may optionally be prefixed with "0b" or "b" unless
-C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry.  If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
-number may use '_' characters to separate digits.
+The binary number may optionally be prefixed with C<"0b"> or C<"b"> unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry.  If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the binary
+number may use C<"_"> characters to separate digits.
+
+=for apidoc Amnh||PERL_SCAN_ALLOW_UNDERSCORES
+=for apidoc Amnh||PERL_SCAN_DISALLOW_PREFIX
+=for apidoc Amnh||PERL_SCAN_GREATER_THAN_UV_MAX
+=for apidoc Amnh||PERL_SCAN_SILENT_ILLDIGIT
+=for apidoc Amnh||PERL_SCAN_TRAILING
 
 =cut
 
 
 =cut
 
@@ -204,7 +311,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                           "Illegal binary digit '%c' ignored", *s);
         break;
     }
                           "Illegal binary digit '%c' ignored", *s);
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -230,24 +337,24 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
 
 converts a string representing a hex number to numeric form.
 
 
 converts a string representing a hex number to numeric form.
 
-On entry I<start> and I<*len_p> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len_p> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
 The scan stops at the end of the string, or the first invalid character.
 The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
 invalid character will also trigger a warning.
 invalid character will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
 
 
-If the value is <= UV_MAX it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>.  If the value is > UV_MAX C<grok_hex>
-returns UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
-is NULL).
+If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
+and nothing is written to C<*result>.  If the value is > C<UV_MAX>, C<grok_hex>
+returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
+is C<NULL>).
 
 
-The hex number may optionally be prefixed with "0x" or "x" unless
-C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry.  If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
-number may use '_' characters to separate digits.
+The hex number may optionally be prefixed with C<"0x"> or C<"x"> unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry.  If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the hex
+number may use C<"_"> characters to separate digits.
 
 =cut
 
 
 =cut
 
@@ -325,7 +432,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                         "Illegal hexadecimal digit '%c' ignored", *s);
         break;
     }
                         "Illegal hexadecimal digit '%c' ignored", *s);
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -351,22 +458,22 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
 
 converts a string representing an octal number to numeric form.
 
 
 converts a string representing an octal number to numeric form.
 
-On entry I<start> and I<*len> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
 The scan stops at the end of the string, or the first invalid character.
 The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
 8 or 9 will also trigger a warning.
 8 or 9 will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
 
 
-If the value is <= UV_MAX it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>.  If the value is > UV_MAX C<grok_oct>
-returns UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
-is NULL).
+If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
+and nothing is written to C<*result>.  If the value is > C<UV_MAX>, C<grok_oct>
+returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
+is C<NULL>).
 
 
-If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the octal
-number may use '_' characters to separate digits.
+If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the octal
+number may use C<"_"> characters to separate digits.
 
 =cut
 
 
 =cut
 
@@ -432,7 +539,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
         }
         break;
     }
         }
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -518,168 +625,71 @@ Scan and skip for a numeric decimal separator (radix).
 bool
 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 {
 bool
 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 {
-#ifdef USE_LOCALE_NUMERIC
-    PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
-
-    if (IN_LC(LC_NUMERIC)) {
-        DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
-        if (PL_numeric_radix_sv) {
-            STRLEN len;
-            const char * const radix = SvPV(PL_numeric_radix_sv, len);
-            if (*sp + len <= send && memEQ(*sp, radix, len)) {
-                *sp += len;
-                RESTORE_LC_NUMERIC();
-                return TRUE;
-            }
-        }
-        RESTORE_LC_NUMERIC();
-    }
-    /* always try "." if numeric radix didn't match because
-     * we may have data from different locales mixed */
-#endif
-
     PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
 
     PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
 
-    if (*sp < send && **sp == '.') {
-        ++*sp;
-        return TRUE;
-    }
-    return FALSE;
-}
-
-/*
-=for apidoc nan_hibyte
-
-Given an NV, returns pointer to the byte containing the most
-significant bit of the NaN, this bit is most commonly the
-quiet/signaling bit of the NaN.  The mask will contain a mask
-appropriate for manipulating the most significant bit.
-Note that this bit may not be the highest bit of the byte.
-
-If the NV is not a NaN, returns NULL.
-
-Most platforms have "high bit is one" -> quiet nan.
-The known opposite exceptions are older MIPS and HPPA platforms.
-
-Some platforms do not differentiate between quiet and signaling NaNs.
-
-=cut
-*/
-U8*
-Perl_nan_hibyte(NV *nvp, U8* mask)
-{
-    STRLEN i = (NV_MANT_REAL_DIG - 1) / 8;
-    STRLEN j = (NV_MANT_REAL_DIG - 1) % 8;
+#ifdef USE_LOCALE_NUMERIC
 
 
-    PERL_ARGS_ASSERT_NAN_HIBYTE;
+    if (IN_LC(LC_NUMERIC)) {
+        STRLEN len;
+        char * radix;
+        bool matches_radix = FALSE;
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
 
 
-    *mask = 1 << j;
-#ifdef NV_BIG_ENDIAN
-    return (U8*) nvp + NVSIZE - 1 - i;
-#endif
-#ifdef NV_LITTLE_ENDIAN
-    return (U8*) nvp + i;
-#endif
-}
+        STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
 
 
-/*
-=for apidoc nan_signaling_set
+        radix = SvPV(PL_numeric_radix_sv, len);
+        radix = savepvn(radix, len);
 
 
-Set or unset the NaN signaling-ness.
+        RESTORE_LC_NUMERIC();
 
 
-Of those platforms that differentiate between quiet and signaling
-platforms the majority has the semantics of the most significant bit
-being on meaning quiet NaN, so for signaling we need to clear the bit.
+        if (*sp + len <= send) {
+            matches_radix = memEQ(*sp, radix, len);
+        }
 
 
-Some platforms (older MIPS, and HPPA) have the opposite
-semantics, and we set the bit for a signaling NaN.
+        Safefree(radix);
 
 
-=cut
-*/
-void
-Perl_nan_signaling_set(NV *nvp, bool signaling)
-{
-    U8 mask;
-    U8* hibyte;
-
-    PERL_ARGS_ASSERT_NAN_SIGNALING_SET;
-
-    hibyte = nan_hibyte(nvp, &mask);
-    if (hibyte) {
-        const NV nan = NV_NAN;
-        /* Decent optimizers should make the irrelevant branch to disappear. */
-        if ((((U8*)&nan)[hibyte - (U8*)nvp] & mask)) {
-            /* x86 style: the most significant bit of the NaN is off
-             * for a signaling NaN, and on for a quiet NaN. */
-            if (signaling) {
-                *hibyte &= ~mask;
-            } else {
-                *hibyte |=  mask;
-            }
-        } else {
-            /* MIPS/HPPA style: the most significant bit of the NaN is on
-             * for a signaling NaN, and off for a quiet NaN. */
-            if (signaling) {
-                *hibyte |=  mask;
-            } else {
-                *hibyte &= ~mask;
-            }
+        if (matches_radix) {
+            *sp += len;
+            return TRUE;
         }
     }
         }
     }
-}
-
-/*
-=for apidoc nan_is_signaling
 
 
-Returns true if the nv is a NaN is a signaling NaN.
+#endif
 
 
-=cut
-*/
-int
-Perl_nan_is_signaling(NV nv)
-{
-    /* Quiet NaN bit pattern (64-bit doubles, ignore endianness):
-     * x86    00 00 00 00 00 00 f8 7f
-     * sparc  7f ff ff ff ff ff ff ff
-     * mips   7f f7 ff ff ff ff ff ff
-     * hppa   7f f4 00 00 00 00 00 00
-     * The "7ff" is the exponent.  The most significant bit of the NaN
-     * (note: here, not the most significant bit of the byte) is of
-     * interest: in the x86 style (also in sparc) the bit on means
-     * 'quiet', in the mips style the bit off means 'quiet'. */
-#ifdef Perl_fp_classify_snan
-    return Perl_fp_classify_snan(nv);
-#else
-    if (Perl_isnan(nv)) {
-        U8 mask;
-        U8 *hibyte = Perl_nan_hibyte(&nv, &mask);
-        /* Hoping NV_NAN is a quiet nan - this might be a false hope.
-         * XXX Configure test */
-        const NV nan = NV_NAN;
-        return (*hibyte & mask) != (((U8*)&nan)[hibyte - (U8*)&nv] & mask);
-    } else {
-        return 0;
+    /* always try "." if numeric radix didn't match because
+     * we may have data from different locales mixed */
+    if (*sp < send && **sp == '.') {
+        ++*sp;
+        return TRUE;
     }
     }
-#endif
+
+    return FALSE;
 }
 
 /*
 =for apidoc grok_infnan
 
 }
 
 /*
 =for apidoc grok_infnan
 
-Helper for grok_number(), accepts various ways of spelling "infinity"
+Helper for C<grok_number()>, accepts various ways of spelling "infinity"
 or "not a number", and returns one of the following flag combinations:
 
 or "not a number", and returns one of the following flag combinations:
 
-  IS_NUMBER_INFINITE
+  IS_NUMBER_INFINITY
   IS_NUMBER_NAN
   IS_NUMBER_NAN
-  IS_NUMBER_INFINITE | IS_NUMBER_NEG
+  IS_NUMBER_INFINITY | IS_NUMBER_NEG
   IS_NUMBER_NAN | IS_NUMBER_NEG
   0
 
   IS_NUMBER_NAN | IS_NUMBER_NEG
   0
 
-possibly |-ed with IS_NUMBER_TRAILING.
+possibly |-ed with C<IS_NUMBER_TRAILING>.
 
 
-If an infinity or a not-a-number is recognized, the *sp will point to
+If an infinity or a not-a-number is recognized, C<*sp> will point to
 one byte past the end of the recognized string.  If the recognition fails,
 one byte past the end of the recognized string.  If the recognition fails,
-zero is returned, and the *sp will not move.
+zero is returned, and C<*sp> will not move.
+
+=for apidoc Amn|bool|IS_NUMBER_GREATER_THAN_UV_MAX
+=for apidoc Amn|bool|IS_NUMBER_INFINITY
+=for apidoc Amn|bool|IS_NUMBER_IN_UV
+=for apidoc Amn|bool|IS_NUMBER_NAN
+=for apidoc Amn|bool|IS_NUMBER_NEG
+=for apidoc Amn|bool|IS_NUMBER_NOT_INT
 
 =cut
 */
 
 =cut
 */
@@ -689,6 +699,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
 {
     const char* s = *sp;
     int flags = 0;
 {
     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;
     bool odh = FALSE; /* one-dot-hash: 1.#INF */
 
     PERL_ARGS_ASSERT_GROK_INFNAN;
@@ -913,6 +924,9 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
     while (s < send && isSPACE(*s))
         s++;
 
     while (s < send && isSPACE(*s))
         s++;
 
+#else
+    PERL_UNUSED_ARG(send);
+#endif /* #if defined(NV_INF) || defined(NV_NAN) */
     *sp = s;
     return flags;
 }
     *sp = s;
     return flags;
 }
@@ -922,20 +936,20 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
 
 Recognise (or not) a number.  The type of the number is returned
 (0 if unrecognised), otherwise it is a bit-ORed combination of
 
 Recognise (or not) a number.  The type of the number is returned
 (0 if unrecognised), otherwise it is a bit-ORed combination of
-IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
-IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h).
-
-If the value of the number can fit in a UV, it is returned in the *valuep
-IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
-will never be set unless *valuep is valid, but *valuep may have been assigned
-to during processing even though IS_NUMBER_IN_UV is not set on return.
-If valuep is NULL, IS_NUMBER_IN_UV will be set for the same cases as when
-valuep is non-NULL, but no actual assignment (or SEGV) will occur.
-
-IS_NUMBER_NOT_INT will be set with IS_NUMBER_IN_UV if trailing decimals were
-seen (in which case *valuep gives the true value truncated to an integer), and
-IS_NUMBER_NEG if the number is negative (in which case *valuep holds the
-absolute value).  IS_NUMBER_IN_UV is not set if e notation was used or the
+C<IS_NUMBER_IN_UV>, C<IS_NUMBER_GREATER_THAN_UV_MAX>, C<IS_NUMBER_NOT_INT>,
+C<IS_NUMBER_NEG>, C<IS_NUMBER_INFINITY>, C<IS_NUMBER_NAN> (defined in perl.h).
+
+If the value of the number can fit in a UV, it is returned in C<*valuep>.
+C<IS_NUMBER_IN_UV> will be set to indicate that C<*valuep> is valid, C<IS_NUMBER_IN_UV>
+will never be set unless C<*valuep> is valid, but C<*valuep> may have been assigned
+to during processing even though C<IS_NUMBER_IN_UV> is not set on return.
+If C<valuep> is C<NULL>, C<IS_NUMBER_IN_UV> will be set for the same cases as when
+C<valuep> is non-C<NULL>, but no actual assignment (or SEGV) will occur.
+
+C<IS_NUMBER_NOT_INT> will be set with C<IS_NUMBER_IN_UV> if trailing decimals were
+seen (in which case C<*valuep> gives the true value truncated to an integer), and
+C<IS_NUMBER_NEG> if the number is negative (in which case C<*valuep> holds the
+absolute value).  C<IS_NUMBER_IN_UV> is not set if e notation was used or the
 number is larger than a UV.
 
 C<flags> allows only C<PERL_SCAN_TRAILING>, which allows for trailing
 number is larger than a UV.
 
 C<flags> allows only C<PERL_SCAN_TRAILING>, which allows for trailing
@@ -944,7 +958,7 @@ C<IS_NUMBER_TRAILING> on the result.
 
 =for apidoc grok_number
 
 
 =for apidoc grok_number
 
-Identical to grok_number_flags() with flags set to zero.
+Identical to C<grok_number_flags()> with C<flags> set to zero.
 
 =cut
  */
 
 =cut
  */
@@ -999,41 +1013,41 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
        before checking for overflow.  */
     if (++s < send) {
       int digit = *s - '0';
        before checking for overflow.  */
     if (++s < send) {
       int digit = *s - '0';
-      if (digit >= 0 && digit <= 9) {
+      if (inRANGE(digit, 0, 9)) {
         value = value * 10 + digit;
         if (++s < send) {
           digit = *s - '0';
         value = value * 10 + digit;
         if (++s < send) {
           digit = *s - '0';
-          if (digit >= 0 && digit <= 9) {
+          if (inRANGE(digit, 0, 9)) {
             value = value * 10 + digit;
             if (++s < send) {
               digit = *s - '0';
             value = value * 10 + digit;
             if (++s < send) {
               digit = *s - '0';
-              if (digit >= 0 && digit <= 9) {
+              if (inRANGE(digit, 0, 9)) {
                 value = value * 10 + digit;
                if (++s < send) {
                   digit = *s - '0';
                 value = value * 10 + digit;
                if (++s < send) {
                   digit = *s - '0';
-                  if (digit >= 0 && digit <= 9) {
+                  if (inRANGE(digit, 0, 9)) {
                     value = value * 10 + digit;
                     if (++s < send) {
                       digit = *s - '0';
                     value = value * 10 + digit;
                     if (++s < send) {
                       digit = *s - '0';
-                      if (digit >= 0 && digit <= 9) {
+                      if (inRANGE(digit, 0, 9)) {
                         value = value * 10 + digit;
                         if (++s < send) {
                           digit = *s - '0';
                         value = value * 10 + digit;
                         if (++s < send) {
                           digit = *s - '0';
-                          if (digit >= 0 && digit <= 9) {
+                          if (inRANGE(digit, 0, 9)) {
                             value = value * 10 + digit;
                             if (++s < send) {
                               digit = *s - '0';
                             value = value * 10 + digit;
                             if (++s < send) {
                               digit = *s - '0';
-                              if (digit >= 0 && digit <= 9) {
+                              if (inRANGE(digit, 0, 9)) {
                                 value = value * 10 + digit;
                                 if (++s < send) {
                                   digit = *s - '0';
                                 value = value * 10 + digit;
                                 if (++s < send) {
                                   digit = *s - '0';
-                                  if (digit >= 0 && digit <= 9) {
+                                  if (inRANGE(digit, 0, 9)) {
                                     value = value * 10 + digit;
                                     if (++s < send) {
                                       /* Now got 9 digits, so need to check
                                          each time for overflow.  */
                                       digit = *s - '0';
                                     value = value * 10 + digit;
                                     if (++s < send) {
                                       /* Now got 9 digits, so need to check
                                          each time for overflow.  */
                                       digit = *s - '0';
-                                      while (digit >= 0 && digit <= 9
+                                      while (    inRANGE(digit, 0, 9)
                                              && (value < uv_max_div_10
                                                  || (value == uv_max_div_10
                                                      && digit <= uv_max_mod_10))) {
                                              && (value < uv_max_div_10
                                                  || (value == uv_max_div_10
                                                      && digit <= uv_max_mod_10))) {
@@ -1043,7 +1057,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
                                         else
                                           break;
                                       }
                                         else
                                           break;
                                       }
-                                      if (digit >= 0 && digit <= 9
+                                      if (inRANGE(digit, 0, 9)
                                           && (s < send)) {
                                         /* value overflowed.
                                            skip the remaining digits, don't
                                           && (s < send)) {
                                         /* value overflowed.
                                            skip the remaining digits, don't
@@ -1124,7 +1138,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
     s++;
   if (s >= send)
     return numtype;
     s++;
   if (s >= send)
     return numtype;
-  if (len == 10 && memEQ(pv, "0 but true", 10)) {
+  if (memEQs(pv, len, "0 but true")) {
     if (valuep)
       *valuep = 0;
     return IS_NUMBER_IN_UV;
     if (valuep)
       *valuep = 0;
     return IS_NUMBER_IN_UV;
@@ -1133,7 +1147,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
   if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
       /* Really detect inf/nan. Start at d, not s, since the above
        * code might have already consumed the "1." or "1". */
   if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
       /* Really detect inf/nan. Start at d, not s, since the above
        * code might have already consumed the "1." or "1". */
-      int infnan = Perl_grok_infnan(aTHX_ &d, send);
+      const int infnan = Perl_grok_infnan(aTHX_ &d, send);
       if ((infnan & IS_NUMBER_INFINITY)) {
           return (numtype | infnan); /* Keep sign for infinity. */
       }
       if ((infnan & IS_NUMBER_INFINITY)) {
           return (numtype | infnan); /* Keep sign for infinity. */
       }
@@ -1149,91 +1163,103 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
 }
 
 /*
 }
 
 /*
-=for apidoc grok_atou
-
-grok_atou is a safer replacement for atoi and strtol.
-
-grok_atou parses a C-style zero-byte terminated string, looking for
-a decimal unsigned integer.
-
-Returns the unsigned integer, if a valid value can be parsed
-from the beginning of the string.
+=for apidoc grok_atoUV
 
 
-Accepts only the decimal digits '0'..'9'.
+parse a string, looking for a decimal unsigned integer.
 
 
-As opposed to atoi or strtol, grok_atou does NOT allow optional
-leading whitespace, or negative inputs.  If such features are
-required, the calling code needs to explicitly implement those.
+On entry, C<pv> points to the beginning of the string;
+C<valptr> points to a UV that will receive the converted value, if found;
+C<endptr> is either NULL or points to a variable that points to one byte
+beyond the point in C<pv> that this routine should examine.
+If C<endptr> is NULL, C<pv> is assumed to be NUL-terminated.
 
 
-If a valid value cannot be parsed, returns either zero (if non-digits
-are met before any digits) or UV_MAX (if the value overflows).
+Returns FALSE if C<pv> doesn't represent a valid unsigned integer value (with
+no leading zeros).  Otherwise it returns TRUE, and sets C<*valptr> to that
+value.
 
 
-Note that extraneous leading zeros also count as an overflow
-(meaning that only "0" is the zero).
+If you constrain the portion of C<pv> that is looked at by this function (by
+passing a non-NULL C<endptr>), and if the intial bytes of that portion form a
+valid value, it will return TRUE, setting C<*endptr> to the byte following the
+final digit of the value.  But if there is no constraint at what's looked at,
+all of C<pv> must be valid in order for TRUE to be returned.
 
 
-On failure, the *endptr is also set to NULL, unless endptr is NULL.
+The only characters this accepts are the decimal digits '0'..'9'.
 
 
-Trailing non-digit bytes are allowed if the endptr is non-NULL.
-On return the *endptr will contain the pointer to the first non-digit byte.
+As opposed to L<atoi(3)> or L<strtol(3)>, C<grok_atoUV> does NOT allow optional
+leading whitespace, nor negative inputs.  If such features are required, the
+calling code needs to explicitly implement those.
 
 
-If the endptr is NULL, the first non-digit byte MUST be
-the zero byte terminating the pv, or zero will be returned.
+Note that this function returns FALSE for inputs that would overflow a UV,
+or have leading zeros.  Thus a single C<0> is accepted, but not C<00> nor
+C<01>, C<002>, I<etc>.
 
 
-Background: atoi has severe problems with illegal inputs, it cannot be
+Background: C<atoi> has severe problems with illegal inputs, it cannot be
 used for incremental parsing, and therefore should be avoided
 used for incremental parsing, and therefore should be avoided
-atoi and strtol are also affected by locale settings, which can also be
+C<atoi> and C<strtol> are also affected by locale settings, which can also be
 seen as a bug (global state controlled by user environment).
 
 =cut
 seen as a bug (global state controlled by user environment).
 
 =cut
+
 */
 
 */
 
-UV
-Perl_grok_atou(const char *pv, const char** endptr)
+bool
+Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
 {
     const char* s = pv;
     const char** eptr;
     const char* end2; /* Used in case endptr is NULL. */
 {
     const char* s = pv;
     const char** eptr;
     const char* end2; /* Used in case endptr is NULL. */
-    UV val = 0; /* The return value. */
+    UV val = 0; /* The parsed value. */
 
 
-    PERL_ARGS_ASSERT_GROK_ATOU;
+    PERL_ARGS_ASSERT_GROK_ATOUV;
 
 
-    eptr = endptr ? endptr : &end2;
-    if (isDIGIT(*s)) {
-        /* Single-digit inputs are quite common. */
-        val = *s++ - '0';
-        if (isDIGIT(*s)) {
-            /* Extra leading zeros cause overflow. */
-            if (val == 0) {
-                *eptr = NULL;
-                return UV_MAX;
-            }
-            while (isDIGIT(*s)) {
-                /* This could be unrolled like in grok_number(), but
-                 * the expected uses of this are not speed-needy, and
-                 * unlikely to need full 64-bitness. */
-                U8 digit = *s++ - '0';
-                if (val < uv_max_div_10 ||
-                    (val == uv_max_div_10 && digit <= uv_max_mod_10)) {
-                    val = val * 10 + digit;
-                } else {
-                    *eptr = NULL;
-                    return UV_MAX;
-                }
+    if (endptr) {
+        eptr = endptr;
+    }
+    else {
+        end2 = s + strlen(s);
+        eptr = &end2;
+    }
+
+    if (   *eptr <= s
+        || ! isDIGIT(*s))
+    {
+        return FALSE;
+    }
+
+    /* Single-digit inputs are quite common. */
+    val = *s++ - '0';
+    if (s < *eptr && isDIGIT(*s)) {
+        /* Fail on extra leading zeros. */
+        if (val == 0)
+            return FALSE;
+        while (s < *eptr && isDIGIT(*s)) {
+            /* This could be unrolled like in grok_number(), but
+                * the expected uses of this are not speed-needy, and
+                * unlikely to need full 64-bitness. */
+            const U8 digit = *s++ - '0';
+            if (val < uv_max_div_10 ||
+                (val == uv_max_div_10 && digit <= uv_max_mod_10)) {
+                val = val * 10 + digit;
+            } else {
+                return FALSE;
             }
         }
     }
             }
         }
     }
-    if (s == pv) {
-        *eptr = NULL; /* If no progress, failed to parse anything. */
-        return 0;
+
+    if (endptr == NULL) {
+        if (*s) {
+            return FALSE; /* If endptr is NULL, no trailing non-digits allowed. */
+        }
     }
     }
-    if (endptr == NULL && *s) {
-        return 0; /* If endptr is NULL, no trailing non-digits allowed. */
+    else {
+        *endptr = s;
     }
     }
-    *eptr = s;
-    return val;
+
+    *valptr = val;
+    return TRUE;
 }
 
 }
 
-#ifndef USE_QUADMATH
+#ifndef Perl_strtod
 STATIC NV
 S_mulexp10(NV value, I32 exponent)
 {
 STATIC NV
 S_mulexp10(NV value, I32 exponent)
 {
@@ -1249,11 +1275,11 @@ S_mulexp10(NV value, I32 exponent)
 
     /* On OpenVMS VAX we by default use the D_FLOAT double format,
      * and that format does not have *easy* capabilities [1] for
 
     /* On OpenVMS VAX we by default use the D_FLOAT double format,
      * and that format does not have *easy* capabilities [1] for
-     * overflowing doubles 'silently' as IEEE fp does.  We also need 
-     * to support G_FLOAT on both VAX and Alpha, and though the exponent 
-     * range is much larger than D_FLOAT it still doesn't do silent 
-     * overflow.  Therefore we need to detect early whether we would 
-     * overflow (this is the behaviour of the native string-to-float 
+     * overflowing doubles 'silently' as IEEE fp does.  We also need
+     * to support G_FLOAT on both VAX and Alpha, and though the exponent
+     * range is much larger than D_FLOAT it still doesn't do silent
+     * overflow.  Therefore we need to detect early whether we would
+     * overflow (this is the behaviour of the native string-to-float
      * conversion routines, and therefore of native applications, too).
      *
      * [1] Trying to establish a condition handler to trap floating point
      * conversion routines, and therefore of native applications, too).
      *
      * [1] Trying to establish a condition handler to trap floating point
@@ -1267,7 +1293,7 @@ S_mulexp10(NV value, I32 exponent)
      * a hammer.  Therefore we need to catch potential overflows before
      * it's too late. */
 
      * a hammer.  Therefore we need to catch potential overflows before
      * it's too late. */
 
-#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
+#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP)
     STMT_START {
        const NV exp_v = log10(value);
        if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
     STMT_START {
        const NV exp_v = log10(value);
        if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
@@ -1314,10 +1340,14 @@ S_mulexp10(NV value, I32 exponent)
            result *= power;
 #ifdef FP_OVERFLOWS_TO_ZERO
             if (result == 0)
            result *= power;
 #ifdef FP_OVERFLOWS_TO_ZERO
             if (result == 0)
+# ifdef NV_INF
                 return value < 0 ? -NV_INF : NV_INF;
                 return value < 0 ? -NV_INF : NV_INF;
+# else
+                return value < 0 ? -FLT_MAX : FLT_MAX;
+# endif
 #endif
            /* Floating point exceptions are supposed to be turned off,
 #endif
            /* Floating point exceptions are supposed to be turned off,
-            *  but if we're obviously done, don't risk another iteration.  
+            *  but if we're obviously done, don't risk another iteration.
             */
             if (exponent == 0) break;
        }
             */
             if (exponent == 0) break;
        }
@@ -1325,24 +1355,36 @@ S_mulexp10(NV value, I32 exponent)
     }
     return negative ? value / result : value * result;
 }
     }
     return negative ? value / result : value * result;
 }
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
+
+#ifdef Perl_strtod
+#  define ATOF(s, x) my_atof2(s, &x)
+#else
+#  define ATOF(s, x) Perl_atof2(s, x)
+#endif
 
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
 
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
+    /* 's' must be NUL terminated */
+
     NV x = 0.0;
     NV x = 0.0;
-#ifdef USE_QUADMATH
-    Perl_my_atof2(aTHX_ s, &x);
-    return x;
-#else
-#  ifdef USE_LOCALE_NUMERIC
+
     PERL_ARGS_ASSERT_MY_ATOF;
 
     PERL_ARGS_ASSERT_MY_ATOF;
 
+#if ! defined(USE_LOCALE_NUMERIC)
+
+    ATOF(s, x);
+
+#else
+
     {
     {
-        DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
-        if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
-            const char *standard = NULL, *local = NULL;
-            bool use_standard_radix;
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_SET_TO_NEEDED();
+        if (! (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))) {
+            ATOF(s,x);
+        }
+        else {
 
             /* Look through the string for the first thing that looks like a
              * decimal point: either the value in the current locale or the
 
             /* Look through the string for the first thing that looks like a
              * decimal point: either the value in the current locale or the
@@ -1351,41 +1393,40 @@ Perl_my_atof(pTHX_ const char* s)
              * that we have to determine this beforehand because on some
              * systems, Perl_atof2 is just a wrapper around the system's atof.
              * */
              * that we have to determine this beforehand because on some
              * systems, Perl_atof2 is just a wrapper around the system's atof.
              * */
-            standard = strchr(s, '.');
-            local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
-
-            use_standard_radix = standard && (!local || standard < local);
+            const char * const standard_pos = strchr(s, '.');
+            const char * const local_pos
+                                  = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
+            const bool use_standard_radix
+                    = standard_pos && (!local_pos || standard_pos < local_pos);
 
 
-            if (use_standard_radix)
+            if (use_standard_radix) {
                 SET_NUMERIC_STANDARD();
                 SET_NUMERIC_STANDARD();
+                LOCK_LC_NUMERIC_STANDARD();
+            }
 
 
-            Perl_atof2(s, x);
+            ATOF(s,x);
 
 
-            if (use_standard_radix)
-                SET_NUMERIC_LOCAL();
+            if (use_standard_radix) {
+                UNLOCK_LC_NUMERIC_STANDARD();
+                SET_NUMERIC_UNDERLYING();
+            }
         }
         }
-        else
-            Perl_atof2(s, x);
         RESTORE_LC_NUMERIC();
     }
         RESTORE_LC_NUMERIC();
     }
-#  else
-    Perl_atof2(s, x);
-#  endif
+
 #endif
 #endif
+
     return x;
 }
 
     return x;
 }
 
+#if defined(NV_INF) || defined(NV_NAN)
 
 
-#ifdef USING_MSVC6
-#  pragma warning(push)
-#  pragma warning(disable:4756;disable:4056)
-#endif
 static char*
 S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value)
 {
     const char *p0 = negative ? s - 1 : s;
     const char *p = p0;
 static char*
 S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value)
 {
     const char *p0 = negative ? s - 1 : s;
     const char *p = p0;
-    int infnan = grok_infnan(&p, send);
+    const int infnan = grok_infnan(&p, send);
     if (infnan && p != p0) {
         /* If we can generate inf/nan directly, let's do so. */
 #ifdef NV_INF
     if (infnan && p != p0) {
         /* If we can generate inf/nan directly, let's do so. */
 #ifdef NV_INF
@@ -1404,46 +1445,52 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
         /* If still here, we didn't have either NV_INF or NV_NAN,
          * and can try falling back to native strtod/strtold.
          *
         /* If still here, we didn't have either NV_INF or NV_NAN,
          * and can try falling back to native strtod/strtold.
          *
-         * (Though, are our NV_INF or NV_NAN ever not defined?)
-         *
          * The native interface might not recognize all the possible
          * inf/nan strings Perl recognizes.  What we can try
          * is to try faking the input.  We will try inf/-inf/nan
          * as the most promising/portable input. */
         {
          * The native interface might not recognize all the possible
          * inf/nan strings Perl recognizes.  What we can try
          * is to try faking the input.  We will try inf/-inf/nan
          * as the most promising/portable input. */
         {
-            const char* fake = NULL;
+            const char* fake = "silence compiler warning";
             char* endp;
             NV nv;
             char* endp;
             NV nv;
+#ifdef NV_INF
             if ((infnan & IS_NUMBER_INFINITY)) {
                 fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf";
             }
             if ((infnan & IS_NUMBER_INFINITY)) {
                 fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf";
             }
-            else if ((infnan & IS_NUMBER_NAN)) {
+#endif
+#ifdef NV_NAN
+            if ((infnan & IS_NUMBER_NAN)) {
                 fake = "nan";
             }
                 fake = "nan";
             }
-            assert(fake);
-            nv = Perl_strtod(fake, &endp);
+#endif
+            assert(strNE(fake, "silence compiler warning"));
+            nv = S_strtod(aTHX_ fake, &endp);
             if (fake != endp) {
             if (fake != endp) {
+#ifdef NV_INF
                 if ((infnan & IS_NUMBER_INFINITY)) {
                 if ((infnan & IS_NUMBER_INFINITY)) {
-#ifdef Perl_isinf
+#  ifdef Perl_isinf
                     if (Perl_isinf(nv))
                         *value = nv;
                     if (Perl_isinf(nv))
                         *value = nv;
-#else
+#  else
                     /* last resort, may generate SIGFPE */
                     *value = Perl_exp((NV)1e9);
                     if ((infnan & IS_NUMBER_NEG))
                         *value = -*value;
                     /* last resort, may generate SIGFPE */
                     *value = Perl_exp((NV)1e9);
                     if ((infnan & IS_NUMBER_NEG))
                         *value = -*value;
-#endif
+#  endif
                     return (char*)p; /* p, not endp */
                 }
                     return (char*)p; /* p, not endp */
                 }
-                else if ((infnan & IS_NUMBER_NAN)) {
-#ifdef Perl_isnan
+#endif
+#ifdef NV_NAN
+                if ((infnan & IS_NUMBER_NAN)) {
+#  ifdef Perl_isnan
                     if (Perl_isnan(nv))
                         *value = nv;
                     if (Perl_isnan(nv))
                         *value = nv;
-#else
+#  else
                     /* last resort, may generate SIGFPE */
                     *value = Perl_log((NV)-1.0);
                     /* last resort, may generate SIGFPE */
                     *value = Perl_log((NV)-1.0);
-#endif
+#  endif
                     return (char*)p; /* p, not endp */
                     return (char*)p; /* p, not endp */
+#endif
                 }
             }
         }
                 }
             }
         }
@@ -1451,20 +1498,28 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
     }
     return NULL;
 }
     }
     return NULL;
 }
-#ifdef USING_MSVC6
-#  pragma warning(pop)
-#endif
+
+#endif /* if defined(NV_INF) || defined(NV_NAN) */
 
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 {
 
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 {
+    PERL_ARGS_ASSERT_MY_ATOF2;
+    return my_atof3(orig, value, 0);
+}
+
+char*
+Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
+{
     const char* s = orig;
     NV result[3] = {0.0, 0.0, 0.0};
     const char* s = orig;
     NV result[3] = {0.0, 0.0, 0.0};
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
-    const char* send = s + strlen(orig); /* one past the last */
+#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
+    const char* send = s + ((len != 0)
+                           ? len
+                           : strlen(orig)); /* one past the last */
     bool negative = 0;
 #endif
     bool negative = 0;
 #endif
-#if defined(USE_PERL_ATOF) && !defined(USE_QUADMATH)
+#if defined(USE_PERL_ATOF) && !defined(Perl_strtod)
     UV accumulator[2] = {0,0}; /* before/after dp */
     bool seen_digit = 0;
     I32 exp_adjust[2] = {0,0};
     UV accumulator[2] = {0,0}; /* before/after dp */
     bool seen_digit = 0;
     I32 exp_adjust[2] = {0,0};
@@ -1477,11 +1532,11 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     I32 sig_digits = 0; /* noof significant digits seen so far */
 #endif
 
     I32 sig_digits = 0; /* noof significant digits seen so far */
 #endif
 
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
-    PERL_ARGS_ASSERT_MY_ATOF2;
+#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
+    PERL_ARGS_ASSERT_MY_ATOF3;
 
     /* leading whitespace */
 
     /* leading whitespace */
-    while (isSPACE(*s))
+    while (s < send && isSPACE(*s))
        ++s;
 
     /* sign */
        ++s;
 
     /* sign */
@@ -1494,12 +1549,43 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     }
 #endif
 
     }
 #endif
 
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
     {
         char* endp;
     {
         char* endp;
-        if ((endp = S_my_atof_infnan(s, negative, send, value)))
+        char* copy = NULL;
+
+        if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
             return endp;
             return endp;
-        result[2] = strtoflt128(s, &endp);
+
+        /* strtold() accepts 0x-prefixed hex and in POSIX implementations,
+           0b-prefixed binary numbers, which is backward incompatible
+        */
+        if ((len == 0 || len - (s-orig) >= 2) && *s == '0' &&
+            (isALPHA_FOLD_EQ(s[1], 'x') || isALPHA_FOLD_EQ(s[1], 'b'))) {
+            *value = 0;
+            return (char *)s+1;
+        }
+
+        /* If the length is passed in, the input string isn't NUL-terminated,
+         * and in it turns out the function below assumes it is; therefore we
+         * create a copy and NUL-terminate that */
+        if (len) {
+            Newx(copy, len + 1, char);
+            Copy(orig, copy, len, char);
+            copy[len] = '\0';
+            s = copy + (s - orig);
+        }
+
+        result[2] = S_strtod(aTHX_ s, &endp);
+
+        /* If we created a copy, 'endp' is in terms of that.  Convert back to
+         * the original */
+        if (copy) {
+            s = (s - copy) + (char *) orig;
+            endp = (endp - copy) + (char *) orig;
+            Safefree(copy);
+        }
+
         if (s != endp) {
             *value = negative ? -result[2] : result[2];
             return endp;
         if (s != endp) {
             *value = negative ? -result[2] : result[2];
             return endp;
@@ -1537,16 +1623,18 @@ 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))
 
 /* 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;
+        char* endp;
         if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
         if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
-            return (char*)endp;
+            return endp;
     }
     }
+#endif
 
     /* we accumulate digits into an integer; when this becomes too
      * large, we add the total to NV and start again */
 
 
     /* we accumulate digits into an integer; when this becomes too
      * large, we add the total to NV and start again */
 
-    while (1) {
+    while (s < send) {
        if (isDIGIT(*s)) {
            seen_digit = 1;
            old_digit = digit;
        if (isDIGIT(*s)) {
            seen_digit = 1;
            old_digit = digit;
@@ -1574,7 +1662,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
                    exp_adjust[0]++;
                }
                /* skip remaining digits */
                    exp_adjust[0]++;
                }
                /* skip remaining digits */
-               while (isDIGIT(*s)) {
+               while (s < send && isDIGIT(*s)) {
                    ++s;
                    if (! seen_dp) {
                        exp_adjust[0]++;
                    ++s;
                    if (! seen_dp) {
                        exp_adjust[0]++;
@@ -1598,9 +1686,9 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
        else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
            seen_dp = 1;
            if (sig_digits > MAX_SIG_DIGITS) {
        else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
            seen_dp = 1;
            if (sig_digits > MAX_SIG_DIGITS) {
-               do {
+               while (s < send && isDIGIT(*s)) {
                    ++s;
                    ++s;
-               } while (isDIGIT(*s));
+               }
                break;
            }
        }
                break;
            }
        }
@@ -1614,7 +1702,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
        result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1];
     }
 
        result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1];
     }
 
-    if (seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) {
+    if (s < send && seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) {
        bool expnegative = 0;
 
        ++s;
        bool expnegative = 0;
 
        ++s;
@@ -1625,14 +1713,12 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
            case '+':
                ++s;
        }
            case '+':
                ++s;
        }
-       while (isDIGIT(*s))
+       while (s < send && isDIGIT(*s))
            exponent = exponent * 10 + (*s++ - '0');
        if (expnegative)
            exponent = -exponent;
     }
 
            exponent = exponent * 10 + (*s++ - '0');
        if (expnegative)
            exponent = -exponent;
     }
 
-
-
     /* now apply the exponent */
 
     if (seen_dp) {
     /* now apply the exponent */
 
     if (seen_dp) {
@@ -1653,9 +1739,9 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 /*
 =for apidoc isinfnan
 
 /*
 =for apidoc isinfnan
 
-Perl_isinfnan() is utility function that returns true if the NV
-argument is either an infinity or a NaN, false otherwise.  To test
-in more detail, use Perl_isinf() and Perl_isnan().
+C<Perl_isinfnan()> is utility function that returns true if the NV
+argument is either an infinity or a C<NaN>, false otherwise.  To test
+in more detail, use C<Perl_isinf()> and C<Perl_isnan()>.
 
 This is also the logical inverse of Perl_isfinite().
 
 
 This is also the logical inverse of Perl_isfinite().
 
@@ -1664,6 +1750,7 @@ This is also the logical inverse of Perl_isfinite().
 bool
 Perl_isinfnan(NV nv)
 {
 bool
 Perl_isinfnan(NV nv)
 {
+  PERL_UNUSED_ARG(nv);
 #ifdef Perl_isinf
     if (Perl_isinf(nv))
         return TRUE;
 #ifdef Perl_isinf
     if (Perl_isinf(nv))
         return TRUE;
@@ -1676,11 +1763,11 @@ Perl_isinfnan(NV nv)
 }
 
 /*
 }
 
 /*
-=for apidoc
+=for apidoc isinfnansv
 
 
-Checks whether the argument would be either an infinity or NaN when used
+Checks whether the argument would be either an infinity or C<NaN> when used
 as a number, but is careful not to trigger non-numeric or uninitialized
 as a number, but is careful not to trigger non-numeric or uninitialized
-warnings.  it assumes the caller has done SvGETMAGIC(sv) already.
+warnings.  it assumes the caller has done C<SvGETMAGIC(sv)> already.
 
 =cut
 */
 
 =cut
 */
@@ -1736,21 +1823,21 @@ Perl_my_frexpl(long double x, int *e) {
 =for apidoc Perl_signbit
 
 Return a non-zero integer if the sign bit on an NV is set, and 0 if
 =for apidoc Perl_signbit
 
 Return a non-zero integer if the sign bit on an NV is set, and 0 if
-it is not.  
+it is not.
 
 
-If Configure detects this system has a signbit() that will work with
-our NVs, then we just use it via the #define in perl.h.  Otherwise,
+If F<Configure> detects this system has a C<signbit()> that will work with
+our NVs, then we just use it via the C<#define> in F<perl.h>.  Otherwise,
 fall back on this implementation.  The main use of this function
 fall back on this implementation.  The main use of this function
-is catching -0.0.
+is catching C<-0.0>.
 
 
-Configure notes:  This function is called 'Perl_signbit' instead of a
-plain 'signbit' because it is easy to imagine a system having a signbit()
+C<Configure> notes:  This function is called C<'Perl_signbit'> instead of a
+plain C<'signbit'> because it is easy to imagine a system having a C<signbit()>
 function or macro that doesn't happen to work with our particular choice
 function or macro that doesn't happen to work with our particular choice
-of NVs.  We shouldn't just re-#define signbit as Perl_signbit and expect
+of NVs.  We shouldn't just re-C<#define> C<signbit> as C<Perl_signbit> and expect
 the standard system headers to be happy.  Also, this is a no-context
 the standard system headers to be happy.  Also, this is a no-context
-function (no pTHX_) because Perl_signbit() is usually re-#defined in
-perl.h as a simple macro call to the system's signbit().
-Users should just always call Perl_signbit().
+function (no C<pTHX_>) because C<Perl_signbit()> is usually re-C<#defined> in
+F<perl.h> as a simple macro call to the system's C<signbit()>.
+Users should just always call C<Perl_signbit()>.
 
 =cut
 */
 
 =cut
 */
@@ -1758,19 +1845,25 @@ Users should just always call Perl_signbit().
 int
 Perl_signbit(NV x) {
 #  ifdef Perl_fp_class_nzero
 int
 Perl_signbit(NV x) {
 #  ifdef Perl_fp_class_nzero
-    if (x == 0)
-        return Perl_fp_class_nzero(x);
-#  endif
+    return Perl_fp_class_nzero(x);
+    /* Try finding the high byte, and assume it's highest bit
+     * is the sign.  This assumption is probably wrong somewhere. */
+#  elif defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+    return (((unsigned char *)&x)[9] & 0x80);
+#  elif defined(NV_LITTLE_ENDIAN)
+    /* Note that NVSIZE is sizeof(NV), which would make the below be
+     * wrong if the end bytes are unused, which happens with the x86
+     * 80-bit long doubles, which is why take care of that above. */
+    return (((unsigned char *)&x)[NVSIZE - 1] & 0x80);
+#  elif defined(NV_BIG_ENDIAN)
+    return (((unsigned char *)&x)[0] & 0x80);
+#  else
+    /* This last resort fallback is wrong for the negative zero. */
     return (x < 0.0) ? 1 : 0;
     return (x < 0.0) ? 1 : 0;
+#  endif
 }
 #endif
 
 /*
 }
 #endif
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */