Added listIn, listNotIn, and dictGet.

4 files changed, 118 insertions, 12 deletions

diff --git a/ChangeLog b/ChangeLog
index 2d19259..806f15c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,10 +1,18 @@
-2010-09-30  Kevin B, Kenny  <kennykb@acm.org>
+2010-10-01  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tests/assemble.test:
+	* generic/tclAssemble.h:
+	* generic/tclAssemble.c:  Added listIn, listNotIn, and dictGet.
+
+2010-09-30  Kevin B. Kenny  <kennykb@acm.org>
 
 	[dogeen-assembler-branch]
 
 	* tests/assemble.test:   Added tryCvtToNumeric and several more list
 	* generic/tclAssemble.c: operations.
-	* generic/tclAssemble.h: 
+	* generic/tclAssemble.h:
 
 2010-09-29  Kevin B. Kenny  <kennykb@acm.org>
 
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index cac051f..94b1ff8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -102,6 +102,7 @@ TalInstDesc TalInstructionTable[] = {
     {"bitor",   ASSEM_1BYTE ,   INST_BITOR  ,   2   ,   1},
     {"bitxor",  ASSEM_1BYTE ,   INST_BITXOR ,   2   ,   1},
     {"concat",	ASSEM_CONCAT1,	INST_CONCAT1,	INT_MIN,1},
+    {"dictGet", ASSEM_DICT_GET, INST_DICT_GET,  INT_MIN,1},
     {"div",     ASSEM_1BYTE,    INST_DIV,       2,      1},
     {"dup",     ASSEM_1BYTE ,   INST_DUP    ,   1   ,   2}, 
     {"eq",      ASSEM_1BYTE ,   INST_EQ     ,   2   ,   1},
@@ -179,6 +180,7 @@ TalInstDesc TalInstructionTable[] = {
      				INST_LIST_INDEX_MULTI,
      						INT_MIN,1},
     {"list",	ASSEM_LIST,	INST_LIST,	INT_MIN,1},
+    {"listIn",	ASSEM_1BYTE,	INST_LIST_IN,	2,	1},
     {"listIndex", 
      		ASSEM_1BYTE,    INST_LIST_INDEX,2,      1},
     {"listIndexImm",
@@ -187,6 +189,9 @@ TalInstDesc TalInstructionTable[] = {
     {"listLength",
                 ASSEM_1BYTE,    INST_LIST_LENGTH,
                                                 1,      1},
+    {"listNotIn",
+	        ASSEM_1BYTE,	INST_LIST_NOT_IN,
+						2,	1},
     {"load",    ASSEM_LVT,      (INST_LOAD_SCALAR1 << 8
 	                         | INST_LOAD_SCALAR4), 
                                                 0,      1}, 
@@ -335,7 +340,7 @@ BBUpdateStackReqs(BasicBlock* bbPtr,
 	consumed = count;
     }
     if (produced < 0) {
-	/* The instruction leaves some of its operations on the stack,
+	/* The instruction leaves some of its variadic operands on the stack,
 	 * with net stack effect of '-1-produced' */
 	produced = consumed - produced - 1;
     }
@@ -1015,6 +1020,18 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
 	BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd);
 	break;
 
+    case ASSEM_DICT_GET:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	break;
+
     case ASSEM_EVAL:
 	/* TODO - Refactor this stuff into a subroutine
 	 * that takes the inst code, the message ("script" or "expression")
diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h
index c950dd8..0c8cd61 100644
--- a/generic/tclAssembly.h
+++ b/generic/tclAssembly.h
@@ -48,6 +48,8 @@ typedef enum TalInstType {
     ASSEM_BOOL_LVT4,/* One Boolean, one 4-byte LVT ref. */
     ASSEM_CONCAT1,  /* 1-byte unsigned-integer operand count, must be 
 		     * strictly positive, consumes N, produces 1 */
+    ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 operands,
+		     * produces 1, N >= 0 */
     ASSEM_EVAL,	    /* 'eval' - evaluate a constant script (by compiling it
 		     * in line with the assembly code! I love Tcl!) */
     ASSEM_INDEX,    /* 4 byte operand, integer or end-integer */
diff --git a/tests/assemble.test b/tests/assemble.test
index bff1a84..e901e38 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -787,15 +787,7 @@ test assemble-7.39 {tryCvtToNumeric} {
     }
     -result 42
 }
-test assemble-7.43 {tryCvtToNumeric} {
-    -body {
-	assemble {
-	    push NaN; tryCvtToNumeric
-	}
-    }
-    -returnCodes error
-    -result {domain error: argument not in valid range}
-}
+
 test assemble-7.41 {uminus} {
     -body {
 	assemble {
@@ -823,6 +815,34 @@ test assemble-7.43 {uplus} {
     -result {can't use non-numeric floating-point value as operand of "+"}
 }
 
+test assemble-7.43 {tryCvtToNumeric} {
+    -body {
+	assemble {
+	    push NaN; tryCvtToNumeric
+	}
+    }
+    -returnCodes error
+    -result {domain error: argument not in valid range}
+}
+
+test assemble-7.44 {listIn} {
+    -body {
+	assemble {
+	    push b; push {a b c}; listIn
+	}
+    }
+    -result 1
+}
+
+test assemble-7.45 {listNotIn} {
+    -body {
+	assemble {
+	    push d; push {a b c}; listNotIn
+	}
+    }
+    -result 1
+}
+
 # assemble-8 ASSEM_LVT and FindLocalVar
 
 test assemble-8.1 {load, wrong # args} {
@@ -2563,6 +2583,65 @@ test assemble-24.12 {unsetArray} {
     -cleanup {rename x {}}
 }
 
+# assemble-25 - dict get
+
+test assemble-25.1 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-25.2 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-25.3 {dictGet - bad subst} {
+    -body {
+	assemble {dictGet $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-25.4 {dict get - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictGet rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-25.5 {dictGet - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictGet 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-25.6 {dictGet - 1 index} {
+    -body {
+	assemble {push {a 1 b 2}; push a; dictGet 1}
+    }
+    -result 1
+}
+
 test assemble-30.1 {unbalanced stack} {
     -body {
 	list \