From 0c53151b0a0babe6750b97749fe0f26b754177ae Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 29 Mar 2006 16:04:03 +0000 Subject: * generic/tclExecute.c: Revised INST_MOD implementation to do calculations in native types as much as possible, moving to mp_ints only when necessary. --- ChangeLog | 6 ++ generic/tclExecute.c | 182 +++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 160 insertions(+), 28 deletions(-) diff --git a/ChangeLog b/ChangeLog index 49c0e54..0233f80 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2006-03-29 Don Porter + + * generic/tclExecute.c: Revised INST_MOD implementation to do + calculations in native types as much as possible, moving to mp_ints + only when necessary. + 2006-03-28 Jeff Hobbs * win/tclWinPipe.c (TclpCreateProcess): change panics to Tcl diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 51cb634..58e771c 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.234 2006/03/27 23:12:59 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.235 2006/03/29 16:04:09 dgp Exp $ */ #include "tclInt.h" @@ -3700,7 +3700,7 @@ TclExecuteByteCode( Tcl_Obj *valuePtr = *(tosPtr - 1); ClientData ptr1, ptr2; int invalid, shift, type1, type2; - long l; + long l1, l2; result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); if ((result != TCL_OK) @@ -3725,20 +3725,144 @@ TclExecuteByteCode( } if (*pc == INST_MOD) { - /* Both values are some kind of integer */ - /* TODO: optimize use of narrower native integers */ - mp_int big1, big2, bigResult, bigRemainder; - - Tcl_GetBignumFromObj(NULL, valuePtr, &big1); - Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); - mp_init(&bigResult); - if (mp_iszero(&big2)) { + /* Following section assumes BIGNUM_AUTO_NARROW */ + /* TODO: Attempts to re-use unshared operands on stack */ + if (type2 == TCL_NUMBER_LONG) { + l2 = *((CONST long *)ptr2); + if (l2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); - mp_clear(&big1); - mp_clear(&big2); goto divideByZero; } + if ((l2 == 1) || (l2 == -1)) { + /* Div. by |1| always yields remainder of 0 */ + objResultPtr = eePtr->constants[0]; + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + } + if (type1 == TCL_NUMBER_LONG) { + l1 = *((CONST long *)ptr1); + if (l1 == 0) { + /* 0 % (non-zero) always yields remainder of 0 */ + objResultPtr = eePtr->constants[0]; + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + if (type2 == TCL_NUMBER_LONG) { + /* Both operands are long; do native calculation */ + long lRemainder, lQuotient = l1 / l2; + + /* Force Tcl's integer division rules */ + /* TODO: examine for logic simplification */ + if (((lQuotient < 0) || ((lQuotient == 0) && + ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && + ((lQuotient * l2) != l1)) { + lQuotient -= 1; + } + lRemainder = l1 - l2*lQuotient; + TclNewLongObj(objResultPtr, lRemainder); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + /* + * first operand fits in long; second does not, so the second + * has greater magnitude than first. No need to divide to + * determine the remainder. + */ +#ifndef NO_WIDE_TYPE + if (type2 == TCL_NUMBER_WIDE) { + Tcl_WideInt wResult, w2 = *((CONST Tcl_WideInt *)ptr2); + + if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) { + /* Arguments are opposite sign; remainder is sum */ + objResultPtr = Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + /* Arguments are same sign; remainder is first operand */ + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } +#endif + { + mp_int big2; + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + + /* TODO: internals intrusion */ + if ((l1 > 0) ^ big2.sign) { + /* Arguments are opposite sign; remainder is sum */ + mp_int big1; + TclBNInitBignumFromLong(&big1, l1); + mp_add(&big2, &big1, &big2); + objResultPtr = Tcl_NewBignumObj(&big2); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + /* Arguments are same sign; remainder is first operand */ + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } +#ifndef NO_WIDE_TYPE + if (type1 == TCL_NUMBER_WIDE) { + Tcl_WideInt w1 = *((CONST Tcl_WideInt *)ptr1); + if (type2 != TCL_NUMBER_BIG) { + Tcl_WideInt w2, wQuotient, wRemainder; + + Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2); + wQuotient = w1 / w2; + + /* Force Tcl's integer division rules */ + /* TODO: examine for logic simplification */ + if (((wQuotient < ((Tcl_WideInt) 0)) + || ((wQuotient == ((Tcl_WideInt) 0)) + && ((w1 < ((Tcl_WideInt) 0) + && w2 > ((Tcl_WideInt) 0)) + || (w1 > ((Tcl_WideInt) 0) + && w2 < ((Tcl_WideInt) 0))))) && + ((wQuotient * w2) != w1)) { + wQuotient -= (Tcl_WideInt) 1; + } + wRemainder = w1 - w2*wQuotient; + objResultPtr = Tcl_NewWideIntObj(wRemainder); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + { + mp_int big2; + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + + /* TODO: internals intrusion */ + if ((w1 > ((Tcl_WideInt) 0)) ^ big2.sign) { + /* Arguments are opposite sign; remainder is sum */ + mp_int big1; + TclBNInitBignumFromWideInt(&big1, w1); + mp_add(&big2, &big1, &big2); + objResultPtr = Tcl_NewBignumObj(&big2); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + /* Arguments are same sign; remainder is first operand */ + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } +#endif + { + mp_int big1, big2, bigResult, bigRemainder; + + Tcl_GetBignumFromObj(NULL, valuePtr, &big1); + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + mp_init(&bigResult); mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); if (!mp_iszero(&bigRemainder) @@ -3749,17 +3873,18 @@ TclExecuteByteCode( } mp_copy(&bigRemainder, &bigResult); mp_clear(&bigRemainder); - mp_clear(&big1); - mp_clear(&big2); - TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - if (Tcl_IsShared(valuePtr)) { - objResultPtr = Tcl_NewBignumObj(&bigResult); - TRACE(("%s\n", O2S(objResultPtr))); - NEXT_INST_F(1, 2, 1); + mp_clear(&big1); + mp_clear(&big2); + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + if (Tcl_IsShared(valuePtr)) { + objResultPtr = Tcl_NewBignumObj(&bigResult); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetBignumObj(valuePtr, &bigResult); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); } - Tcl_SetBignumObj(valuePtr, &bigResult); - TRACE(("%s\n", O2S(valuePtr))); - NEXT_INST_F(1, 1, 0); } /* reject negative shift argument */ @@ -3813,10 +3938,10 @@ TclExecuteByteCode( /* Handle shifts within the native long range */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if ((type1 == TCL_NUMBER_LONG) && (shift < CHAR_BIT*sizeof(long)) - && (l = *((CONST long *)ptr1)) - && !(((l>0) ? l : ~l) + && (l1 = *((CONST long *)ptr1)) + && !(((l1>0) ? l1 : ~l1) & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) { - TclNewLongObj(objResultPtr, (l<= CHAR_BIT*sizeof(long)) { - if (l >= (long)0) { + if (l1 >= (long)0) { objResultPtr = eePtr->constants[0]; } else { TclNewIntObj(objResultPtr, -1); } } else { - TclNewLongObj(objResultPtr, (l >> shift)); + TclNewLongObj(objResultPtr, (l1 >> shift)); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -4566,6 +4691,7 @@ TclExecuteByteCode( } /* Following section assumes BIGNUM_AUTO_NARROW */ + /* TODO: Attempts to re-use unshared operands on stack */ if (*pc == INST_EXPON) { long l2 = 0; int oddExponent = 0, negativeExponent = 0; -- cgit v0.12