summaryrefslogtreecommitdiffstats
path: root/generic/tclCompExpr.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-12-08 18:08:33 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-12-08 18:08:33 (GMT)
commitc31a5d22b7398ccaa6b9d0e17e4865563253b0f5 (patch)
treefb63e564b3c47e38440f42ab67e1d573b49d5a5e /generic/tclCompExpr.c
parent075c0449ce2a01114dcd419a912889ce694a35cc (diff)
downloadtcl-c31a5d22b7398ccaa6b9d0e17e4865563253b0f5.zip
tcl-c31a5d22b7398ccaa6b9d0e17e4865563253b0f5.tar.gz
tcl-c31a5d22b7398ccaa6b9d0e17e4865563253b0f5.tar.bz2
* generic/tclCompExpr.c: Revised implementation of TclInvertOpCmd
* generic/tclMathOp.c: to perform a bytecode compile / execute sequence. This demonstrates a path toward avoiding mountains of code duplication in tclMathOp.c and tclExecute.c. * generic/tclCompile.h: Change TclExecuteByteCode() from static to * generic/tclExecute.c: MODULE_SCOPE so all files including tclCompile.h may call it.
Diffstat (limited to 'generic/tclCompExpr.c')
-rw-r--r--generic/tclCompExpr.c79
1 files changed, 55 insertions, 24 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 90a6499..146c3c4 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.40 2006/12/04 22:33:28 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.41 2006/12/08 18:08:33 dgp Exp $
*/
#include "tclInt.h"
@@ -36,8 +36,6 @@ typedef struct ExprNode {
#endif
-#if !defined(USE_EXPR_TOKENS) || !defined(PARSE_DIRECT_EXPR_TOKENS)
-
/*
* Integer codes indicating the form of an operand of an operator.
*/
@@ -66,8 +64,6 @@ typedef struct OpNode {
int parent; /* Index of the operator of this operand node */
} OpNode;
-#endif
-
/*
* Set of lexeme codes stored in ExprNode structs to label and categorize
* the lexemes found.
@@ -2185,13 +2181,12 @@ static void CompileMathFuncCall(Tcl_Interp *interp,
static void CompileSubExpr(Tcl_Interp *interp,
Tcl_Token *exprTokenPtr, int *convertPtr,
CompileEnv *envPtr);
-#else
+#endif
static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
- Tcl_Obj *litList, Tcl_Obj *funcList,
+ Tcl_Obj *const litObjv[], Tcl_Obj *funcList,
Tcl_Token *tokenPtr, int *convertPtr,
CompileEnv *envPtr);
-#endif
/*
* Macro used to debug the execution of the expression compiler.
@@ -2248,14 +2243,16 @@ TclCompileExpr(
funcList, &parse);
if (code == TCL_OK) {
- int needsNumConversion = 1;
+ int litObjc, needsNumConversion = 1;
+ Tcl_Obj **litObjv;
/* TIP #280 : Track Lines within the expression */
TclAdvanceLines (&envPtr->line, script,
script+TclParseAllWhiteSpace(script, numBytes));
/* Valid parse; compile the tree */
- CompileExprTree(interp, opTree, litList, funcList, parse.tokenPtr,
+ Tcl_ListObjGetElements(NULL, litList, &litObjc, &litObjv);
+ CompileExprTree(interp, opTree, litObjv, funcList, parse.tokenPtr,
&needsNumConversion, envPtr);
if (needsNumConversion) {
/*
@@ -2331,7 +2328,6 @@ TclCompileExpr(
#endif
}
-#ifndef USE_EXPR_TOKENS
/*
*----------------------------------------------------------------------
@@ -2360,15 +2356,14 @@ static void
CompileExprTree(
Tcl_Interp *interp,
OpNode *nodes,
- Tcl_Obj *litList,
+ Tcl_Obj * const litObjv[],
Tcl_Obj *funcList,
Tcl_Token *tokenPtr,
int *convertPtr,
CompileEnv *envPtr)
{
OpNode *nodePtr = nodes;
- int nextLiteral = 0, nextFunc = 0;
- Tcl_Obj *literal;
+ int nextFunc = 0;
JumpList *jumpPtr = NULL;
static CONST int instruction[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -2413,9 +2408,8 @@ CompileExprTree(
break;
case OT_LITERAL:
/* TODO: reduce constant expressions */
- Tcl_ListObjIndex(NULL, litList, nextLiteral++, &literal);
- TclEmitPush(
- TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+ TclEmitPush( TclAddLiteralObj(
+ envPtr, *litObjv++, NULL), envPtr);
break;
case OT_TOKENS:
if (tokenPtr->type != TCL_TOKEN_WORD) {
@@ -2484,9 +2478,8 @@ CompileExprTree(
}
switch (left) {
case OT_LITERAL:
- Tcl_ListObjIndex(NULL, litList, nextLiteral++, &literal);
- TclEmitPush(
- TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+ TclEmitPush( TclAddLiteralObj(
+ envPtr, *litObjv++, NULL), envPtr);
break;
case OT_TOKENS:
if (tokenPtr->type != TCL_TOKEN_WORD) {
@@ -2521,9 +2514,8 @@ CompileExprTree(
}
switch (right) {
case OT_LITERAL:
- Tcl_ListObjIndex(NULL, litList, nextLiteral++, &literal);
- TclEmitPush(
- TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+ TclEmitPush( TclAddLiteralObj(
+ envPtr, *litObjv++, NULL), envPtr);
break;
case OT_TOKENS:
if (tokenPtr->type != TCL_TOKEN_WORD) {
@@ -2591,8 +2583,47 @@ CompileExprTree(
}
}
}
-#endif
+int
+TclInvertOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CompileEnv compEnv;
+ ByteCode *byteCodePtr;
+ OpNode nodes[2];
+ int code, tmp = 1;
+ Tcl_Obj *byteCodeObj;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "number");
+ return TCL_ERROR;
+ }
+
+ /* Note we are compiling an expression with literal arguments.
+ * This means there can be no [info frame] calls when we execute
+ * the resulting bytecode, so there's no need to tend to TIP 280 issues */
+ TclInitCompileEnv(interp, &compEnv, NULL, 0, NULL, 0);
+
+ nodes[0].lexeme = START;
+ nodes[0].right = 1;
+ nodes[1].lexeme = BIT_NOT;
+ nodes[1].right = OT_LITERAL;
+ nodes[1].parent = 0;
+
+ CompileExprTree(interp, nodes, objv+1, NULL, NULL, &tmp, &compEnv);
+ TclEmitOpcode(INST_DONE, &compEnv);
+ byteCodeObj = Tcl_NewObj();
+ Tcl_IncrRefCount(byteCodeObj);
+ TclInitByteCodeObj(byteCodeObj, &compEnv);
+ TclFreeCompileEnv(&compEnv);
+ byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
+ code = TclExecuteByteCode(interp, byteCodePtr);
+ Tcl_DecrRefCount(byteCodeObj);
+ return code;
+}
/*
*----------------------------------------------------------------------