summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-12-06 18:05:25 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-12-06 18:05:25 (GMT)
commit1bd8d4fc6fdcdcd0ba535a3dc45b7670500acf83 (patch)
tree0e86d1914a1f1ef38a8ca255d4ad86ed37c3231c /generic
parent50620f98af568bb61c29bf2f7350cf455367813a (diff)
downloadtcl-1bd8d4fc6fdcdcd0ba535a3dc45b7670500acf83.zip
tcl-1bd8d4fc6fdcdcd0ba535a3dc45b7670500acf83.tar.gz
tcl-1bd8d4fc6fdcdcd0ba535a3dc45b7670500acf83.tar.bz2
* generic/tclCompCmds.c: Revised and consolidated into utility
* tests/mathop.c: routines some of routines that compile the new TIP 174 commands. This corrects some known bugs. More to come.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c218
1 files changed, 105 insertions, 113 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 02bf071..c12e8b3 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.93 2006/11/28 22:20:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.94 2006/12/06 18:05:26 dgp Exp $
*/
#include "tclInt.h"
@@ -135,6 +135,12 @@ static int PushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *simpleVarNamePtr, int *isScalarPtr, int line);
+static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, CONST char *identity,
+ unsigned char instruction, CompileEnv *envPtr);
+static int CompileUnaryOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, unsigned char instruction,
+ CompileEnv *envPtr);
/*
* Flags bits used by PushVarName.
@@ -4581,25 +4587,26 @@ PushVarName(
/*
*----------------------------------------------------------------------
*
- * TclCompileInvertOpCmd --
+ * CompileUnaryOpCmd --
*
- * Procedure called to compile the "::tcl::mathop::~" command.
+ * Utility routine to compile the unary operator commands.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
* evaluation to runtime.
*
* Side effects:
- * Instructions are added to envPtr to execute the "::tcl::mathop::~"
+ * Instructions are added to envPtr to execute the compiled
* command at runtime.
*
*----------------------------------------------------------------------
*/
-int
-TclCompileInvertOpCmd(
+static int
+CompileUnaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ unsigned char instruction,
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr;
@@ -4610,50 +4617,103 @@ TclCompileInvertOpCmd(
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
- TclEmitOpcode(INST_BITNOT, envPtr);
+ TclEmitOpcode(instruction, envPtr);
return TCL_OK;
}
-int
-TclCompileNotOpCmd(
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileAssociativeBinaryOpCmd --
+ *
+ * Utility routine to compile the binary operator commands that
+ * accept an arbitrary number of arguments, and that are associative
+ * operations. Because of the associativity, we may combine operations
+ * from right to left, saving us any effort of re-ordering the arguments
+ * on the stack after substitutions are completed.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the compiled
+ * command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileAssociativeBinaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ CONST char *identity,
+ unsigned char instruction,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
+ int words;
- if (parsePtr->numWords != 2) {
- return TCL_ERROR;
+ if (parsePtr->numWords == 1) {
+ PushLiteral(envPtr, identity, -1);
+ return TCL_OK;
+ }
+ for (words=1 ; words<parsePtr->numWords ; words++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ }
+ while (--words > 1) {
+ TclEmitOpcode(instruction, envPtr);
}
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp, 1);
- TclEmitOpcode(INST_LNOT, envPtr);
return TCL_OK;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompile*OpCmd --
+ *
+ * Procedures called to compile the corresponding
+ * "::tcl::mathop::*" commands.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the compiled
+ * command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInvertOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ CompileEnv *envPtr)
+{
+ return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
+}
+
+int
+TclCompileNotOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ CompileEnv *envPtr)
+{
+ return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
+}
+
int
TclCompileAddOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "0", 1);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- TclEmitOpcode(INST_ADD, envPtr);
- }
- return TCL_OK;
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "0", INST_ADD, envPtr);
}
int
@@ -4662,22 +4722,8 @@ TclCompileMulOpCmd(
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "1", 1);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- TclEmitOpcode(INST_MULT, envPtr);
- }
- return TCL_OK;
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "1", INST_MULT, envPtr);
}
int
@@ -4686,22 +4732,8 @@ TclCompileAndOpCmd(
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "-1", 2);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- TclEmitOpcode(INST_BITAND, envPtr);
- }
- return TCL_OK;
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "-1", INST_BITAND, envPtr);
}
int
@@ -4710,22 +4742,8 @@ TclCompileOrOpCmd(
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "0", 1);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- TclEmitOpcode(INST_BITOR, envPtr);
- }
- return TCL_OK;
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "0", INST_BITOR, envPtr);
}
int
@@ -4734,22 +4752,8 @@ TclCompileXorOpCmd(
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "0", 1);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- TclEmitOpcode(INST_BITXOR, envPtr);
- }
- return TCL_OK;
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "0", INST_BITXOR, envPtr);
}
int
@@ -4758,24 +4762,12 @@ TclCompilePowOpCmd(
Tcl_Parse *parsePtr,
CompileEnv *envPtr)
{
- Tcl_Token *tokenPtr;
- DefineLineInformation; /* TIP #280 */
- int words;
-
- if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "1", 1);
- return TCL_OK;
- }
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,1);
- for (words=2 ; words<parsePtr->numWords ; words++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp,words);
- }
- for (; words>2 ; words--) {
- TclEmitOpcode(INST_EXPON, envPtr);
- }
- return TCL_OK;
+ /*
+ * The ** operator isn't associative, but the right to left
+ * calculation order of the called routine is correct
+ */
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ "1", INST_EXPON, envPtr);
}
int