if (exponent == 0)
return value;
- else if (exponent < 0) {
- negative = 1;
- exponent = -exponent;
- }
/* On OpenVMS VAX we by default use the D_FLOAT double format,
* and that format does not have *easy* capabilities [1] for
*
* [1] Trying to establish a condition handler to trap floating point
* exceptions is not a good idea. */
-#if defined(VMS) && !defined(__IEEE_FP) && defined(NV_MAX_10_EXP)
- if (!negative &&
- (log10(value) + exponent) >= (NV_MAX_10_EXP))
- return NV_MAX;
-#endif
/* In UNICOS and in certain Cray models (such as T90) there is no
* IEEE fp, and no way at all from C to catch fp overflows gracefully.
* disable *all* floating point interrupts, a little bit too large
* a hammer. Therefore we need to catch potential overflows before
* it's too late. */
-#if defined(_UNICOS) && defined(NV_MAX_10_EXP)
- if (!negative &&
- (log10(value) + exponent) >= NV_MAX_10_EXP)
- return NV_MAX;
+
+#if ((defined(VMS) && !defined(__IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
+ STMT_START {
+ NV exp_v = log10(value);
+ if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
+ return NV_MAX;
+ if (exponent < 0) {
+ if (-(exponent + exp_v) >= NV_MAX_10_EXP)
+ return 0.0;
+ while (-exponent >= NV_MAX_10_EXP) {
+ /* combination does not overflow, but 10^(-exponent) does */
+ value /= 10;
+ ++exponent;
+ }
+ }
+ } STMT_END;
#endif
+ if (exponent < 0) {
+ negative = 1;
+ exponent = -exponent;
+ }
for (bit = 1; exponent; bit <<= 1) {
if (exponent & bit) {
exponent ^= bit;
result *= power;
+ /* Floating point exceptions are supposed to be turned off,
+ * but if we're obviously done, don't risk another iteration.
+ */
+ if (exponent == 0) break;
}
- /* Floating point exceptions are supposed to be turned off. */
power *= power;
}
return negative ? value / result : value * result;
/* Scan the number twice; once using locale and once without;
* choose the larger result (in absolute value). */
- Perl_atof2(aTHX_ s, &x);
+ Perl_atof2(s, x);
SET_NUMERIC_STANDARD();
- Perl_atof2(aTHX_ s, &y);
+ Perl_atof2(s, y);
SET_NUMERIC_LOCAL();
if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
return y;
}
else
- Perl_atof2(aTHX_ s, &x);
+ Perl_atof2(s, x);
#else
- Perl_atof2(aTHX_ s, &x);
+ Perl_atof2(s, x);
#endif
return x;
}
Perl_my_atof2(pTHX_ const char* orig, NV* value)
{
NV result = 0.0;
- bool negative = 0;
char* s = (char*)orig;
+#ifdef USE_PERL_ATOF
+ bool negative = 0;
char* send = s + strlen(orig) - 1;
bool seendigit = 0;
I32 expextra = 0;
/* now apply the sign */
if (negative)
result = -result;
+#endif /* USE_PERL_ATOF */
*value = result;
return s;
}