diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 312 | ||||
| -rw-r--r-- | tests/expr.test | 8 |
3 files changed, 135 insertions, 191 deletions
@@ -1,5 +1,11 @@ 2006-03-23 Don Porter <dgp@users.sourceforge.net> + * generic/tclExecute.c: Revised INST_EXPON implementation to do + calculations in native types as much as possible, moving to mp_ints + only when necessary. + +2006-03-23 Don Porter <dgp@users.sourceforge.net> + * generic/tclExecute.c: Merged INST_EXPON handling in with the other binary operators that operate on all number types (INST_ADD, etc.). diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 73b12f6..68078be 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.229 2006/03/24 00:52:07 das Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.230 2006/03/24 18:20:37 dgp Exp $ */ #include "tclInt.h" @@ -417,11 +417,6 @@ static void ValidatePcAndStackTop(ByteCode *codePtr, unsigned char *pc, int stackTop, int stackLowerBound, int checkStack); #endif /* TCL_COMPILE_DEBUG */ -#if 0 -static Tcl_WideInt ExponWide(Tcl_WideInt w, Tcl_WideInt w2, - int *errExpon); -static long ExponLong(long i, long i2, int *errExpon); -#endif /* *---------------------------------------------------------------------- @@ -4566,6 +4561,104 @@ TclExecuteByteCode( NEXT_INST_F(1, 1, 0); } + /* Following section assumes BIGNUM_AUTO_NARROW */ + if (*pc == INST_EXPON) { + long l2 = 0; + int oddExponent = 0, negativeExponent = 0; + if (type2 == TCL_NUMBER_LONG) { + l2 = *((CONST long *)ptr2); + if (l2 == 0) { + /* Anything to the zero power is 1 */ + objResultPtr = eePtr->constants[1]; + NEXT_INST_F(1, 2, 1); + } + } + switch (type2) { + case TCL_NUMBER_LONG: { + negativeExponent = (l2 < 0); + oddExponent = (l2 & 1); + break; + } +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: { + Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2); + negativeExponent = (w2 < 0); + oddExponent = (w2 & (Tcl_WideInt)1); + break; + } +#endif + case TCL_NUMBER_BIG: { + mp_int big2; + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT); + mp_mod_2d(&big2, 1, &big2); + oddExponent = !mp_iszero(&big2); + mp_clear(&big2); + break; + } + } + + if (negativeExponent) { + if (type1 == TCL_NUMBER_LONG) { + long l1 = *((CONST long *)ptr1); + switch (l1) { + case 0: + /* zero to a negative power is div by zero error */ + TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr), + O2S(value2Ptr))); + goto exponOfZero; + case -1: + if (oddExponent) { + TclNewIntObj(objResultPtr, -1); + } else { + objResultPtr = eePtr->constants[1]; + } + NEXT_INST_F(1, 2, 1); + case 1: + /* 1 to any power is 1 */ + objResultPtr = eePtr->constants[1]; + NEXT_INST_F(1, 2, 1); + } + } + /* Integers with magnitude greater than 1 raise to a negative + * power yield the answer zero (see TIP 123) */ + objResultPtr = eePtr->constants[0]; + NEXT_INST_F(1, 2, 1); + } + + if (type1 == TCL_NUMBER_LONG) { + long l1 = *((CONST long *)ptr1); + switch (l1) { + case 0: + /* zero to a positive power is zero */ + objResultPtr = eePtr->constants[0]; + NEXT_INST_F(1, 2, 1); + case 1: + /* 1 to any power is 1 */ + objResultPtr = eePtr->constants[1]; + NEXT_INST_F(1, 2, 1); + case -1: + if (oddExponent) { + TclNewIntObj(objResultPtr, -1); + } else { + objResultPtr = eePtr->constants[1]; + } + NEXT_INST_F(1, 2, 1); + } + } + + if (type2 != TCL_NUMBER_LONG) { + result = TCL_ERROR; + Tcl_SetObjResult(interp, + Tcl_NewStringObj("exponent too large", -1)); + goto checkForCatch; + } + } + if ((*pc != INST_MULT) && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, wResult; @@ -4623,8 +4716,29 @@ TclExecuteByteCode( } break; case INST_EXPON: - /* TODO: Implement calculation for narrow integer types */ - goto overflow; + if (w2 & 1) { + wResult = w1; + } else { + wResult = Tcl_LongAsWide(1); + } + w1 *= w1; + w2 /= 2; + for (; w2>Tcl_LongAsWide(1) ; w1*=w1,w2/=2) { + if (w1 < 0) { + goto overflow; + } + if (w2 & 1) { + wResult *= w1; + if (wResult < 0) { + goto overflow; + } + } + } + wResult *= w1; + if (wResult < 0) { + goto overflow; + } + break; default: /* Unused, here to silence compiler warning. */ wResult = 0; @@ -4689,51 +4803,6 @@ TclExecuteByteCode( mp_clear(&bigRemainder); break; case INST_EXPON: - if (mp_iszero(&big2)) { - /* Anything to the zero power is 1 */ - mp_clear(&big1); - mp_clear(&big2); - objResultPtr = eePtr->constants[1]; - NEXT_INST_F(1, 2, 1); - } - if (mp_iszero(&big1)) { - if (mp_cmp_d(&big2, 0) == MP_LT) { - TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr), - O2S(value2Ptr))); - mp_clear(&big1); - mp_clear(&big2); - goto exponOfZero; - } - mp_clear(&big1); - mp_clear(&big2); - objResultPtr = eePtr->constants[0]; - NEXT_INST_F(1, 2, 1); - } - if (mp_cmp_d(&big2, 0) == MP_LT) { - switch (mp_cmp_d(&big1, 1)) { - case MP_GT: - objResultPtr = eePtr->constants[0]; - break; - case MP_EQ: - objResultPtr = eePtr->constants[1]; - break; - case MP_LT: - mp_add_d(&big1, 1, &big1); - if (mp_cmp_d(&big1, 0) == MP_LT) { - objResultPtr = eePtr->constants[0]; - break; - } - mp_mod_2d(&big2, 1, &big2); - if (mp_iszero(&big2)) { - objResultPtr = eePtr->constants[1]; - } else { - TclNewIntObj(objResultPtr, -1); - } - } - mp_clear(&big1); - mp_clear(&big2); - NEXT_INST_F(1, 2, 1); - } if (big2.used > 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("exponent too large", -1)); @@ -7313,143 +7382,6 @@ StringForResultCode( return buf; } #endif /* TCL_COMPILE_DEBUG */ -#if 0 - -/* - *---------------------------------------------------------------------- - * - * ExponWide -- - * - * Procedure to return w**w2 as wide integer - * - * Results: - * Return value is w to the power w2, unless the computation makes no - * sense mathematically. In that case *errExpon is set to 1. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static Tcl_WideInt -ExponWide( - Tcl_WideInt w, /* The value that must be exponentiated */ - Tcl_WideInt w2, /* The exponent */ - int *errExpon) /* Error code */ -{ - Tcl_WideInt result; - - *errExpon = 0; - - /* - * Check for possible errors and simple/edge cases - */ - - if (w == 0) { - if (w2 < 0) { - *errExpon = 1; - return W0; - } else if (w2 > 0) { - return W0; - } - return Tcl_LongAsWide(1); /* By definition and analysis */ - } else if (w < -1) { - if (w2 < 0) { - return W0; - } else if (w2 == 0) { - return Tcl_LongAsWide(1); - } - } else if (w == -1) { - return (w2 & 1) ? Tcl_LongAsWide(-1) : Tcl_LongAsWide(1); - } else if ((w == 1) || (w2 == 0)) { - return Tcl_LongAsWide(1); - } else if (w>1 && w2<0) { - return W0; - } - - /* - * The general case. - */ - - result = Tcl_LongAsWide(1); - for (; w2>Tcl_LongAsWide(1) ; w*=w,w2/=2) { - if (w2 & 1) { - result *= w; - } - } - return result * w; -} - -/* - *---------------------------------------------------------------------- - * - * ExponLong -- - * - * Procedure to return i**i2 as long integer - * - * Results: - * Return value is i to the power i2, unless the computation makes no - * sense mathematically. In that case *errExpon is set to 1. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static long -ExponLong( - long i, /* The value that must be exponentiated */ - long i2, /* The exponent */ - int *errExpon) /* Error code */ -{ - long result; - - *errExpon = 0; - - /* - * Check for possible errors and simple cases - */ - - if (i == 0) { - if (i2 < 0) { - *errExpon = 1; - return 0L; - } else if (i2 > 0) { - return 0L; - } - /* - * By definition and analysis, 0**0 is 1. - */ - return 1L; - } else if (i < -1) { - if (i2 < 0) { - return 0L; - } else if (i2 == 0) { - return 1L; - } - } else if (i == -1) { - return (i2&1) ? -1L : 1L; - } else if ((i == 1) || (i2 == 0)) { - return 1L; - } else if (i > 1 && i2 < 0) { - return 0L; - } - - /* - * The general case - */ - - result = 1; - for (; i2>1 ; i*=i,i2/=2) { - if (i2 & 1) { - result *= i; - } - } - return result * i; -} -#endif /* * Local Variables: diff --git a/tests/expr.test b/tests/expr.test index 39b8eb8..f747f87 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.51 2006/03/21 18:30:54 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.52 2006/03/24 18:20:37 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1025,6 +1025,12 @@ test expr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1 test expr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0 test expr-23.34 {INST_EXPON: special cases} {expr {2**0}} 1 test expr-23.35 {INST_EXPON: special cases} {expr {wide(2)**0}} 1 +test expr-23.36 {INST_EXPON: big integer} {expr {10**17}} 1[string repeat 0 17] +test expr-23.37 {INST_EXPON: big integer} {expr {10**18}} 1[string repeat 0 18] +test expr-23.38 {INST_EXPON: big integer} {expr {10**19}} 1[string repeat 0 19] +test expr-23.39 {INST_EXPON: big integer} { + expr 1[string repeat 0 30]**2 +} 1[string repeat 0 60] # Some compilers get this wrong; ensure that we work around it correctly test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0 |