From e4b45ac4b9b3f4d8b9e0cc0533db0dac6e318e29 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 23 Nov 2006 15:24:28 +0000 Subject: *Partial* implementation of TIP#174. Still needs non-compiled versions of most operators, plus docs and tests. --- ChangeLog | 6 + generic/tclBasic.c | 52 ++- generic/tclCompCmds.c | 963 +++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclInt.h | 118 ++++++- 4 files changed, 1135 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2f31d32..77ce434 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2006-11-23 Donal K. Fellows + + * generic/tclCompCmds.c (Tcl*OpCmd, TclCompile*OpCmd): + * generic/tclBasic.c (Tcl_CreateInterp): Partial implementation of + TIP#174; the commands are compiled, but (mostly) not interpreted yet. + 2006-11-22 Donal K. Fellows TIP#269 IMPLEMENTATION diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a817bd9..127620d 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.219 2006/11/20 14:28:02 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.220 2006/11/23 15:24:28 dkf Exp $ */ #include "tclInt.h" @@ -87,7 +87,7 @@ extern TclStubs tclStubs; */ typedef struct { - char *name; /* Name of object-based command. */ + const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ int isSafe; /* If non-zero, command will be present in @@ -251,6 +251,37 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } }; + +/* + * TIP#174's math operators. + */ + +static const CmdInfo mathOpCmds[] = { + { "::tcl::mathop::~", TclInvertOpCmd, TclCompileInvertOpCmd, 1 }, + { "::tcl::mathop::!", TclNotOpCmd, TclCompileNotOpCmd, 1 }, + { "::tcl::mathop::+", TclAddOpCmd, TclCompileAddOpCmd, 1 }, + { "::tcl::mathop::*", TclMulOpCmd, TclCompileMulOpCmd, 1 }, + { "::tcl::mathop::&", TclAndOpCmd, TclCompileAndOpCmd, 1 }, + { "::tcl::mathop::|", TclOrOpCmd, TclCompileOrOpCmd, 1 }, + { "::tcl::mathop::^", TclXorOpCmd, TclCompileXorOpCmd, 1 }, + { "::tcl::mathop::**", TclPowOpCmd, TclCompilePowOpCmd, 1 }, + { "::tcl::mathop::<<", TclLshiftOpCmd, TclCompileLshiftOpCmd, 1 }, + { "::tcl::mathop::>>", TclRshiftOpCmd, TclCompileRshiftOpCmd, 1 }, + { "::tcl::mathop::%", TclModOpCmd, TclCompileModOpCmd, 1 }, + { "::tcl::mathop::!=", TclNeqOpCmd, TclCompileNeqOpCmd, 1 }, + { "::tcl::mathop::ne", TclStrneqOpCmd, TclCompileStrneqOpCmd, 1 }, + { "::tcl::mathop::in", TclInOpCmd, TclCompileInOpCmd, 1 }, + { "::tcl::mathop::ni", TclNiOpCmd, TclCompileNiOpCmd, 1 }, + { "::tcl::mathop::-", TclMinusOpCmd, TclCompileMinusOpCmd, 1 }, + { "::tcl::mathop::/", TclDivOpCmd, TclCompileDivOpCmd, 1 }, + { "::tcl::mathop::<", TclLessOpCmd, TclCompileLessOpCmd, 1 }, + { "::tcl::mathop::<=", TclLeqOpCmd, TclCompileLeqOpCmd, 1 }, + { "::tcl::mathop::>", TclGreaterOpCmd,TclCompileGreaterOpCmd,1 }, + { "::tcl::mathop::>=", TclGeqOpCmd, TclCompileGeqOpCmd, 1 }, + { "::tcl::mathop::==", TclEqOpCmd, TclCompileEqOpCmd, 1 }, + { "::tcl::mathop::eq", TclStreqOpCmd, TclCompileStreqOpCmd, 1 }, + { NULL, NULL, NULL, 0 } +}; /* *---------------------------------------------------------------------- @@ -563,6 +594,23 @@ Tcl_CreateInterp(void) } /* + * Register the mathematical "operator" commands. [TIP #174] + */ + + if (Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL) == NULL) { + Tcl_Panic("can't create math operator namespace"); + } + for (cmdInfoPtr=mathOpCmds ; cmdInfoPtr->name!=NULL ; cmdInfoPtr++) { + cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdInfoPtr->name, + cmdInfoPtr->objProc, NULL, NULL); + if (cmdPtr == NULL) { + Tcl_Panic("failed to create math operator %s", cmdInfoPtr->name); + } else if (cmdInfoPtr->compileProc != NULL) { + cmdPtr->compileProc = cmdInfoPtr->compileProc; + } + } + + /* * Do Multiple/Safe Interps Tcl init stuff */ diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index d3a2c9f..3c89ec5 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,11 +12,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.85 2006/11/08 13:47:07 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.86 2006/11/23 15:24:29 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" +#include "tommath.h" /* * Macro that encapsulates an efficiency trick that avoids a function call for @@ -4443,6 +4444,966 @@ PushVarName( return TCL_OK; } +int +TclInvertOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + ClientData val; + int type; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "number"); + return TCL_ERROR; + } + if (TclGetNumberFromObj(interp, objv[1], &val, &type) != TCL_OK) { + return TCL_ERROR; + } + switch (type) { + case TCL_NUMBER_LONG: { + long l = *((const long *) val); + + Tcl_SetLongObj(Tcl_GetObjResult(interp), ~l); + return TCL_OK; + } +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: { + Tcl_WideInt w = *((const Tcl_WideInt *) val); + + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), ~w); + return TCL_OK; + } +#endif + default: { + mp_int big; + + if (Tcl_IsShared(objv[1])) { + Tcl_GetBignumFromObj(NULL, objv[1], &big); + } else { + Tcl_GetBignumAndClearObj(NULL, objv[1], &big); + } + /* ~a = - a - 1 */ + mp_neg(&big, &big); + mp_sub_d(&big, 1, &big); + if (Tcl_IsShared(objv[1])) { + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); + } else { + Tcl_SetBignumObj(objv[1], &big); + Tcl_SetObjResult(interp, objv[1]); + } + return TCL_OK; + } + } +} + +int +TclCompileInvertOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_BITNOT, envPtr); + return TCL_OK; +} + +int +TclNotOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int b; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "boolean"); + return TCL_ERROR; + } + if (Tcl_GetBooleanFromObj(interp, objv[1], &b) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), !b); + return TCL_OK; +} + +int +TclCompileNotOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LNOT, envPtr); + return TCL_OK; +} + +int +TclAddOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileAddOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "0", 1); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_ADD, envPtr); + } + return TCL_OK; +} + +int +TclMulOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileMulOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "1", 1); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_MULT, envPtr); + } + return TCL_OK; +} + +int +TclAndOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileAndOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "-1", 2); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_BITAND, envPtr); + } + return TCL_OK; +} + +int +TclOrOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileOrOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "0", 1); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_BITOR, envPtr); + } + return TCL_OK; +} + +int +TclXorOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileXorOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "0", 1); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_BITXOR, envPtr); + } + return TCL_OK; +} + +int +TclPowOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompilePowOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + PushLiteral(envPtr, "1", 1); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + } + for (; words>2 ; words--) { + TclEmitOpcode(INST_EXPON, envPtr); + } + return TCL_OK; +} + +int +TclMinusOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileMinusOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (parsePtr->numWords == 2) { + TclEmitOpcode(INST_UMINUS, envPtr); + return TCL_OK; + } + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_SUB, envPtr); + } + return TCL_OK; +} + +int +TclDivOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileDivOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + int words; + + if (parsePtr->numWords == 1) { + return TCL_ERROR; + } else if (parsePtr->numWords == 2) { + PushLiteral(envPtr, "1", 1); + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_DIV, envPtr); + return TCL_OK; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + for (words=2 ; wordsnumWords ; words++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_DIV, envPtr); + } + return TCL_OK; +} + +int +TclLshiftOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileLshiftOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LSHIFT, envPtr); + return TCL_OK; +} + +int +TclRshiftOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileRshiftOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_RSHIFT, envPtr); + return TCL_OK; +} + +int +TclModOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileModOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_MOD, envPtr); + return TCL_OK; +} + +int +TclNeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileNeqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_NEQ, envPtr); + return TCL_OK; +} + +int +TclStrneqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileStrneqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_STR_NEQ, envPtr); + return TCL_OK; +} + +int +TclInOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileInOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LIST_IN, envPtr); + return TCL_OK; +} + +int +TclNiOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileNiOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LIST_NOT_IN, envPtr); + return TCL_OK; +} + +int +TclLessOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileLessOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LT, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_LT, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_LT, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + +int +TclLeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileLeqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LE, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_LE, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_LE, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + +int +TclGreaterOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileGreaterOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_GT, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_GT, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_GT, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + +int +TclGeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileGeqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_GE, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_GE, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_GE, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + +int +TclEqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileEqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_EQ, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_EQ, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_EQ, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + +int +TclStreqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_AppendResult(interp, "not yet implemented", NULL); + return TCL_ERROR; +} + +int +TclCompileStreqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords < 3) { + PushLiteral(envPtr, "1", 1); + } else if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_STR_EQ, envPtr); + } else if (envPtr->procPtr == NULL) { + /* + * No local variable space! + */ + + return TCL_ERROR; + } else { + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, + envPtr->procPtr); + int words; + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + TclEmitOpcode(INST_STR_EQ, envPtr); + for (words=3 ; wordsnumWords ;) { + TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + if (++words < parsePtr->numWords) { + TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); + } + TclEmitOpcode(INST_STR_EQ, envPtr); + } + for (; words>3 ; words--) { + TclEmitOpcode(INST_BITAND, envPtr); + } + } + return TCL_OK; +} + /* * Local Variables: * mode: c diff --git a/generic/tclInt.h b/generic/tclInt.h index c65fd21..116846a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.297 2006/11/22 19:43:19 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.298 2006/11/23 15:24:29 dkf Exp $ */ #ifndef _TCLINT @@ -2605,6 +2605,122 @@ MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclNotOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclAddOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclMulOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclAndOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclOrOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclXorOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclPowOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclModOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclInOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclNiOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclDivOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclLessOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclEqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + /* * Functions defined in generic/tclVar.c and currenttly exported only for use * by the bytecode compiler and engine. Some of these could later be placed in -- cgit v0.12