X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=a6d9c90844df08de76de3254216ec0a84c3e36fa;hb=02c473a9139e94d6158d1e3dd9a912f3525b3b21;hp=1b91c5f45ff3bbf8e37bc4601a82dd76896455ba;hpb=4c79ee7a1e7564ef83d0ac25d6677fdebb3ec7aa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/numeric.c b/numeric.c index 1b91c5f..a6d9c90 100644 --- a/numeric.c +++ b/numeric.c @@ -1,6 +1,7 @@ /* numeric.c * - * Copyright (c) 2001-2003, Larry Wall + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -14,6 +15,12 @@ /* =head1 Numeric functions + +This file contains all the stuff needed by perl for manipulating numeric +values, including such things as replacements for the OS's atof() function + +=cut + */ #include "EXTERN.h" @@ -117,8 +124,10 @@ converts a string representing a binary number to numeric form. On entry I and I<*len> give the string to scan, I<*flags> gives conversion flags, and I should be NULL or a pointer to an NV. The scan stops at the end of the string, or the first invalid character. -On return I<*len> is set to the length scanned string, and I<*flags> gives -output flags. +Unless C is set in I<*flags>, encountering an +invalid character will also trigger a warning. +On return I<*len> is set to the length of the scanned string, +and I<*flags> gives output flags. If the value is <= UV_MAX it is returned as a UV, the output flags are clear, and nothing is written to I<*result>. If the value is > UV_MAX C @@ -126,7 +135,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 optionally be prefixed with "0b" or "b" unless +The binary 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. @@ -197,7 +206,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { ++s; goto redo; } - if (ckWARN(WARN_DIGIT)) + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal binary digit '%c' ignored", *s); break; @@ -230,9 +239,11 @@ converts a string representing a hex number to numeric form. On entry I and I<*len> give the string to scan, I<*flags> gives conversion flags, and I should be NULL or a pointer to an NV. -The scan stops at the end of the string, or the first non-hex-digit character. -On return I<*len> is set to the length scanned string, and I<*flags> gives -output flags. +The scan stops at the end of the string, or the first invalid character. +Unless C is set in I<*flags>, encountering an +invalid character will also trigger a warning. +On return I<*len> is set to the length of the scanned string, +and I<*flags> gives output flags. If the value is <= UV_MAX it is returned as a UV, the output flags are clear, and nothing is written to I<*result>. If the value is > UV_MAX C @@ -312,7 +323,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { ++s; goto redo; } - if (ckWARN(WARN_DIGIT)) + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; @@ -341,6 +352,24 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { /* =for apidoc grok_oct +converts a string representing an octal number to numeric form. + +On entry I and I<*len> give the string to scan, I<*flags> gives +conversion flags, and I should be NULL or a pointer to an NV. +The scan stops at the end of the string, or the first invalid character. +Unless C is set in I<*flags>, encountering an +invalid character will also trigger a warning. +On return I<*len> is set to the length of the scanned string, +and I<*flags> gives output flags. + +If the value is <= UV_MAX it is returned as a UV, the output flags are clear, +and nothing is written to I<*result>. If the value is > UV_MAX C +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). + +If C is set in I<*flags> then the octal +number may use '_' characters to separate digits. =cut */ @@ -395,10 +424,10 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } /* Allow \octal to work the DWIM way (that is, stop scanning - * as soon as non-octal characters are seen, complain only iff + * as soon as non-octal characters are seen, complain only if * someone seems to want to use the digits eight and nine). */ if (digit == 8 || digit == 9) { - if (ckWARN(WARN_DIGIT)) + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal octal digit '%c' ignored", *s); } @@ -717,7 +746,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) return 0; } -NV +STATIC NV S_mulexp10(NV value, I32 exponent) { NV result = 1.0; @@ -972,3 +1001,19 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) return s; } +#if ! defined(HAS_MODFL) && defined(HAS_AINTL) && defined(HAS_COPYSIGNL) +long double +Perl_my_modfl(long double x, long double *ip) +{ + *ip = aintl(x); + return (x == *ip ? copysignl(0.0L, x) : x - *ip); +} +#endif + +#if ! defined(HAS_FREXPL) && defined(HAS_ILOGBL) && defined(HAS_SCALBNL) +long double +Perl_my_frexpl(long double x, int *e) { + *e = x == 0.0L ? 0 : ilogbl(x) + 1; + return (scalbnl(x, -*e)); +} +#endif