summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c89
-rw-r--r--generic/tclCompExpr.c60
-rw-r--r--generic/tclCompile.h15
-rw-r--r--generic/tclMathOp.c5
4 files changed, 110 insertions, 59 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index bef8f10..8c43737 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.227 2006/12/07 16:29:31 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.228 2006/12/08 20:48:08 dgp Exp $
*/
#include "tclInt.h"
@@ -53,6 +53,7 @@ static char * CallCommandTraces (Interp *iPtr, Command *cmdPtr,
CONST char *oldName, CONST char* newName, int flags);
static int CheckDoubleResult (Tcl_Interp *interp, double dResult);
static void DeleteInterpProc (Tcl_Interp *interp);
+static void DeleteOpCmdClientData(ClientData clientData);
static void ProcessUnexpectedResult (Tcl_Interp *interp, int returnCode);
static int OldMathFuncProc (ClientData clientData, Tcl_Interp *interp,
@@ -270,31 +271,40 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
* TIP#174's math operators.
*/
-static const CmdInfo mathOpCmds[] = {
- { "~", TclInvertOpCmd, TclCompileInvertOpCmd, 1 },
- { "!", TclNotOpCmd, TclCompileNotOpCmd, 1 },
- { "+", TclAddOpCmd, TclCompileAddOpCmd, 1 },
- { "*", TclMulOpCmd, TclCompileMulOpCmd, 1 },
- { "&", TclAndOpCmd, TclCompileAndOpCmd, 1 },
- { "|", TclOrOpCmd, TclCompileOrOpCmd, 1 },
- { "^", TclXorOpCmd, TclCompileXorOpCmd, 1 },
- { "**", TclPowOpCmd, TclCompilePowOpCmd, 1 },
- { "<<", TclLshiftOpCmd, TclCompileLshiftOpCmd, 1 },
- { ">>", TclRshiftOpCmd, TclCompileRshiftOpCmd, 1 },
- { "%", TclModOpCmd, TclCompileModOpCmd, 1 },
- { "!=", TclNeqOpCmd, TclCompileNeqOpCmd, 1 },
- { "ne", TclStrneqOpCmd, TclCompileStrneqOpCmd, 1 },
- { "in", TclInOpCmd, TclCompileInOpCmd, 1 },
- { "ni", TclNiOpCmd, TclCompileNiOpCmd, 1 },
- { "-", TclMinusOpCmd, TclCompileMinusOpCmd, 1 },
- { "/", TclDivOpCmd, TclCompileDivOpCmd, 1 },
- { "<", TclLessOpCmd, TclCompileLessOpCmd, 1 },
- { "<=", TclLeqOpCmd, TclCompileLeqOpCmd, 1 },
- { ">", TclGreaterOpCmd, TclCompileGreaterOpCmd, 1 },
- { ">=", TclGeqOpCmd, TclCompileGeqOpCmd, 1 },
- { "==", TclEqOpCmd, TclCompileEqOpCmd, 1 },
- { "eq", TclStreqOpCmd, TclCompileStreqOpCmd, 1 },
- { NULL, NULL, NULL, 0 }
+typedef struct {
+ const char *name; /* Name of object-based command. */
+ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
+ CompileProc *compileProc; /* Function called to compile command. */
+ int numArgs;
+ const char *expected; /* For error message, what argument(s)
+ * were expected. */
+} 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 },
+ { "<", 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 },
+ { NULL, NULL, NULL, 0, NULL }
};
/*
@@ -322,6 +332,7 @@ Tcl_CreateInterp(void)
Tcl_Interp *interp;
Command *cmdPtr;
const BuiltinFuncDef *builtinFuncPtr;
+ const OpCmdInfo *opcmdInfoPtr;
const CmdInfo *cmdInfoPtr;
const CmdInfo2 *cmdInfo2Ptr;
Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
@@ -633,14 +644,20 @@ Tcl_CreateInterp(void)
}
(void) Tcl_Export(interp, mathopNSPtr, "*", 1);
strcpy(mathFuncName, "::tcl::mathop::");
- for (cmdInfoPtr=mathOpCmds ; cmdInfoPtr->name!=NULL ; cmdInfoPtr++) {
- strcpy(mathFuncName + MATH_OP_PREFIX_LEN, cmdInfoPtr->name);
+ for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++) {
+ TclOpCmdClientData *occdPtr
+ = (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData));
+ occdPtr->operator = opcmdInfoPtr->name;
+ occdPtr->numArgs = opcmdInfoPtr->numArgs;
+ occdPtr->expected = opcmdInfoPtr->expected;
+ strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
- cmdInfoPtr->objProc, NULL, NULL);
+ opcmdInfoPtr->objProc, (ClientData) occdPtr,
+ DeleteOpCmdClientData);
if (cmdPtr == NULL) {
- Tcl_Panic("failed to create math operator %s", cmdInfoPtr->name);
- } else if (cmdInfoPtr->compileProc != NULL) {
- cmdPtr->compileProc = cmdInfoPtr->compileProc;
+ Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name);
+ } else if (opcmdInfoPtr->compileProc != NULL) {
+ cmdPtr->compileProc = opcmdInfoPtr->compileProc;
}
}
@@ -717,6 +734,14 @@ Tcl_CreateInterp(void)
return interp;
}
+
+static void
+DeleteOpCmdClientData(
+ ClientData clientData)
+{
+ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+ ckfree((char *)occdPtr);
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 146c3c4..195f67e 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.41 2006/12/08 18:08:33 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.42 2006/12/08 20:48:09 dgp Exp $
*/
#include "tclInt.h"
@@ -2584,38 +2584,23 @@ CompileExprTree(
}
}
-int
-TclInvertOpCmd(
- ClientData clientData,
+static int
+OpCmd(
Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
+ OpNode *nodes,
+ Tcl_Obj * const litObjv[])
{
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;
- }
+ int code, tmp=1;
+ Tcl_Obj *byteCodeObj = Tcl_NewObj();
/* 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);
+ CompileExprTree(interp, nodes, litObjv, NULL, NULL, &tmp, &compEnv);
TclEmitOpcode(INST_DONE, &compEnv);
- byteCodeObj = Tcl_NewObj();
Tcl_IncrRefCount(byteCodeObj);
TclInitByteCodeObj(byteCodeObj, &compEnv);
TclFreeCompileEnv(&compEnv);
@@ -2624,6 +2609,35 @@ TclInvertOpCmd(
Tcl_DecrRefCount(byteCodeObj);
return code;
}
+
+int
+TclSingleOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+ unsigned char lexeme;
+ OpNode nodes[2];
+
+ if (objc != 1+occdPtr->numArgs) {
+ Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+ return TCL_ERROR;
+ }
+
+ ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL);
+ 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;
+
+ return OpCmd(interp, nodes, objv+1);
+}
+
+
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5dc9cd7..c864c3c 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.63 2006/12/08 18:08:35 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.64 2006/12/08 20:48:09 dgp Exp $
*/
#ifndef _TCLCOMPILATION
@@ -746,6 +746,16 @@ typedef struct JumptableInfo {
} JumptableInfo;
MODULE_SCOPE AuxDataType tclJumptableInfoType;
+
+/*
+ * ClientData type used by the math operator commands.
+ */
+typedef struct {
+ const char *operator;
+ const char *expected;
+ int numArgs;
+} TclOpCmdClientData;
+
/*
*----------------------------------------------------------------
@@ -845,6 +855,9 @@ MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Command *cmdPtr);
+MODULE_SCOPE int TclSingleOpCmd(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 f146a39..0ef70a1 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.6 2006/12/08 18:08:37 dgp Exp $
+ * RCS: @(#) $Id: tclMathOp.c,v 1.7 2006/12/08 20:48:09 dgp Exp $
*/
#include "tclInt.h"
@@ -1047,7 +1047,7 @@ CompareNumbers(
*
*----------------------------------------------------------------------
*/
-#if 0
+
int
TclInvertOpCmd(
ClientData clientData,
@@ -1108,7 +1108,6 @@ TclInvertOpCmd(
}
}
}
-#endif
/*
*----------------------------------------------------------------------
generated by cgit v0.12 at 2024-12-29 09:53:37 (GMT)