* 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.


FossilOrigin-Name: cac128331f0b0adc9622285f7caf53a41489232c

4 files changed, 63 insertions, 31 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;
+}
 
 /*
  *----------------------------------------------------------------------
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
 
 /*
  *----------------------------------------------------------------------