diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 14 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 57 | ||||
| -rw-r--r-- | generic/tclCompile.h | 5 |
4 files changed, 73 insertions, 9 deletions
@@ -1,3 +1,9 @@ +2006-12-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Another step with all sorting operator commands + * generic/tclCompExpr.c: now routing through TEBC via + * generic/tclCompile.h: TclSortingOpCmd(). + 2006-12-08 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Another step down the path of re-using diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8c43737..9f21b3b 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.228 2006/12/08 20:48:08 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.229 2006/12/11 18:54:10 dgp Exp $ */ #include "tclInt.h" @@ -298,12 +298,12 @@ static const OpCmdInfo mathOpCmds[] = { { "ni", TclSingleOpCmd, TclCompileNiOpCmd, 2, "value list"}, { "-", TclMinusOpCmd, TclCompileMinusOpCmd, 0, NULL }, { "/", TclDivOpCmd, TclCompileDivOpCmd, 0, NULL }, - { "<", TclLessOpCmd, TclCompileLessOpCmd, 0, NULL }, - { "<=", TclLeqOpCmd, TclCompileLeqOpCmd, 0, NULL }, - { ">", TclGreaterOpCmd, TclCompileGreaterOpCmd, 0, NULL }, - { ">=", TclGeqOpCmd, TclCompileGeqOpCmd, 0, NULL }, - { "==", TclEqOpCmd, TclCompileEqOpCmd, 0, NULL }, - { "eq", TclStreqOpCmd, TclCompileStreqOpCmd, 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 } }; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 195f67e..e893390 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.42 2006/12/08 20:48:09 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.43 2006/12/11 18:54:11 dgp Exp $ */ #include "tclInt.h" @@ -2637,6 +2637,61 @@ TclSingleOpCmd( return OpCmd(interp, nodes, objv+1); } +int +TclSortingOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int code = TCL_OK; + + if (objc < 3) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } else { + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; + 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; + + ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), + &lexeme, NULL); + + litObjv[0] = objv[1]; + nodes[0].lexeme = START; + for (i=2; i<objc-1; i++) { + litObjv[2*(i-1)-1] = objv[i]; + nodes[2*(i-1)-1].lexeme = lexeme; + nodes[2*(i-1)-1].left = OT_LITERAL; + 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)].right = 2*(i-1)+1; + nodes[2*(i-1)+1].parent= 2*(i-1); + + lastBitAnd = 2*(i-1); + } + litObjv[2*(objc-2)-1] = objv[objc-1]; + + nodes[2*(objc-2)-1].lexeme = lexeme; + nodes[2*(objc-2)-1].left = OT_LITERAL; + nodes[2*(objc-2)-1].right = OT_LITERAL; + + nodes[0].right = lastBitAnd; + nodes[lastBitAnd].parent = 0; + + code = OpCmd(interp, nodes, litObjv); + + ckfree((char *) nodes); + ckfree((char *) litObjv); + } + return code; +} /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c864c3c..b34616c 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.64 2006/12/08 20:48:09 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.65 2006/12/11 18:54:11 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -858,6 +858,9 @@ MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, MODULE_SCOPE int TclSingleOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclSortingOpCmd(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); |