diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 50 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 122 | ||||
| -rw-r--r-- | generic/tclCompile.h | 8 | ||||
| -rw-r--r-- | generic/tclMathOp.c | 11 |
5 files changed, 163 insertions, 35 deletions
@@ -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: |