summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-12-12 17:21:38 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-12-12 17:21:38 (GMT)
commitde68040d322c721b0f2781f53d87871d05ab130e (patch)
treee903c3b82fb1e9a97363419b07c94bd324299ff9
parentd9089b0f76f5224ffc6d7f52e0cd6d8306820853 (diff)
downloadtcl-de68040d322c721b0f2781f53d87871d05ab130e.zip
tcl-de68040d322c721b0f2781f53d87871d05ab130e.tar.gz
tcl-de68040d322c721b0f2781f53d87871d05ab130e.tar.bz2
* generic/tclBasic.c: Final step routing all direct evaluation forms
* generic/tclCompExpr.c: of the operator commands through TEBC, * generic/tclCompile.h: dropping all the routines in tclMathOp.c. * generic/tclMathOp.c: Still needs Engineering Manual attention.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c50
-rw-r--r--generic/tclCompExpr.c122
-rw-r--r--generic/tclCompile.h8
-rw-r--r--generic/tclMathOp.c11
5 files changed, 163 insertions, 35 deletions
diff --git a/ChangeLog b/ChangeLog
index bc93ee3..0059619 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-12-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Final step routing all direct evaluation forms
+ * generic/tclCompExpr.c: of the operator commands through TEBC,
+ * generic/tclCompile.h: dropping all the routines in tclMathOp.c.
+ * generic/tclMathOp.c: Still needs Engineering Manual attention.
+
2006-12-11 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: Another step with all sorting operator commands
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9f21b3b..d22b949 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.229 2006/12/11 18:54:10 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.230 2006/12/12 17:21:41 dgp Exp $
*/
#include "tclInt.h"
@@ -281,30 +281,30 @@ typedef struct {
} OpCmdInfo;
static const OpCmdInfo mathOpCmds[] = {
- { "~", TclSingleOpCmd, TclCompileInvertOpCmd, 1, "integer" },
- { "!", TclSingleOpCmd, TclCompileNotOpCmd, 1, "boolean" },
- { "+", TclAddOpCmd, TclCompileAddOpCmd, 0, NULL },
- { "*", TclMulOpCmd, TclCompileMulOpCmd, 0, NULL },
- { "&", TclAndOpCmd, TclCompileAndOpCmd, 0, NULL },
- { "|", TclOrOpCmd, TclCompileOrOpCmd, 0, NULL },
- { "^", TclXorOpCmd, TclCompileXorOpCmd, 0, NULL },
- { "**", TclPowOpCmd, TclCompilePowOpCmd, 0, NULL },
- { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd, 2, "integer shift" },
- { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd, 2, "integer shift" },
- { "%", TclSingleOpCmd, TclCompileModOpCmd, 2, "integer integer" },
- { "!=", TclSingleOpCmd, TclCompileNeqOpCmd, 2, "value value"},
- { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd, 2, "value value" },
- { "in", TclSingleOpCmd, TclCompileInOpCmd, 2, "value list"},
- { "ni", TclSingleOpCmd, TclCompileNiOpCmd, 2, "value list"},
- { "-", TclMinusOpCmd, TclCompileMinusOpCmd, 0, NULL },
- { "/", TclDivOpCmd, TclCompileDivOpCmd, 0, NULL },
- { "<", TclSortingOpCmd, TclCompileLessOpCmd, 0, NULL },
- { "<=", TclSortingOpCmd, TclCompileLeqOpCmd, 0, NULL },
- { ">", TclSortingOpCmd, TclCompileGreaterOpCmd, 0, NULL },
- { ">=", TclSortingOpCmd, TclCompileGeqOpCmd, 0, NULL },
- { "==", TclSortingOpCmd, TclCompileEqOpCmd, 0, NULL },
- { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, 0, NULL },
- { NULL, NULL, NULL, 0, NULL }
+ { "~", TclSingleOpCmd, TclCompileInvertOpCmd, 1, "integer" },
+ { "!", TclSingleOpCmd, TclCompileNotOpCmd, 1, "boolean" },
+ { "+", TclVariadicOpCmd, TclCompileAddOpCmd, 0, NULL },
+ { "*", TclVariadicOpCmd, TclCompileMulOpCmd, 1, NULL },
+ { "&", TclVariadicOpCmd, TclCompileAndOpCmd, -1, NULL },
+ { "|", TclVariadicOpCmd, TclCompileOrOpCmd, 0, NULL },
+ { "^", TclVariadicOpCmd, TclCompileXorOpCmd, 0, NULL },
+ { "**", TclVariadicOpCmd, TclCompilePowOpCmd, 1, NULL },
+ { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd, 2, "integer shift" },
+ { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd, 2, "integer shift" },
+ { "%", TclSingleOpCmd, TclCompileModOpCmd, 2, "integer integer" },
+ { "!=", TclSingleOpCmd, TclCompileNeqOpCmd, 2, "value value"},
+ { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd, 2, "value value" },
+ { "in", TclSingleOpCmd, TclCompileInOpCmd, 2, "value list"},
+ { "ni", TclSingleOpCmd, TclCompileNiOpCmd, 2, "value list"},
+ { "-", TclNoIdentOpCmd, TclCompileMinusOpCmd, 0, "value ?value ...?"},
+ { "/", TclNoIdentOpCmd, TclCompileDivOpCmd, 0, "value ?value ...?"},
+ { "<", TclSortingOpCmd, TclCompileLessOpCmd, 0, NULL },
+ { "<=", TclSortingOpCmd, TclCompileLeqOpCmd, 0, NULL },
+ { ">", TclSortingOpCmd, TclCompileGreaterOpCmd, 0, NULL },
+ { ">=", TclSortingOpCmd, TclCompileGeqOpCmd, 0, NULL },
+ { "==", TclSortingOpCmd, TclCompileEqOpCmd, 0, NULL },
+ { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, 0, NULL },
+ { NULL, NULL, NULL, 0, NULL }
};
/*
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index e893390..96b5b97 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.43 2006/12/11 18:54:11 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.44 2006/12/12 17:21:42 dgp Exp $
*/
#include "tclInt.h"
@@ -2653,7 +2653,7 @@ TclSortingOpCmd(
Tcl_Obj **litObjv = (Tcl_Obj **) ckalloc(2*(objc-2)*sizeof(Tcl_Obj *));
OpNode *nodes = (OpNode *) ckalloc(2*(objc-2)*sizeof(OpNode));
unsigned char lexeme;
- int i, lastBitAnd = 1;
+ int i, lastAnd = 1;
ParseLexeme(occdPtr->operator, strlen(occdPtr->operator),
&lexeme, NULL);
@@ -2667,14 +2667,14 @@ TclSortingOpCmd(
nodes[2*(i-1)-1].right = OT_LITERAL;
litObjv[2*(i-1)] = objv[i];
- nodes[2*(i-1)].lexeme = BIT_AND;
- nodes[2*(i-1)].left = lastBitAnd;
- nodes[lastBitAnd].parent = 2*(i-1);
+ nodes[2*(i-1)].lexeme = AND;
+ nodes[2*(i-1)].left = lastAnd;
+ nodes[lastAnd].parent = 2*(i-1);
nodes[2*(i-1)].right = 2*(i-1)+1;
nodes[2*(i-1)+1].parent= 2*(i-1);
- lastBitAnd = 2*(i-1);
+ lastAnd = 2*(i-1);
}
litObjv[2*(objc-2)-1] = objv[objc-1];
@@ -2682,8 +2682,8 @@ TclSortingOpCmd(
nodes[2*(objc-2)-1].left = OT_LITERAL;
nodes[2*(objc-2)-1].right = OT_LITERAL;
- nodes[0].right = lastBitAnd;
- nodes[lastBitAnd].parent = 0;
+ nodes[0].right = lastAnd;
+ nodes[lastAnd].parent = 0;
code = OpCmd(interp, nodes, litObjv);
@@ -2693,6 +2693,112 @@ TclSortingOpCmd(
return code;
}
+int
+TclVariadicOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+ unsigned char lexeme;
+ int code;
+
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->numArgs));
+ return TCL_OK;
+ }
+
+ ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL);
+ lexeme |= BINARY;
+
+ if (objc == 2) {
+ Tcl_Obj *litObjv[2];
+ OpNode nodes[2];
+ int decrMe = 0;
+
+ if (lexeme == EXPON) {
+ litObjv[1] = Tcl_NewIntObj(occdPtr->numArgs);
+ Tcl_IncrRefCount(litObjv[1]);
+ decrMe = 1;
+ litObjv[0] = objv[1];
+ nodes[0].lexeme = START;
+ nodes[0].right = 1;
+ nodes[1].lexeme = lexeme;
+ nodes[1].left = OT_LITERAL;
+ nodes[1].right = OT_LITERAL;
+ nodes[1].parent = 0;
+ } else {
+ if (lexeme == DIVIDE) {
+ litObjv[0] = Tcl_NewDoubleObj(1.0);
+ } else {
+ litObjv[0] = Tcl_NewIntObj(occdPtr->numArgs);
+ }
+ Tcl_IncrRefCount(litObjv[0]);
+ litObjv[1] = objv[1];
+ nodes[0].lexeme = START;
+ nodes[0].right = 1;
+ nodes[1].lexeme = lexeme;
+ nodes[1].left = OT_LITERAL;
+ nodes[1].right = OT_LITERAL;
+ nodes[1].parent = 0;
+ }
+
+ code = OpCmd(interp, nodes, litObjv);
+
+ Tcl_DecrRefCount(litObjv[decrMe]);
+ return code;
+ } else {
+ OpNode *nodes = (OpNode *) ckalloc((objc-1)*sizeof(OpNode));
+ int i, lastOp = OT_LITERAL;
+
+ nodes[0].lexeme = START;
+ if (lexeme == EXPON) {
+ for (i=objc-2; i>0; i-- ) {
+ nodes[i].lexeme = lexeme;
+ nodes[i].left = OT_LITERAL;
+ nodes[i].right = lastOp;
+ if (lastOp >= 0) {
+ nodes[lastOp].parent = i;
+ }
+ lastOp = i;
+ }
+ } else {
+ for (i=1; i<objc-1; i++ ) {
+ nodes[i].lexeme = lexeme;
+ nodes[i].left = lastOp;
+ if (lastOp >= 0) {
+ nodes[lastOp].parent = i;
+ }
+ nodes[i].right = OT_LITERAL;
+ lastOp = i;
+ }
+ }
+ nodes[0].right = lastOp;
+ nodes[lastOp].parent = 0;
+
+ code = OpCmd(interp, nodes, objv+1);
+
+ ckfree((char *) nodes);
+
+ return code;
+ }
+}
+
+int
+TclNoIdentOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+ return TCL_ERROR;
+ }
+ return TclVariadicOpCmd(clientData, interp, objc, objv);
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b34616c..96d1e81 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.65 2006/12/11 18:54:11 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.66 2006/12/12 17:21:42 dgp Exp $
*/
#ifndef _TCLCOMPILATION
@@ -861,6 +861,12 @@ MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c
index 0ef70a1..9858c00 100644
--- a/generic/tclMathOp.c
+++ b/generic/tclMathOp.c
@@ -9,9 +9,17 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMathOp.c,v 1.7 2006/12/08 20:48:09 dgp Exp $
+ * RCS: @(#) $Id: tclMathOp.c,v 1.8 2006/12/12 17:21:42 dgp Exp $
*/
+/*
+ * NOTE: None of the routines in this file are currently in use.
+ * The file itself may be removed, but remains in place for now in
+ * case its routine may be useful during performance testing.
+ */
+
+#if 0
+
#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"
@@ -2865,6 +2873,7 @@ TclStreqOpCmd(
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
return TCL_OK;
}
+#endif
/*
* Local Variables: