summaryrefslogtreecommitdiffstats
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
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.
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCompExpr.c79
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclMathOp.c5
5 files changed, 72 insertions, 31 deletions
diff --git a/ChangeLog b/ChangeLog
index 82b90bf..77b92d6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2006-12-08 Don Porter <dgp@users.sourceforge.net>
+ * 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.
+
* generic/tclMathOp.c: More revisions to make tests pass.
* tests/mathop.test:
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;
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b5416cd..5dc9cd7 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.62 2006/11/28 22:20:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.63 2006/12/08 18:08:35 dgp Exp $
*/
#ifndef _TCLCOMPILATION
@@ -804,6 +804,8 @@ MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
int catchOnly, ByteCode* codePtr);
MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp,
+ ByteCode *codePtr);
MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int TclFindCompiledLocal(CONST char *name, int nameChars,
int create, int flags, Proc *procPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 86e1db2..f15f66e 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.257 2006/12/07 23:35:29 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.258 2006/12/08 18:08:36 dgp Exp $
*/
#include "tclInt.h"
@@ -349,8 +349,6 @@ static Tcl_ObjType dictIteratorType = {
* Declarations for local procedures to this file:
*/
-static int TclExecuteByteCode(Tcl_Interp *interp,
- ByteCode *codePtr);
#ifdef TCL_COMPILE_STATS
static int EvalStatsCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -1142,7 +1140,7 @@ TclIncrObj(
*----------------------------------------------------------------------
*/
-static int
+int
TclExecuteByteCode(
Tcl_Interp *interp, /* Token for command interpreter. */
ByteCode *codePtr) /* The bytecode sequence to interpret. */
diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c
index f4a5b53..f146a39 100644
--- a/generic/tclMathOp.c
+++ b/generic/tclMathOp.c
@@ -9,7 +9,7 @@
* 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.5 2006/12/08 16:14:17 dgp Exp $
+ * RCS: @(#) $Id: tclMathOp.c,v 1.6 2006/12/08 18:08:37 dgp Exp $
*/
#include "tclInt.h"
@@ -1047,7 +1047,7 @@ CompareNumbers(
*
*----------------------------------------------------------------------
*/
-
+#if 0
int
TclInvertOpCmd(
ClientData clientData,
@@ -1108,6 +1108,7 @@ TclInvertOpCmd(
}
}
}
+#endif
/*
*----------------------------------------------------------------------