From 090a519a33baf8f6568a0540f581d12b80907553 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Oct 2005 18:48:51 +0000 Subject: [kennykb-numerics-branch] * generic/tclExecute.c: Improved performance of INST_RSHIFT and INST_LSHIFT. --- ChangeLog | 3 +- generic/tclExecute.c | 212 +++++++++++++++++++++++---------------------------- 2 files changed, 99 insertions(+), 116 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5e5ba82..bd9ce6c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,7 +2,8 @@ [kennykb-numerics-branch] - * generic/tclExecute.c: Improved performance of INST_RSHIFT. + * generic/tclExecute.c: Improved performance of INST_RSHIFT and + INST_LSHIFT. 2005-10-05 Don Porter diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 48eb08d..1b7cfa8 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.167.2.49 2005/10/06 16:14:48 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.50 2005/10/06 18:48:52 dgp Exp $ */ #include "tclInt.h" @@ -3825,11 +3825,13 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F(0, 2, 1); } + case INST_LSHIFT: case INST_RSHIFT: { Tcl_Obj *value2Ptr = *tosPtr; Tcl_Obj *valuePtr = *(tosPtr - 1); ClientData ptr1, ptr2; int invalid, shift, type1, type2; + long l; result = TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1); if ((result != TCL_OK) @@ -3874,47 +3876,91 @@ TclExecuteByteCode(interp, codePtr) goto checkForCatch; } - TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - /* Quickly force large right shifts to 0 or -1 */ - if ((type2 != TCL_NUMBER_LONG) - || ( *((CONST long *)ptr2) > INT_MAX)) { - int zero; - switch (type1) { - case TCL_NUMBER_LONG: - zero = (*((CONST long *)ptr1) >= (long)0); - break; -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - zero = (*((CONST Tcl_WideInt *)ptr1) > (Tcl_WideInt)0); - break; -#endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); - } - if (zero) { - objResultPtr = eePtr->constants[0]; - } else { - TclNewIntObj(objResultPtr, -1); - } + /* Zero shifted any number of bits is still zero */ + if ((type1 == TCL_NUMBER_LONG) && (*((CONST long *)ptr1) == (long)0)) { + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + objResultPtr = eePtr->constants[0]; TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } - shift = (int)(*((CONST long *)ptr2)); - if (type1 == TCL_NUMBER_LONG) { - long l = *((CONST long *)ptr1); - if (shift >= CHAR_BIT*sizeof(long)) { - if (l >= (long)0) { + + if (*pc == INST_LSHIFT) { + /* Large left shifts create integer overflow */ + result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift); + if (result != TCL_OK) { + /* + * Technically, we could hold the value (1 << (INT_MAX+1)) + * in an mp_int, but since we're using mp_mul_2d() to do the + * work, and it takes only an int argument, that's a good + * place to draw the line. + */ + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent", -1)); + goto checkForCatch; + } + /* 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) + & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) { + TclNewLongObj(objResultPtr, (l< ", O2S(valuePtr), O2S(value2Ptr))); + if ((type2 != TCL_NUMBER_LONG) + || ( *((CONST long *)ptr2) > INT_MAX)) { + /* + * Again, technically, the value to be shifted could + * be an mp_int so huge that a right shift by (INT_MAX+1) + * bits could not take us to the result of 0 or -1, but + * since we're using mp_div_2d to do the work, and it + * takes only an int argument, we draw the line there. + */ + int zero; + switch (type1) { + case TCL_NUMBER_LONG: + zero = (*((CONST long *)ptr1) > (long)0); + break; +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + zero = (*((CONST Tcl_WideInt *)ptr1) > (Tcl_WideInt)0); + break; +#endif + case TCL_NUMBER_BIG: + /* TODO: const correctness ? */ + zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); + } + if (zero) { objResultPtr = eePtr->constants[0]; } else { TclNewIntObj(objResultPtr, -1); } - } else { - TclNewIntObj(objResultPtr, (l >> shift)); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); } - TRACE(("%s\n", O2S(objResultPtr))); - NEXT_INST_F(1, 2, 1); - } else { + shift = (int)(*((CONST long *)ptr2)); + /* Handle shifts within the native long range */ + if (type1 == TCL_NUMBER_LONG) { + l = *((CONST long *)ptr1); + if (shift >= CHAR_BIT*sizeof(long)) { + if (l >= (long)0) { + objResultPtr = eePtr->constants[0]; + } else { + TclNewIntObj(objResultPtr, -1); + } + } else { + TclNewIntObj(objResultPtr, (l >> shift)); + } + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + } + + { mp_int big, bigResult, bigRemainder; if (Tcl_IsShared(valuePtr)) { @@ -3924,94 +3970,30 @@ TclExecuteByteCode(interp, codePtr) } mp_init(&bigResult); - mp_init(&bigRemainder); - mp_div_2d(&big, shift, &bigResult, &bigRemainder); - if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { - /* Convert to Tcl's integer division rules */ - mp_sub_d(&bigResult, 1, &bigResult); + if (*pc == INST_LSHIFT) { + mp_mul_2d(&big, shift, &bigResult); + } else { + mp_init(&bigRemainder); + mp_div_2d(&big, shift, &bigResult, &bigRemainder); + if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { + /* Convert to Tcl's integer division rules */ + mp_sub_d(&bigResult, 1, &bigResult); + } + mp_clear(&bigRemainder); } mp_clear(&big); - mp_clear(&bigRemainder); - - 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); - } - } - - case INST_LSHIFT: { - Tcl_Obj *valuePtr, *value2Ptr; - mp_int big1, big2, bigResult; - int shift; - value2Ptr = *tosPtr; - valuePtr = *(tosPtr - 1); - result = Tcl_GetBignumFromObj(NULL, valuePtr, &big1); - if (result != TCL_OK) { - TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), - O2S(value2Ptr), (valuePtr->typePtr? - valuePtr->typePtr->name : "null"))); - IllegalExprOperandType(interp, pc, valuePtr); - goto checkForCatch; - } - result = Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); - if (result != TCL_OK) { - mp_clear(&big1); - TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), - O2S(value2Ptr), (value2Ptr->typePtr? - value2Ptr->typePtr->name : "null"))); - IllegalExprOperandType(interp, pc, value2Ptr); - goto checkForCatch; - } - if (mp_cmp_d(&big2, 0) == MP_LT) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("negative shift argument", -1)); - result = TCL_ERROR; - goto checkForCatch; - } - mp_clear(&big2); - if (mp_iszero(&big1)) { - /* Zero shifted any integral number of bits either way is zero */ - mp_clear(&big1); - TRACE(("0 %s => 0\n", O2S(value2Ptr))); - NEXT_INST_F(1, 1, 0); - } - result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift); - if (result != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); - goto checkForCatch; - } - mp_init(&bigResult); - if (*pc == INST_LSHIFT) { - mp_mul_2d(&big1, shift, &bigResult); - } else { - mp_int bigRemainder; - mp_init(&bigRemainder); - mp_div_2d(&big1, shift, &bigResult, &bigRemainder); - if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { - /* Convert to Tcl's integer division rules */ - mp_sub_d(&bigResult, 1, &bigResult); + if (!Tcl_IsShared(valuePtr)) { + Tcl_SetBignumObj(valuePtr, &bigResult); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); } - mp_clear(&bigRemainder); - } - mp_clear(&big1); - 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); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); } - + case INST_BITOR: case INST_BITXOR: case INST_BITAND: { -- cgit v0.12