diff options
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r-- | generic/tclCompCmds.c | 107 |
1 files changed, 48 insertions, 59 deletions
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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; words++) { + for (words=1 ; words<parsePtr->numWords ; 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; |