summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompExpr.c6
-rw-r--r--generic/tclCompile.c7
-rw-r--r--generic/tclCompile.h7
-rw-r--r--generic/tclExecute.c67
-rw-r--r--generic/tclParseExpr.c38
5 files changed, 114 insertions, 11 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 64d28aa..e25160d 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.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: tclCompExpr.c,v 1.24 2004/10/06 05:52:21 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.25 2004/10/08 15:39:52 dkf Exp $
*/
#include "tclInt.h"
@@ -91,6 +91,8 @@ typedef struct ExprInfo {
#define OP_STREQ 21
#define OP_STRNEQ 22
#define OP_EXPON 23
+#define OP_IN_LIST 24
+#define OP_NOT_IN_LIST 25
/*
* Table describing the expression operators. Entries in this table must
@@ -134,6 +136,8 @@ static OperatorDesc operatorTable[] = {
{"eq", 2, INST_STR_EQ},
{"ne", 2, INST_STR_NEQ},
{"**", 2, INST_EXPON},
+ {"in", 2, INST_LIST_IN},
+ {"ni", 2, INST_LIST_NOT_IN},
{NULL}
};
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d320a15..11383b7 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,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.c,v 1.77 2004/10/06 09:31:38 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.78 2004/10/08 15:39:52 dkf Exp $
*/
#include "tclInt.h"
@@ -295,6 +295,11 @@ InstructionDesc tclInstructionTable[] = {
{"startCommand", 5, 0, 1, {OPERAND_UINT4}},
/* Start of bytecoded command: op is the length of the cmd's code */
+
+ {"listIn", 1, -1, 0, {OPERAND_NONE}},
+ /* List containment: push [lsearch stktop stknext]>=0) */
+ {"listNotIn", 1, -1, 0, {OPERAND_NONE}},
+ /* List negated containment: push [lsearch stktop stknext]<0) */
{0}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4654d2b..2734b5f 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.48 2004/09/26 16:36:04 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.49 2004/10/08 15:39:53 dkf Exp $
*/
#ifndef _TCLCOMPILATION
@@ -544,8 +544,11 @@ typedef struct ByteCode {
#define INST_START_CMD 105
+#define INST_LIST_IN 106
+#define INST_LIST_NOT_IN 107
+
/* The last opcode */
-#define LAST_INST_OPCODE 105
+#define LAST_INST_OPCODE 107
/*
* Table describing the Tcl bytecode instructions: their name (for
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 65a57dd..60b9344 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.155 2004/10/06 20:09:37 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.156 2004/10/08 15:39:53 dkf Exp $
*/
#ifdef STDC_HEADERS
@@ -2913,6 +2913,71 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(9, 1, 1);
}
+ case INST_LIST_IN:
+ case INST_LIST_NOT_IN: {
+ /*
+ * Basic list containment operators.
+ */
+ int found, s1len, s2len, llen, i;
+ Tcl_Obj *valuePtr, *value2Ptr, *o;
+ char *s1, *s2;
+
+ value2Ptr = *tosPtr;
+ valuePtr = *(tosPtr - 1);
+
+ s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+ result = Tcl_ListObjLength(interp, value2Ptr, &llen);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
+ O2S(value2Ptr)), Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ found = 0;
+ if (llen > 0) {
+ /* An empty list doesn't match anything */
+ i = 0;
+ do {
+ Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+ if (o != NULL) {
+ s2 = Tcl_GetStringFromObj(o, &s2len);
+ } else {
+ s2 = "";
+ }
+ if (s1len == s2len) {
+ found = (strcmp(s1, s2) == 0);
+ }
+ i++;
+ } while (i < llen && found == 0);
+ }
+
+ if (*pc == INST_LIST_NOT_IN) {
+ found = !found;
+ }
+
+ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), found));
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump
+ * from here.
+ */
+
+ pc++;
+#ifndef TCL_COMPILE_DEBUG
+ switch (*pc) {
+ case INST_JUMP_FALSE1:
+ NEXT_INST_F((found ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE1:
+ NEXT_INST_F((found ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+ case INST_JUMP_FALSE4:
+ NEXT_INST_F((found ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE4:
+ NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ }
+#endif
+ objResultPtr = Tcl_NewBooleanObj(found);
+ NEXT_INST_F(0, 2, 1);
+ }
+
/*
* End of INST_LIST and related instructions.
* ---------------------------------------------------------
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 266466c..2a1c151 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.22 2004/10/04 13:56:37 dkf Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.23 2004/10/08 15:39:55 dkf Exp $
*/
#include "tclInt.h"
@@ -134,6 +134,13 @@ typedef struct ParseInfo {
#define EXPON 36
/*
+ * List containment operators
+ */
+
+#define IN_LIST 37
+#define NOT_IN_LIST 38
+
+/*
* Mapping from lexemes to strings; used for debugging messages. These
* entries must match the order and number of the lexeme definitions above.
*/
@@ -144,7 +151,7 @@ static char *lexemeStrings[] = {
"*", "/", "%", "+", "-",
"<<", ">>", "<", ">", "<=", ">=", "==", "!=",
"&", "^", "|", "&&", "||", "?", ":",
- "!", "~", "eq", "ne", "**"
+ "!", "~", "eq", "ne", "**", "in", "ni"
};
/*
@@ -747,8 +754,8 @@ ParseEqualityExpr(infoPtr)
}
lexeme = infoPtr->lexeme;
- while ((lexeme == EQUAL) || (lexeme == NEQ)
- || (lexeme == STREQ) || (lexeme == STRNEQ)) {
+ while (lexeme == EQUAL || lexeme == NEQ || lexeme == NOT_IN_LIST ||
+ lexeme == IN_LIST || lexeme == STREQ || lexeme == STRNEQ) {
operator = infoPtr->start;
code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne' */
if (code != TCL_OK) {
@@ -1857,7 +1864,7 @@ GetLexeme(infoPtr)
case 'e':
if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
+ (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
infoPtr->lexeme = STREQ;
infoPtr->size = 2;
infoPtr->next = src+2;
@@ -1869,12 +1876,31 @@ GetLexeme(infoPtr)
case 'n':
if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
+ (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
infoPtr->lexeme = STRNEQ;
infoPtr->size = 2;
infoPtr->next = src+2;
parsePtr->term = infoPtr->next;
return TCL_OK;
+ } else if ((src[1] == 'i') && ((infoPtr->lastChar - src) > 1) &&
+ (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
+ infoPtr->lexeme = NOT_IN_LIST;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+ } else {
+ goto checkFuncName;
+ }
+
+ case 'i':
+ if ((src[1] == 'n') && ((infoPtr->lastChar - src) > 1) &&
+ (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
+ infoPtr->lexeme = IN_LIST;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
} else {
goto checkFuncName;
}
generated by cgit v0.12 at 2024-11-06 00:30:29 (GMT)