diff options
author | Kevin B Kenny <kennykb@acm.org> | 2005-08-23 19:15:40 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2005-08-23 19:15:40 (GMT) |
commit | a63a7fbde97f559e69fd0f29bdc7f1eb9c869b2d (patch) | |
tree | 885bd496b857149747df4d9e738a91832aacc40e | |
parent | cae326bf8b05132f1e6d7996e8e3af49f971281d (diff) | |
download | tcl-a63a7fbde97f559e69fd0f29bdc7f1eb9c869b2d.zip tcl-a63a7fbde97f559e69fd0f29bdc7f1eb9c869b2d.tar.gz tcl-a63a7fbde97f559e69fd0f29bdc7f1eb9c869b2d.tar.bz2 |
Removed TclStrToD and friends, and added '0b' test cases.
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rwxr-xr-x | generic/tclStrToD.c | 670 | ||||
-rw-r--r-- | tests/expr.test | 44 |
4 files changed, 51 insertions, 674 deletions
@@ -1,5 +1,7 @@ 2005-08-23 Kevin Kenny <kennykb@users.sourceforge.net> + [kennykb_numerics_branch] + * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclInt.h: * generic/tclObj.c (Tcl_GetBooleanFromObj, SetDoubleFromAny, @@ -17,7 +19,10 @@ some code that is needed only for IBM hexadecimal floating point. Fixed bugs in code to handle the corner cases of smallest and largest significands. Added test cases to improve test coverage - in generic/tclStrToD.c. + in generic/tclStrToD.c. Added test cases for 0b notation (TIP + #114). Removed TclStrToD, and the static functions that it calls, + which are now dead code (TclParseNumber now does all input + floating-point conversions.) 2005-08-23 Don Porter <dgp@users.sourceforge.net> diff --git a/generic/tclInt.h b/generic/tclInt.h index 5bc4a88..1da991d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.202.2.31 2005/08/23 18:28:51 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.32 2005/08/23 19:15:40 kennykb Exp $ */ #ifndef _TCLINT @@ -2180,8 +2180,6 @@ MODULE_SCOPE void TclSetProcessGlobalValue _ANSI_ARGS_ (( Tcl_Encoding encoding)); MODULE_SCOPE VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id, int result)); -MODULE_SCOPE double TclStrToD _ANSI_ARGS_((CONST char* string, - CONST char** endPtr)); MODULE_SCOPE int TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr)); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 71de6e8..998a824 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -15,7 +15,7 @@ * 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.1.2.29 2005/08/23 18:28:51 kennykb Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.30 2005/08/23 19:15:41 kennykb Exp $ * *---------------------------------------------------------------------- */ @@ -1677,674 +1677,6 @@ RefineApproximation( double approxResult, /* *---------------------------------------------------------------------- * - * TclStrToD -- - * - * Scans a double from a string. - * - * Results: - * Returns the scanned number. In the case of underflow, returns an - * appropriately signed zero; in the case of overflow, returns an - * appropriately signed HUGE_VAL. - * - * Side effects: - * Stores a pointer to the end of the scanned number in '*endPtr', if - * endPtr is not NULL. If '*endPtr' is equal to 's' on return from this - * function, it indicates that the input string could not be recognized - * as a number. In the case of underflow or overflow, 'errno' is set to - * ERANGE. - * - *------------------------------------------------------------------------ - */ - -double -TclStrToD(CONST char *s, /* String to scan. */ - CONST char **endPtr) /* Pointer to the end of the scanned number. */ -{ - const char *p = s; - const char *startOfSignificand = NULL; - /* Start of the significand in the string. */ - int signum = 0; /* Sign of the significand. */ - double exactSignificand = 0.0; - /* Significand, represented exactly as a - * floating-point number. */ - int seenDigit = 0; /* Flag == 1 if a digit has been seen. */ - int nSigDigs = 0; /* Number of significant digits presented. */ - int nDigitsAfterDp = 0; /* Number of digits after the decimal point. */ - int nTrailZero = 0; /* Number of trailing zeros in the - * significand. */ - long exponent = 0; /* Exponent. */ - int seenDp = 0; /* Flag == 1 if decimal point has been seen. */ - char c; /* One character extracted from the input. */ - volatile double v; /* Scanned value; must be 'volatile double' on - * gc-ix86 to force correct rounding to IEEE - * double and not Intel double-extended. */ - int machexp; /* Exponent of the machine rep of the scanned - * value. */ - int expt2; /* Exponent for computing first approximation - * to the true value. */ - int i, j; - - /* - * With gcc on x86, the floating point rounding mode is double-extended. - * This causes the result of double-precision calculations to be rounded - * twice: once to the precision of double-extended and then again to the - * precision of double. Double-rounding introduces gratuitous errors of - * one ulp, so we need to change rounding mode to 53-bits. - */ - -#ifdef ADJUST_FPU_CONTROL_WORD - fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING; - fpu_control_t oldRoundingMode; - _FPU_GETCW(oldRoundingMode); - _FPU_SETCW(roundTo53Bits); -# define RestoreRoundingMode() _FPU_SETCW(oldRoundingMode) -#else -# define RestoreRoundingMode() (void) 0 /* Do nothing */ -#endif - - /* - * Discard leading whitespace from input. - */ - - while (isspace(UCHAR(*p))) { - ++p; - } - - /* - * Determine the sign of the significand. - */ - - switch (*p) { - case '-': - signum = 1; - /* FALLTHROUGH */ - case '+': - ++p; - } - - /* - * Discard leading zeroes from input. - */ - - while (*p == '0') { - seenDigit = 1; - ++p; - } - - /* - * Scan digits from the significand. Simultaneously, keep track of the - * number of digits after the decimal point. Maintain a pointer to the - * start of the significand. Keep "exactSignificand" equal to the - * conversion of the DBL_DIG most significant digits. - */ - - for (;;) { - c = *p; - if (c == '.' && !seenDp) { - seenDp = 1; - ++p; - } else if (isdigit(UCHAR(c))) { - if (c == '0') { - if (startOfSignificand != NULL) { - ++nTrailZero; - } - } else { - if (startOfSignificand == NULL) { - startOfSignificand = p; - } else if (nTrailZero) { - if (nTrailZero + nSigDigs < DBL_DIG) { - exactSignificand *= pow10[nTrailZero]; - } else if (nSigDigs < DBL_DIG) { - exactSignificand *= pow10[DBL_DIG - nSigDigs]; - } - nSigDigs += nTrailZero; - } - if (nSigDigs < DBL_DIG) { - exactSignificand = 10. * exactSignificand + (c - '0'); - } - ++nSigDigs; - nTrailZero = 0; - } - if (seenDp) { - ++nDigitsAfterDp; - } - seenDigit = 1; - ++p; - } else { - break; - } - } - - /* - * At this point, we've scanned the significand, and p points to the - * character beyond it. "startOfSignificand" is the first non-zero - * character in the significand. "nSigDigs" is the number of significant - * digits of the significand, not including any trailing zeroes. - * "exactSignificand" is a floating point number that represents, without - * loss of precision, the first min(DBL_DIG,n) digits of the significand. - * "nDigitsAfterDp" is the number of digits after the decimal point, again - * excluding trailing zeroes. - * - * Now scan 'E' format - */ - - exponent = 0; - if (seenDigit && (*p == 'e' || *p == 'E')) { - const char* stringSave = p; - ++p; - c = *p; - if (isdigit(UCHAR(c)) || c == '+' || c == '-') { - errno = 0; - exponent = strtol(p, (char**)&p, 10); - if (errno == ERANGE) { - if (exponent > 0) { - v = HUGE_VAL; - } else { - v = 0.0; - } - *endPtr = p; - goto returnValue; - } - } - if (p == stringSave+1) { - p = stringSave; - exponent = 0; - } - } - exponent += nTrailZero - nDigitsAfterDp; - - /* - * If we come here with no significant digits, we might still be looking - * at Inf or NaN. Go parse them. - */ - - if (!seenDigit) { - /* - * Test for Inf or Infinity (in any case). - */ - - if (c == 'I' || c == 'i') { - if ((p[1] == 'N' || p[1] == 'n') - && (p[2] == 'F' || p[2] == 'f')) { - p += 3; - if ((p[0] == 'I' || p[0] == 'i') - && (p[1] == 'N' || p[1] == 'n') - && (p[2] == 'I' || p[2] == 'i') - && (p[3] == 'T' || p[3] == 't') - && (p[4] == 'Y' || p[1] == 'y')) { - p += 5; - } - errno = ERANGE; - v = HUGE_VAL; - if (endPtr != NULL) { - *endPtr = p; - } - goto returnValue; - } - -#ifdef IEEE_FLOATING_POINT - /* - * Only IEEE floating point supports NaN - */ - } else if ((c == 'N' || c == 'n') - && (sizeof(Tcl_WideUInt) == sizeof(double))) { - if ((p[1] == 'A' || p[1] == 'a') - && (p[2] == 'N' || p[2] == 'n')) { - p += 3; - - if (endPtr != NULL) { - *endPtr = p; - } - - /* - * Restore FPU mode word. - */ - - RestoreRoundingMode(); - return ParseNaN(signum, endPtr); - } -#endif - } - - goto error; - } - - /* - * We've successfully scanned; update the end-of-element pointer. - */ - - if (endPtr != NULL) { - *endPtr = p; - } - - /* - * Test for zero. - */ - - if (nSigDigs == 0) { - v = 0.0; - goto returnValue; - } - - /* - * The easy cases are where we have an exact significand and the exponent - * is small enough that we can compute the value with only one roundoff. - * In addition to the cases where we can multiply or divide an - * exact-integer significand by an exact-integer power of 10, there is - * also David Gay's case where we can scale the significand by a power of - * 10 (still keeping it exact) and then multiply by an exact power of 10. - * The last case enables combinations like 83e25 that would otherwise - * require high precision arithmetic. - */ - - if (nSigDigs <= DBL_DIG) { - if (exponent >= 0) { - if (exponent <= mmaxpow) { - v = exactSignificand * pow10[exponent]; - goto returnValue; - } else { - int diff = DBL_DIG - nSigDigs; - if ( exponent - diff <= (int) mmaxpow ) { - volatile double factor = exactSignificand * pow10[ diff ]; - v = factor * pow10[ exponent - diff ]; - goto returnValue; - } - } - } else if (exponent >= -mmaxpow) { - v = exactSignificand / pow10[-exponent]; - goto returnValue; - } - } - - /* - * We don't have one of the easy cases, so we can't compute the scanned - * number exactly, and have to do it in multiple precision. Begin by - * testing for obvious overflows and underflows. - */ - - if (nSigDigs + exponent - 1 > maxDigits) { - v = HUGE_VAL; - errno = ERANGE; - goto returnValue; - } - if (nSigDigs + exponent - 1 < minDigits) { - errno = ERANGE; - v = 0.; - goto returnValue; - } - - /* - * Nothing exceeds the boundaries of the tables, at least. Compute an - * approximate value for the number, with no possibility of overflow - * because we manage the exponent separately. - */ - - if (nSigDigs > DBL_DIG) { - expt2 = exponent + nSigDigs - DBL_DIG; - } else { - expt2 = exponent; - } - v = frexp(exactSignificand, &machexp); - if (expt2 > 0) { - v = frexp(v * pow10[expt2 & 0xf], &j); - machexp += j; - for (i=4 ; i<9 ; ++i) { - if (expt2 & (1 << i)) { - v = frexp(v * pow_10_2_n[i], &j); - machexp += j; - } - } - } else { - v = frexp(v / pow10[(-expt2) & 0xf], &j); - machexp += j; - for (i=4 ; i<9 ; ++i) { - if ((-expt2) & (1 << i)) { - v = frexp(v / pow_10_2_n[i], &j); - machexp += j; - } - } - } - - /* - * A first approximation is that the result will be v * 2 ** machexp. v is - * greater than or equal to 0.5 and less than 1. If machexp > - * DBL_MAX_EXP*log2(FLT_RADIX), there is an overflow. Constrain the result - * to the smallest representible number to avoid premature underflow. - */ - - if (machexp > DBL_MAX_EXP * log2FLT_RADIX) { - v = HUGE_VAL; - errno = ERANGE; - goto returnValue; - } - - v = SafeLdExp(v, machexp); - if (v < tiny) { - v = tiny; - } - - /* - * We have a first approximation in v. Now we need to refine it. - */ - - v = RefineResult(v, startOfSignificand, nSigDigs, exponent); - - /* - * In a very few cases, a second iteration is needed. e.g., 457e-102 - */ - - v = RefineResult(v, startOfSignificand, nSigDigs, exponent); - - /* - * Handle underflow. - */ - - returnValue: - if (nSigDigs != 0 && v == 0.0) { - errno = ERANGE; - } - - /* - * Return a number with correct sign. - */ - - if (signum) { - v = -v; - } - - /* - * Restore FPU mode word and return. - */ - - RestoreRoundingMode(); - return v; - - /* - * Come here on an invalid input. - */ - - error: - if (endPtr != NULL) { - *endPtr = s; - } - - /* - * Restore FPU mode word and return. - */ - - RestoreRoundingMode(); - return 0.0; -} - -/* - *---------------------------------------------------------------------- - * - * RefineResult -- - * - * Given a poor approximation to a floating point number, returns a - * better one. (The better approximation is correct to within 1 ulp, and - * is entirely correct if the poor approximation is correct to 1 ulp.) - * - * Results: - * Returns the improved result. - * - *---------------------------------------------------------------------- - */ - -static double -RefineResult(double approxResult, /* Approximate result of conversion. */ - CONST char* sigStart, - /* Pointer to start of significand in input - * string. */ - int nSigDigs, /* Number of significant digits. */ - long exponent) /* Power of ten to multiply by significand. */ -{ - int M2, M5; /* Powers of 2 and of 5 needed to put the - * decimal and binary numbers over a common - * denominator. */ - double significand; /* Sigificand of the binary number. */ - int binExponent; /* Exponent of the binary number. */ - int msb; /* Most significant bit position of an - * intermediate result. */ - int nDigits; /* Number of mp_digit's in an intermediate - * result. */ - mp_int twoMv; /* Approx binary value expressed as an exact - * integer scaled by the multiplier 2M. */ - mp_int twoMd; /* Exact decimal value expressed as an exact - * integer scaled by the multiplier 2M. */ - int scale; /* Scale factor for M. */ - int multiplier; /* Power of two to scale M. */ - double num, den; /* Numerator and denominator of the correction - * term. */ - double quot; /* Correction term. */ - double minincr; /* Lower bound on the absolute value of the - * correction term. */ - int i; - const char* p; - - /* - * The first approximation is always low. If we find that it's HUGE_VAL, - * we're done. - */ - - if (approxResult == HUGE_VAL) { - return approxResult; - } - - /* - * Find a common denominator for the decimal and binary fractions. The - * common denominator will be 2**M2 + 5**M5. - */ - - significand = frexp(approxResult, &binExponent); - i = mantBits - binExponent; - if (i < 0) { - M2 = 0; - } else { - M2 = i; - } - if (exponent > 0) { - M5 = 0; - } else { - M5 = -exponent; - if ((M5-1) > M2) { - M2 = M5-1; - } - } - - /* - * The floating point number is significand*2**binExponent. The 2**-1 bit - * of the significand (the most significant) corresponds to the - * 2**(binExponent+M2 + 1) bit of 2*M2*v. Allocate enough digits to hold - * that quantity, then convert the significand to a large integer, scaled - * appropriately. Then multiply by the appropriate power of 5. - */ - - msb = binExponent + M2; /* 1008 */ - nDigits = msb / DIGIT_BIT + 1; - mp_init_size(&twoMv, nDigits); - i = (msb % DIGIT_BIT + 1); - twoMv.used = nDigits; - significand *= SafeLdExp(1.0, i); - while (--nDigits >= 0) { - twoMv.dp[nDigits] = (mp_digit) significand; - significand -= (mp_digit) significand; - significand = SafeLdExp(significand, DIGIT_BIT); - } - for (i=0 ; i<=8 ; ++i) { - if (M5 & (1 << i)) { - 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 - * 5**(M5+exponent). - */ - - mp_init(&twoMd); - mp_zero(&twoMd); - i = nSigDigs; - for (p=sigStart ;; ++p) { - char c = *p; - if (isdigit(UCHAR(c))) { - mp_mul_d(&twoMd, (unsigned) 10, &twoMd); - mp_add_d(&twoMd, (unsigned) (c - '0'), &twoMd); - --i; - if (i == 0) { - break; - } - } - } - for (i=0 ; i<=8 ; ++i) { - if ((M5+exponent) & (1 << i)) { - mp_mul(&twoMd, pow5+i, &twoMd); - } - } - mp_mul_2d(&twoMd, M2+exponent+1, &twoMd); - mp_sub(&twoMd, &twoMv, &twoMd); - - /* - * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction - * term. Because 2M may well overflow a double, we need to scale the - * denominator by a factor of 2**binExponent-mantBits - */ - - scale = binExponent - mantBits - 1; - - mp_set(&twoMv, 1); - for (i=0 ; i<=8 ; ++i) { - if (M5 & (1 << i)) { - mp_mul(&twoMv, pow5+i, &twoMv); - } - } - multiplier = M2 + scale + 1; - if (multiplier > 0) { - mp_mul_2d(&twoMv, multiplier, &twoMv); - } else if (multiplier < 0) { - mp_div_2d(&twoMv, -multiplier, &twoMv, NULL); - } - - /* - * If the result is less than unity, the error is less than 1/2 unit in - * the last place, so there's no correction to make. - */ - - if (mp_cmp_mag(&twoMd, &twoMv) == MP_LT) { - mp_clear(&twoMd); - mp_clear(&twoMv); - return approxResult; - } - - /* - * Convert the numerator and denominator of the corrector term accurately - * to floating point numbers. - */ - - num = TclBignumToDouble(&twoMd); - den = TclBignumToDouble(&twoMv); - - quot = SafeLdExp(num/den, scale); - minincr = SafeLdExp(1.0, binExponent - mantBits); - - if (quot<0. && quot>-minincr) { - quot = -minincr; - } else if (quot>0. && quot<minincr) { - quot = minincr; - } - - mp_clear(&twoMd); - mp_clear(&twoMv); - - return approxResult + quot; -} - -/* - *---------------------------------------------------------------------- - * - * ParseNaN -- - * - * Parses a "not a number" from an input string, and returns the double - * precision NaN corresponding to it. - * - * Side effects: - * Advances endPtr to follow any (hex) in the input string. - * - * If the NaN is followed by a left paren, a string of spaes and - * hexadecimal digits, and a right paren, endPtr is advanced to follow - * it. - * - * The string of hexadecimal digits is OR'ed into the resulting NaN, and - * the signum is set as well. Note that a signalling NaN is never - * returned. - * - *---------------------------------------------------------------------- - */ - -#ifdef IEEE_FLOATING_POINT -static double -ParseNaN(int signum, /* Flag == 1 if minus sign has been seen in - * front of NaN. */ - CONST char** endPtr) /* Pointer-to-pointer to char following "NaN" - * in the input string. */ -{ - const char* p = *endPtr; - char c; - union { - Tcl_WideUInt iv; - double dv; - } theNaN; - - /* - * Scan off a hex number in parentheses. Embedded blanks are ok. - */ - - theNaN.iv = 0; - if (*p == '(') { - ++p; - for (;;) { - c = *p++; - if (isspace(UCHAR(c))) { - continue; - } else if (c == ')') { - *endPtr = p; - break; - } else if (isdigit(UCHAR(c))) { - c -= '0'; - } else if (c >= 'A' && c <= 'F') { - c -= 'A' + 10; - } else if (c >= 'a' && c <= 'f') { - c -= 'a' + 10; - } else { - theNaN.iv = (((Tcl_WideUInt) NAN_START) << 48) - | (((Tcl_WideUInt) signum) << 63); - return theNaN.dv; - } - theNaN.iv = (theNaN.iv << 4) | c; - } - } - - /* - * Mask the hex number down to the least significant 51 bits. - */ - - theNaN.iv &= ( ((Tcl_WideUInt) 1) << 51 ) - 1; - if ( signum ) { - theNaN.iv |= ((Tcl_WideUInt) (0x8000 | NAN_START)) << 48; - } else { - theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48; - } - - *endPtr = p; - return theNaN.dv; -} -#endif /* IEEE_FLOATING_POINT */ - -/* - *---------------------------------------------------------------------- - * * TclDoubleDigits -- * * Converts a double to a string of digits. diff --git a/tests/expr.test b/tests/expr.test index f39c65a..7805cda 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.30.2.18 2005/08/23 18:28:52 kennykb Exp $ +# RCS: @(#) $Id: expr.test,v 1.30.2.19 2005/08/23 19:15:41 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -6589,6 +6589,48 @@ test expr-42.1 {denormals} ieeeFloatingPoint { expr 7e-324 } 5e-324 +# TIP 114 + +test expr-43.1 {0b notation} { + expr 0b0 +} 0 +test expr-43.2 {0b notation} { + expr 0b1 +} 1 +test expr-43.3 {0b notation} { + expr 0b10 +} 2 +test expr-43.4 {0b notation} { + expr 0b11 +} 3 +test expr-43.5 {0b notation} { + expr 0b100 +} 4 +test expr-43.6 {0b notation} { + expr 0b101 +} 5 +test expr-43.7 {0b notation} { + expr 0b1000 +} 8 +test expr-43.8 {0b notation} { + expr 0b1001 +} 9 +test expr-43.9 {0b notation} { + expr 0b1[string repeat 0 31] +} 2147483648 +test expr-43.10 {0b notation} { + expr 0b1[string repeat 0 30]1 +} 2147483649 +test expr-54.11 {0b notation} { + expr 0b[string repeat 1 64] +} 18446744073709551615 +test expr-54.12 {0b notation} { + expr 0b1[string repeat 0 64] +} 18446744073709551616 +test expr-54.13 {0b notation} { + expr 0b1[string repeat 0 63]1 +} 18446744073709551617 + # cleanup if {[info exists a]} { unset a |