diff options
Diffstat (limited to 'generic/tclStrToD.c')
| -rwxr-xr-x | generic/tclStrToD.c | 235 |
1 files changed, 124 insertions, 111 deletions
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index dc19855..2b03227 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -9,12 +9,12 @@ * into strings of digits, and procedures for interconversion among * 'double' and 'mp_int' types. * - * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.30 2007/04/23 17:34:07 kennykb Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.30.2.1 2007/11/21 06:30:54 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -146,22 +146,21 @@ static double SafeLdExp(double fraction, int exponent); * * TclParseNumber -- * - * Scans bytes, interpreted as characters in Tcl's internal encoding, - * and parses the longest prefix that is the string representation of - * a number in a format recognized by Tcl. + * Scans bytes, interpreted as characters in Tcl's internal encoding, and + * parses the longest prefix that is the string representation of a + * number in a format recognized by Tcl. * * The arguments bytes, numBytes, and objPtr are the inputs which - * determine the string to be parsed. If bytes is non-NULL, it - * points to the first byte to be scanned. If bytes is NULL, then objPtr - * must be non-NULL, and the string representation of objPtr will be - * scanned (generated first, if necessary). The numBytes argument - * determines the number of bytes to be scanned. If numBytes is - * negative, the first NUL byte encountered will terminate the scan. - * If numBytes is non-negative, then no more than numBytes bytes will - * be scanned. + * determine the string to be parsed. If bytes is non-NULL, it points to + * the first byte to be scanned. If bytes is NULL, then objPtr must be + * non-NULL, and the string representation of objPtr will be scanned + * (generated first, if necessary). The numBytes argument determines the + * number of bytes to be scanned. If numBytes is negative, the first NUL + * byte encountered will terminate the scan. If numBytes is non-negative, + * then no more than numBytes bytes will be scanned. * * The argument flags is an input that controls the numeric formats - * recognized by the parser. The flag bits are: + * recognized by the parser. The flag bits are: * * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject * strings that denote floating point values (or accept only the @@ -170,70 +169,72 @@ static double SafeLdExp(double fraction, int exponent); * not part of the [scan] command's vocabulary. Use only in * combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_OCTAL_ONLY: parse only in the octal format, whether - * or not a prefix is present that would lead to octal parsing. Use - * only in combination with TCL_PARSE_INTEGER_ONLY. + * or not a prefix is present that would lead to octal parsing. + * Use only in combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_HEXADECIMAL_ONLY: parse only in the hexadecimal format, * whether or not a prefix is present that would lead to * hexadecimal parsing. Use only in combination with * TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_DECIMAL_ONLY: parse only in the decimal format, no - * matter whether a 0 prefix would normally force a different base. + * matter whether a 0 prefix would normally force a different + * base. * - TCL_PARSE_NO_WHITESPACE: reject any leading/trailing whitespace * - * The arguments interp and expected are inputs that control error message - * generation. If interp is NULL, no error message will be generated. - * If interp is non-NULL, then expected must also be non-NULL. When - * TCL_ERROR is returned, an error message will be left in the result - * of interp, and the expected argument will appear in the error message - * as the thing TclParseNumber expected, but failed to find in the string. + * The arguments interp and expected are inputs that control error + * message generation. If interp is NULL, no error message will be + * generated. If interp is non-NULL, then expected must also be non-NULL. + * When TCL_ERROR is returned, an error message will be left in the + * result of interp, and the expected argument will appear in the error + * message as the thing TclParseNumber expected, but failed to find in + * the string. * * The arguments objPtr and endPtrPtr as well as the return code are the * outputs. * * When the parser cannot find any prefix of the string that matches a * format it is looking for, TCL_ERROR is returned and an error message - * may be generated and returned as described above. The contents of - * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to - * the character in the string that terminated the scan will be written - * to *endPtrPtr. - * - * When the parser determines that the entire string matches a format - * it is looking for, TCL_OK is returned, and if objPtr is non-NULL, - * then the internal rep and Tcl_ObjType of objPtr are set to the - * "canonical" numeric value that matches the scanned string. If - * endPtrPtr is non-NULL, a pointer to the end of the string will be - * written to *endPtrPtr (that is, either bytes+numBytes or a pointer - * to a terminating NUL byte). - * - * When the parser determines that a partial string matches a format - * it is looking for, the value of endPtrPtr determines what happens: + * may be generated and returned as described above. The contents of + * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to the + * character in the string that terminated the scan will be written to + * *endPtrPtr. + * + * When the parser determines that the entire string matches a format it + * is looking for, TCL_OK is returned, and if objPtr is non-NULL, then + * the internal rep and Tcl_ObjType of objPtr are set to the "canonical" + * numeric value that matches the scanned string. If endPtrPtr is not + * NULL, a pointer to the end of the string will be written to *endPtrPtr + * (that is, either bytes+numBytes or a pointer to a terminating NUL + * byte). + * + * When the parser determines that a partial string matches a format it + * is looking for, the value of endPtrPtr determines what happens: * * - If endPtrPtr is NULL, then TCL_ERROR is returned, with error message * generation as above. * * - If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr - * internals are set as above. Also, a pointer to the first - * character following the parsed numeric string is written - * to *endPtrPtr. + * internals are set as above. Also, a pointer to the first + * character following the parsed numeric string is written to + * *endPtrPtr. * * In some cases where the string being scanned is the string rep of - * objPtr, this routine can leave objPtr in an inconsistent state - * where its string rep and its internal rep do not agree. In these - * cases the internal rep will be in agreement with only some substring - * of the string rep. This might happen if the caller passes in a - * non-NULL bytes value that points somewhere into the string rep. It - * might happen if the caller passes in a numBytes value that limits the - * scan to only a prefix of the string rep. Or it might happen if a - * non-NULL value of endPtrPtr permits a TCL_OK return from only a partial - * string match. It is the responsibility of the caller to detect and - * correct such inconsistencies when they can and do arise. + * objPtr, this routine can leave objPtr in an inconsistent state where + * its string rep and its internal rep do not agree. In these cases the + * internal rep will be in agreement with only some substring of the + * string rep. This might happen if the caller passes in a non-NULL bytes + * value that points somewhere into the string rep. It might happen if + * the caller passes in a numBytes value that limits the scan to only a + * prefix of the string rep. Or it might happen if a non-NULL value of + * endPtrPtr permits a TCL_OK return from only a partial string match. It + * is the responsibility of the caller to detect and correct such + * inconsistencies when they can and do arise. * * Results: * Returns a standard Tcl result. * * Side effects: * The string representaton of objPtr may be generated. - * + * * The internal representation and Tcl_ObjType of objPtr may be changed. * This may involve allocation and/or freeing of memory. * @@ -242,21 +243,23 @@ static double SafeLdExp(double fraction, int exponent); int TclParseNumber( - Tcl_Interp *interp, /* Used for error reporting. May be NULL */ - Tcl_Obj *objPtr, /* Object to receive the internal rep */ - const char *expected, /* Description of the type of number the caller - * expects to be able to parse ("integer", - * "boolean value", etc.). */ - const char *bytes, /* Pointer to the start of the string to scan */ - int numBytes, /* Maximum number of bytes to scan, see above */ + Tcl_Interp *interp, /* Used for error reporting. May be NULL. */ + Tcl_Obj *objPtr, /* Object to receive the internal rep. */ + const char *expected, /* Description of the type of number the + * caller expects to be able to parse + * ("integer", "boolean value", etc.). */ + const char *bytes, /* Pointer to the start of the string to + * scan. */ + int numBytes, /* Maximum number of bytes to scan, see + * above. */ const char **endPtrPtr, /* Place to store pointer to the character - * that terminated the scan */ - int flags) /* Flags governing the parse */ + * that terminated the scan. */ + int flags) /* Flags governing the parse. */ { enum State { - INITIAL, SIGNUM, ZERO, ZERO_X, + INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -306,7 +309,7 @@ TclParseNumber( #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) - /* + /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. */ @@ -341,9 +344,9 @@ TclParseNumber( signum = 1; state = SIGNUM; break; - } + } /* FALLTHROUGH */ - + case SIGNUM: /* * Scanned a leading + or -. Acceptable characters are digits, @@ -449,10 +452,11 @@ TclParseNumber( * too large shifts first. */ - if ((octalSignificandWide != 0) - && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) - || (octalSignificandWide - > (~(Tcl_WideUInt)0 >> shift)))) { + if ((octalSignificandWide != 0) + && (((size_t)shift >= + CHAR_BIT*sizeof(Tcl_WideUInt)) + || (octalSignificandWide > + (~(Tcl_WideUInt)0 >> shift)))) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); @@ -482,8 +486,7 @@ TclParseNumber( case BAD_OCTAL: if (explicitOctal) { /* - * No forgiveness for bad digits in explicitly octal - * numbers. + * No forgiveness for bad digits in explicitly octal numbers. */ goto endgame; @@ -528,7 +531,7 @@ TclParseNumber( } else if (c == 'E' || c == 'e') { state = EXPONENT_START; break; - } + } #endif goto endgame; @@ -646,8 +649,8 @@ TclParseNumber( } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( - (unsigned)(c - '0'), numTrailZeros, - &significandWide, &significandBig, + (unsigned)(c - '0'), numTrailZeros, + &significandWide, &significandBig, significandOverflow); } numSigDigs += numTrailZeros+1; @@ -665,7 +668,7 @@ TclParseNumber( } goto endgame; - /* + /* * Found a decimal point. If no digits have yet been scanned, E is * not allowed; otherwise, it introduces the exponent. If at least * one digit has been found, we have a possible complete number. @@ -691,8 +694,8 @@ TclParseNumber( ++numDigitsAfterDp; if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, + (unsigned)(c-'0'), numTrailZeros, + &significandWide, &significandBig, significandOverflow); } if (numSigDigs != 0) { @@ -707,7 +710,7 @@ TclParseNumber( goto endgame; case EXPONENT_START: - /* + /* * Scanned the E at the start of an exponent. Make sure a legal * character follows before using the C library strtol routine, * which allows whitespace. @@ -737,7 +740,7 @@ TclParseNumber( goto endgame; case EXPONENT: - /* + /* * Found an exponent with at least one digit. Accumulate it, * making sure to hard-pin it to LONG_MAX on overflow. */ @@ -765,13 +768,13 @@ TclParseNumber( if (c == 'n' || c == 'N') { state = sIN; break; - } + } goto endgame; case sIN: if (c == 'f' || c == 'F') { state = sINF; break; - } + } goto endgame; case sINF: acceptState = state; @@ -868,23 +871,32 @@ TclParseNumber( acceptLen = len; goto endgame; } - ++p; + ++p; --len; } endgame: if (acceptState == INITIAL) { - /* No numeric string at all found */ + /* + * No numeric string at all found. + */ + status = TCL_ERROR; if (endPtrPtr != NULL) { *endPtrPtr = p; } } else { - /* Back up to the last accepting state in the lexer. */ + /* + * Back up to the last accepting state in the lexer. + */ + p = acceptPoint; len = acceptLen; if (!(flags & TCL_PARSE_NO_WHITESPACE)) { - /* Accept trailing whitespace */ + /* + * Accept trailing whitespace. + */ + while (len != 0 && isspace(UCHAR(*p))) { ++p; --len; @@ -987,7 +999,7 @@ TclParseNumber( } } if (!octalSignificandOverflow) { - if (octalSignificandWide > + if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef NO_WIDE_TYPE if (octalSignificandWide <= (MOST_BITS + signum)) { @@ -1021,7 +1033,7 @@ TclParseNumber( mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumIntRep(objPtr, &octalSignificandBig); - } + } break; case ZERO: @@ -1034,7 +1046,7 @@ TclParseNumber( } returnInteger: if (!significandOverflow) { - if (significandWide > + if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef NO_WIDE_TYPE if (significandWide <= MOST_BITS+signum) { @@ -1194,6 +1206,7 @@ AccumulateDecimalDigit( /* * There's no need to multiply if the multiplicand is zero. */ + *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide @@ -1202,7 +1215,7 @@ AccumulateDecimalDigit( * Wide multiplication will overflow. Expand the * number to a bignum and fall through into the bignum case. */ - + TclBNInitBignumFromWideUInt (bignumRepPtr, w); } else { /* @@ -1226,7 +1239,7 @@ AccumulateDecimalDigit( bignumRepPtr); mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); } else { - /* + /* * More than single digit multiplication. Multiply by the appropriate * small powers of 5, and then shift. Large strings of zeroes are * eaten 256 at a time; this is less efficient than it could be, but @@ -1304,7 +1317,7 @@ MakeLowPrecisionDouble( if (numSigDigs <= DBL_DIG) { if (exponent >= 0) { if (exponent <= mmaxpow) { - /* + /* * The significand is an exact integer, and so is * 10**exponent. The product will be correct to within 1/2 ulp * without special handling. @@ -1315,7 +1328,7 @@ MakeLowPrecisionDouble( } else { int diff = DBL_DIG - numSigDigs; if (exponent-diff <= mmaxpow) { - /* + /* * 10**exponent is not an exact integer, but * 10**(exponent-diff) is exact, and so is * significand*10**diff, so we can still compute the value @@ -1330,7 +1343,7 @@ MakeLowPrecisionDouble( } } else { if (exponent >= -mmaxpow) { - /* + /* * 10**-exponent is an exact integer, and so is the * significand. Compute the result by one division, again with * only one rounding. @@ -1351,7 +1364,7 @@ MakeLowPrecisionDouble( retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs, exponent); mp_clear(&significandBig); - + /* * Come here to return the computed value. */ @@ -1428,7 +1441,7 @@ MakeHighPrecisionDouble( goto returnValue; } - /* + /* * Develop a first approximation to the significand. It is tempting simply * to force bignum to double, but that will overflow on input numbers like * 1.[string repeat 0 1000]1; while this is a not terribly likely @@ -1448,7 +1461,7 @@ MakeHighPrecisionDouble( retval = tiny; } - /* + /* * Refine the result twice. (The second refinement should be necessary * only if the best approximation is a power of 2 minus 1/2 ulp). */ @@ -1585,7 +1598,7 @@ RefineApproximation( } } - /* + /* * The floating point number is significand*2**binExponent. Compute the * large integer significand*2**(binExponent+M2+1). The 2**-1 bit of the * significand (the most significant) corresponds to the @@ -1610,8 +1623,8 @@ RefineApproximation( mp_mul(&twoMv, pow5+i, &twoMv); } } - - /* + + /* * Collect the decimal significand as a high precision integer. The least * significant bit corresponds to bit M2+exponent+1 so it will need to be * shifted left by that many bits after being multiplied by @@ -1659,7 +1672,7 @@ RefineApproximation( return approxResult; } - /* + /* * Convert the numerator and denominator of the corrector term accurately * to floating point numbers. */ @@ -1752,8 +1765,8 @@ TclDoubleDigits( return 1; } - /* - * Find a large integer r, and integer e, such that + /* + * Find a large integer r, and integer e, such that * v = r * FLT_RADIX**e * and r is as small as possible. Also determine whether the significand * is the smallest possible. @@ -2153,7 +2166,7 @@ TclInitDoubleConversion(void) mantBits = DBL_MANT_DIG * log2FLT_RADIX; d = 1.0; - /* + /* * Initialize a table of powers of ten that can be exactly represented * in a double. */ @@ -2181,10 +2194,10 @@ TclInitDoubleConversion(void) mp_sqr(pow5+i, pow5+i+1); } - /* + /* * Determine the number of decimal digits to the left and right of the * decimal point in the largest and smallest double, the smallest double - * that differs from zero, and the number of mp_digits needed to represent + * that differs from zero, and the number of mp_digits needed to represent * the significand of a double. */ @@ -2197,8 +2210,8 @@ TclInitDoubleConversion(void) log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.)); /* - * Nokia 770's software-emulated floating point is "middle endian": - * the bytes within a 32-bit word are little-endian (like the native + * Nokia 770's software-emulated floating point is "middle endian": the + * bytes within a 32-bit word are little-endian (like the native * integers), but the two words of a 'double' are presented most * significant word first. */ @@ -2255,8 +2268,8 @@ TclFinalizeDoubleConversion(void) * None. * * Side effects: - * Initializes the bignum supplied, and stores the converted number - * in it. + * Initializes the bignum supplied, and stores the converted number in + * it. * *---------------------------------------------------------------------- */ @@ -2557,7 +2570,7 @@ Pow10TimesFrExp( /* * Multiply by 10**exponent */ - + retval = frexp(retval * pow10[exponent&0xf], &j); expt += j; for (i=4; i<9; ++i) { |