}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in binary number");
overflowed = TRUE;
value_nv = (NV) value;
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal binary digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in hexadecimal number");
overflowed = TRUE;
value_nv = (NV) value;
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal hexadecimal digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in octal number");
overflowed = TRUE;
value_nv = (NV) value;
* someone seems to want to use the digits eight and nine). */
if (digit == 8 || digit == 9) {
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal octal digit '%c' ignored", *s);
}
break;
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Octal number > 037777777777 non-portable");
}
*len_p = s - start;
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;
}