X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=b193e0c2e4a30c621c4a074542c67f06635449d9;hb=439ba5457a8422144686c1df300aa1dde218dbfd;hp=913ecc85f48ab5b3bf917d0fb935a148d83c26b5;hpb=eb1102fcca2230364ceadea29bd8e87ee51b15fa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/numeric.c b/numeric.c index 913ecc8..b193e0c 100644 --- a/numeric.c +++ b/numeric.c @@ -175,7 +175,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -198,7 +198,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal binary digit '%c' ignored", *s); break; } @@ -209,7 +209,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -290,7 +290,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -313,7 +313,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; } @@ -324,7 +324,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -372,7 +372,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -399,7 +399,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { * 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; @@ -411,7 +411,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -727,10 +727,6 @@ S_mulexp10(NV value, I32 exponent) 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 @@ -743,11 +739,6 @@ S_mulexp10(NV value, I32 exponent) * * [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. @@ -756,18 +747,37 @@ S_mulexp10(NV value, I32 exponent) * 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; @@ -783,17 +793,17 @@ Perl_my_atof(pTHX_ const char* s) /* 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; } @@ -802,8 +812,9 @@ char* 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; @@ -926,6 +937,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) /* now apply the sign */ if (negative) result = -result; +#endif /* USE_PERL_ATOF */ *value = result; return s; }