X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=d15fdbdd75fe3f56c5bc1358a25ddc5ffabbf57c;hb=1cc8b4c566f7901a54e4b576f09608beb4c81f86;hp=1aadce5155642389e2aa82183c90506733abcfdf;hpb=a333faafe1ea79cc2ee6a8e7cd6170ab2dcba713;p=p5sagit%2Fp5-mst-13.2.git diff --git a/numeric.c b/numeric.c index 1aadce5..d15fdbd 100644 --- a/numeric.c +++ b/numeric.c @@ -350,7 +350,7 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) Recognise (or not) a number. The type of the number is returned (0 if unrecognised), otherwise it is a bit-ORed combination of IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT, -IS_NUMBER_NEG, IS_NUMBER_INFINITY (defined in perl.h). +IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h). If the value of the number can fit an in UV, it is returned in the *valuep IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV @@ -376,6 +376,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) const char max_mod_10 = UV_MAX % 10; int numtype = 0; int sawinf = 0; + int sawnan = 0; while (s < send && isSPACE(*s)) s++; @@ -401,54 +402,54 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) With it gcc on arm is managing 6 instructions (6 cycles) per digit. In theory the optimiser could deduce how far to unroll the loop before checking for overflow. */ - if (s < send) { - int digit = *++s - '0'; + if (++s < send) { + int digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { - digit = *++s - '0'; + if (++s < send) { + digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (s < send) { + if (++s < send) { /* Now got 9 digits, so need to check each time for overflow. */ - digit = *++s - '0'; + digit = *s - '0'; while (digit >= 0 && digit <= 9 && (value < max_div_10 || (value == max_div_10 && digit <= max_mod_10))) { value = value * 10 + digit; - if (s < send) - digit = *++s - '0'; + if (++s < send) + digit = *s - '0'; else break; } if (digit >= 0 && digit <= 9 - && !(s < send)) { + && (s < send)) { /* value overflowed. skip the remaining digits, don't worry about setting *valuep. */ @@ -512,12 +513,21 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) s++; } sawinf = 1; - } else /* Add test for NaN here. */ + } else if (*s == 'N' || *s == 'n') { + /* XXX TODO: There are signaling NaNs and quiet NaNs. */ + s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; + sawnan = 1; + } else return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; + } else if (sawnan) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; } else if (s < send) { /* we can have an optional exponent part */ if (*s == 'e' || *s == 'E') { @@ -539,7 +549,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) while (s < send && isSPACE(*s)) s++; if (s >= send) - return numtype; + return numtype; if (len == 10 && memEQ(pv, "0 but true", 10)) { if (valuep) *valuep = 0; @@ -562,19 +572,43 @@ S_mulexp10(NV value, I32 exponent) negative = 1; exponent = -exponent; } -#ifdef __VAX /* avoid %SYSTEM-F-FLTOVF_F sans VAXC$ESTABLISH */ -# if defined(__DECC_VER) && __DECC_VER <= 50390006 - /* __F_FLT_MAX_10_EXP - 5 == 33 */ + + /* 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 + * conversion routines, and therefore of native applications, too). + * + * [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) >= (__F_FLT_MAX_10_EXP - 5)) + (log10(value) + exponent) >= (NV_MAX_10_EXP)) return NV_MAX; -# endif #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. + * There is something you can do if you are willing to use some + * inline assembler: the instruction is called DFI-- but that will + * 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; +#endif + for (bit = 1; exponent; bit <<= 1) { if (exponent & bit) { exponent ^= bit; result *= power; } + /* Floating point exceptions are supposed to be turned off. */ power *= power; } return negative ? value / result : value * result; @@ -629,6 +663,10 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) I32 ipart = 0; /* index into part[] */ I32 offcount; /* number of digits in least significant part */ + /* leading whitespace */ + while (isSPACE(*s)) + ++s; + /* sign */ switch (*s) { case '-':