From 661d0c07c6af17979d24832f834aae99e2377dac Mon Sep 17 00:00:00 2001 From: dgp Date: Sun, 9 Sep 2007 16:51:15 +0000 Subject: * generic/tclCompCmds.c: Use the new INST_REVERSE instruction * tests/mathop.test: to correct the compiled versions of math operator commands. [Bug 1724437]. * generic/tclCompile.c: New bytecode instruction INST_REVERSE to * generic/tclCompile.h: reverse the order of N items at the top of * generic/tclExecute.c: stack. --- ChangeLog | 8 ++++ generic/tclCompCmds.c | 107 ++++++++++++++++++++++---------------------------- generic/tclCompile.c | 4 +- generic/tclCompile.h | 8 +++- generic/tclExecute.c | 18 ++++++++- tests/mathop.test | 7 ++-- 6 files changed, 86 insertions(+), 66 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8eda2b4..909088f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ 2007-09-09 Don Porter + * generic/tclCompCmds.c: Use the new INST_REVERSE instruction + * tests/mathop.test: to correct the compiled versions of math + operator commands. [Bug 1724437]. + + * generic/tclCompile.c: New bytecode instruction INST_REVERSE to + * generic/tclCompile.h: reverse the order of N items at the top of + * generic/tclExecute.c: stack. + * generic/tclCompCmds.c (TclCompilePowOpCmd): Make a separate routine to compile ** to account for its different associativity. diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6e1a683..dbf3301 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.117 2007/09/09 14:34:08 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.118 2007/09/09 16:51:18 dgp Exp $ */ #include "tclInt.h" @@ -4799,21 +4799,20 @@ CompileAssociativeBinaryOpCmd( DefineLineInformation; /* TIP #280 */ int words; - if (parsePtr->numWords == 1) { + for (words=1 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, words); + } + if (parsePtr->numWords <= 2) { PushLiteral(envPtr, identity, -1); - return TCL_OK; + words++; } - if (parsePtr->numWords == 2) { + if (words > 3) { /* - * TODO: Fixup the single argument case to require numeric argument. - * Fallback on direct eval until fixed. + * Reverse order of arguments to get precise agreement with + * [expr] in calcuations, including roundoff errors. */ - - return TCL_ERROR; - } - for (words=1 ; wordsnumWords ; words++) { - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + TclEmitInstInt4(INST_REVERSE, words-1, envPtr); } while (--words > 1) { TclEmitOpcode(instruction, envPtr); @@ -5042,6 +5041,10 @@ TclCompilePowOpCmd( Tcl_Parse *parsePtr, CompileEnv *envPtr) { + /* + * This one has its own implementation because the ** operator is + * the only one with right associativity. + */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; @@ -5178,29 +5181,6 @@ TclCompileStreqOpCmd( return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr); } -/* - * This is either clever or stupid. - * - * Note the rule: (a-b) = - (b-a) - * And apply repeatedly to: - * - * (((a-b)-c)-d) - * = - (d - ((a-b)-c)) - * = - (d - - (c - (a-b))) - * = - (d - - (c - - (b - a))) - * = - (d + (c + (b - a))) - * = - ((d + c + b) - a) - * = (a - (d + c + b)) - * - * So after word compilation puts the substituted arguments on the stack in - * reverse order, we don't have to turn them around again and apply repeated - * INST_SUB instructions. Instead we keep them in reverse order and apply a - * different sequence of instructions. For N arguments, we apply N-2 - * INST_ADDs, then one INST_SUB. Note that this does the right thing for N=2, - * a single INST_SUB. When N=1, we can add a phony leading "0" argument and - * get the right result from the same algorithm as well. - */ - int TclCompileMinusOpCmd( Tcl_Interp *interp, @@ -5212,22 +5192,30 @@ TclCompileMinusOpCmd( int words; if (parsePtr->numWords == 1) { + /* Fallback to direct eval to report syntax error */ return TCL_ERROR; } - if (parsePtr->numWords == 2) { - PushLiteral(envPtr, "0", -1); - } for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } - if (parsePtr->numWords == 2) { - words++; + if (words == 2) { + TclEmitOpcode(INST_UMINUS, envPtr); + return TCL_OK; } - while (--words > 2) { - TclEmitOpcode(INST_ADD, envPtr); + if (words == 3) { + TclEmitOpcode(INST_SUB, envPtr); + return TCL_OK; + } + /* + * Reverse order of arguments to get precise agreement with + * [expr] in calcuations, including roundoff errors. + */ + TclEmitInstInt4(INST_REVERSE, words-1, envPtr); + while (--words > 1) { + TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitOpcode(INST_SUB, envPtr); } - TclEmitOpcode(INST_SUB, envPtr); return TCL_OK; } @@ -5237,31 +5225,32 @@ TclCompileDivOpCmd( Tcl_Parse *parsePtr, CompileEnv *envPtr) { - Tcl_Token *tokenPtr; + Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; if (parsePtr->numWords == 1) { + /* Fallback to direct eval to report syntax error */ return TCL_ERROR; - } else if (parsePtr->numWords == 2) { + } + if (parsePtr->numWords == 2) { PushLiteral(envPtr, "1.0", 3); - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode(INST_DIV, envPtr); - return TCL_OK; - } else { - /* - * TODO: get compiled version that passes mathop-6.18. For now, - * fallback to direct evaluation. - */ - - return TCL_ERROR; } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - for (words=2 ; wordsnumWords ; words++) { + for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); + } + if (words <= 3) { + TclEmitOpcode(INST_DIV, envPtr); + return TCL_OK; + } + /* + * Reverse order of arguments to get precise agreement with + * [expr] in calcuations, including roundoff errors. + */ + TclEmitInstInt4(INST_REVERSE, words-1, envPtr); + while (--words > 1) { + TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode(INST_DIV, envPtr); } return TCL_OK; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index fda8e9c..7ccf919 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.129 2007/08/30 19:24:32 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.130 2007/09/09 16:51:18 dgp Exp $ */ #include "tclInt.h" @@ -383,6 +383,8 @@ InstructionDesc tclInstructionTable[] = { * index op1. Leaves the namespace on stack. */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled bytecodes to signal syntax error. */ + {"reverse", 5, +1, 1, {OPERAND_UINT4}}, + /* Reverse the order of the arg elements at the top of stack */ {0} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ea975f9..50e2312 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.77 2007/08/28 16:24:31 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.78 2007/09/09 16:51:19 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -630,8 +630,12 @@ typedef struct ByteCode { #define INST_SYNTAX 125 +/* Instruction to reverse N items on top of stack */ + +#define INST_REVERSE 126 + /* The last opcode */ -#define LAST_INST_OPCODE 125 +#define LAST_INST_OPCODE 126 /* * Table describing the Tcl bytecode instructions: their name (for displaying diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 87b1024..e133c55 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.330 2007/09/08 22:36:59 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.331 2007/09/09 16:51:19 dgp Exp $ */ #include "tclInt.h" @@ -1883,6 +1883,22 @@ TclExecuteByteCode( NEXT_INST_F(5, 0, 1); } + case INST_REVERSE: { + int opnd; + Tcl_Obj **a, **b; + + opnd = TclGetUInt4AtPtr(pc+1); + a = tosPtr-(opnd-1); + b = tosPtr; + while (a