summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-11-23 15:24:28 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-11-23 15:24:28 (GMT)
commite4b45ac4b9b3f4d8b9e0cc0533db0dac6e318e29 (patch)
tree358eebe231bbf90bb770a357ee2062fd138c802b /generic
parent0064927ddc659952debf26b8bc0ad9ee754cd27b (diff)
downloadtcl-e4b45ac4b9b3f4d8b9e0cc0533db0dac6e318e29.zip
tcl-e4b45ac4b9b3f4d8b9e0cc0533db0dac6e318e29.tar.gz
tcl-e4b45ac4b9b3f4d8b9e0cc0533db0dac6e318e29.tar.bz2
*Partial* implementation of TIP#174. Still needs non-compiled versions of most
operators, plus docs and tests.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c52
-rw-r--r--generic/tclCompCmds.c963
-rw-r--r--generic/tclInt.h118
3 files changed, 1129 insertions, 4 deletions
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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ; 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 ; words<parsePtr->numWords ;) {
+ 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 ; words<parsePtr->numWords ;) {
+ 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 ; words<parsePtr->numWords ;) {
+ 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 ; words<parsePtr->numWords ;) {
+ 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 ; words<parsePtr->numWords ;) {
+ 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 ; words<parsePtr->numWords ;) {
+ 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