diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 79 | ||||
| -rw-r--r-- | generic/tclCompile.h | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 6 | ||||
| -rw-r--r-- | generic/tclMathOp.c | 5 |
5 files changed, 72 insertions, 31 deletions
@@ -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 /* *---------------------------------------------------------------------- |