"Illegal binary digit '%c' ignored", *s);
break;
}
-
+
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff
"Illegal hexadecimal digit '%c' ignored", *s);
break;
}
-
+
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff
}
break;
}
-
+
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff
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';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
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';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
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';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
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';
- 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';
- 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))) {
else
break;
}
- if (digit >= 0 && digit <= 9
+ if (inRANGE(digit, 0, 9)
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
return TRUE;
}
-#ifndef USE_QUADMATH
+#ifndef Perl_strtod
STATIC NV
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
- * 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
# endif
#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;
}
}
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)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#if ! defined(USE_LOCALE_NUMERIC)
- my_atof2(s, &x);
-
-#elif ! defined(USE_LOCALE_NUMERIC)
-
- Perl_atof2(s, x);
+ ATOF(s, x);
#else
{
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ 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
* standard fallback of '.'. The one which appears earliest in the
LOCK_LC_NUMERIC_STANDARD();
}
- Perl_atof2(s, x);
+ ATOF(s,x);
if (use_standard_radix) {
UNLOCK_LC_NUMERIC_STANDARD();
SET_NUMERIC_UNDERLYING();
}
}
- else
- Perl_atof2(s, x);
RESTORE_LC_NUMERIC();
}
}
char*
-Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
+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};
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
+#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
-#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};
I32 sig_digits = 0; /* noof significant digits seen so far */
#endif
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
+#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
PERL_ARGS_ASSERT_MY_ATOF3;
/* leading whitespace */
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
char* copy = NULL;
s = copy + (s - orig);
}
- result[2] = strtoflt128(s, &endp);
+ result[2] = Perl_strtod(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);
}
=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 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,