X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=f95fde33d364ad250686465191afd76f14a3b083;hb=2f9d292c5c854aad638316029276446c19b69bf6;hp=2e1e261fd2f396210a8ba1dc67ebb4b394d8c5ce;hpb=a4c04bdcc508b6a45f83e703d0f82401445aa55b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/numeric.c b/numeric.c index 2e1e261..f95fde3 100644 --- a/numeric.c +++ b/numeric.c @@ -1,6 +1,6 @@ /* numeric.c * - * Copyright (c) 2001, Larry Wall + * Copyright (c) 2001-2002, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -12,6 +12,10 @@ * wizards count differently to other people." */ +/* +=head1 Numeric functions +*/ + #include "EXTERN.h" #define PERL_IN_NUMERIC_C #include "perl.h" @@ -122,7 +126,7 @@ returns UV_MAX, sets C in the output flags, and writes the value to I<*result> (or the value is discarded if I is NULL). -The hex number may optinally be prefixed with "0b" or "b" unless +The hex number may optionally be prefixed with "0b" or "b" unless C is set in I<*flags> on entry. If C is set in I<*flags> then the binary number may use '_' characters to separate digits. @@ -171,14 +175,14 @@ 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; } value_nv *= 2.0; /* If an NV has not enough bits in its mantissa to - * represent an UV this summing of small low-order numbers + * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the @@ -194,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; } @@ -205,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; @@ -236,7 +240,7 @@ returns UV_MAX, sets C in the output flags, and writes the value to I<*result> (or the value is discarded if I is NULL). -The hex number may optinally be prefixed with "0x" or "x" unless +The hex number may optionally be prefixed with "0x" or "x" unless C is set in I<*flags> on entry. If C is set in I<*flags> then the hex number may use '_' characters to separate digits. @@ -286,14 +290,14 @@ 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; } value_nv *= 16.0; /* If an NV has not enough bits in its mantissa to - * represent an UV this summing of small low-order numbers + * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the @@ -309,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; } @@ -320,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; @@ -368,14 +372,14 @@ 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; } value_nv *= 8.0; /* If an NV has not enough bits in its mantissa to - * represent an UV this summing of small low-order numbers + * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the @@ -395,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; @@ -407,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; @@ -740,9 +744,8 @@ 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; + if ((log10(value) + exponent) >= (NV_MAX_10_EXP)) + return negative ? 0.0 : NV_MAX; #endif /* In UNICOS and in certain Cray models (such as T90) there is no @@ -762,8 +765,11 @@ S_mulexp10(NV value, I32 exponent) 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; @@ -779,17 +785,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; } @@ -798,8 +804,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; @@ -922,6 +929,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; }