* generic/tclAssembly.c:

* generic/tclAssembly.h:
* tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
dictSet, dictUnset, nsupvar, upvar, and variable. (Still need tests
for the last three.)
Merged changes from HEAD.

4 files changed, 129 insertions, 15 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 94b1ff8..8232551 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -102,7 +102,21 @@ TalInstDesc TalInstructionTable[] = {
     {"bitor",   ASSEM_1BYTE ,   INST_BITOR  ,   2   ,   1},
     {"bitxor",  ASSEM_1BYTE ,   INST_BITXOR ,   2   ,   1},
     {"concat",	ASSEM_CONCAT1,	INST_CONCAT1,	INT_MIN,1},
+    {"dictAppend",
+     		ASSEM_LVT4,	INST_DICT_APPEND,
+     						2,      1},
     {"dictGet", ASSEM_DICT_GET, INST_DICT_GET,  INT_MIN,1},
+    {"dictIncrImm",
+                ASSEM_SINT4_LVT4,
+     				INST_DICT_INCR_IMM,
+						1,	1},
+    {"dictLappend",
+     		ASSEM_LVT4,	INST_DICT_LAPPEND,
+     						2,      1},
+    {"dictSet", ASSEM_DICT_SET, INST_DICT_SET,	INT_MIN,1},
+    {"dictUnset",
+		ASSEM_DICT_UNSET,
+     				INST_DICT_UNSET,INT_MIN,1},
     {"div",     ASSEM_1BYTE,    INST_DIV,       2,      1},
     {"dup",     ASSEM_1BYTE ,   INST_DUP    ,   1   ,   2}, 
     {"eq",      ASSEM_1BYTE ,   INST_EQ     ,   2   ,   1},
@@ -215,6 +229,7 @@ TalInstDesc TalInstructionTable[] = {
     {"mult",    ASSEM_1BYTE ,   INST_MULT   ,   2   ,   1},
     {"neq",     ASSEM_1BYTE ,   INST_NEQ    ,   2   ,   1},
     {"not",     ASSEM_1BYTE,    INST_LNOT,      1,      1},
+    {"nsupvar",	ASSEM_LVT4,	INST_NSUPVAR,	2,	1}.
     {"over",    ASSEM_OVER,     INST_OVER,      INT_MIN, -1-1},
     {"pop",     ASSEM_1BYTE ,   INST_POP    ,   1   ,   0},
     {"reverse", ASSEM_REVERSE,  INST_REVERSE,   INT_MIN, -1-0},
@@ -258,6 +273,8 @@ TalInstDesc TalInstructionTable[] = {
     {"unsetStk",
 		ASSEM_BOOL,	INST_UNSET_STK,	1,	0},
     {"uplus",   ASSEM_1BYTE,    INST_UPLUS,     1,      1},
+    {"upvar",	ASSEM_LVT4,	INST_UPVAR,	2,	1}.
+    {"variable",ASSEM_LVT4,	INST_VARIABLE,	2,	1}.
     {NULL, 0, 0,0}
 };
 
@@ -1032,6 +1049,34 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
 	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
 	break;
 
+    case ASSEM_DICT_SET:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
+    case ASSEM_DICT_UNSET:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
     case ASSEM_EVAL:
 	/* TODO - Refactor this stuff into a subroutine
 	 * that takes the inst code, the message ("script" or "expression")
@@ -1287,6 +1332,19 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
 	BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
 	break;
 
+    case ASSEM_SINT4_LVT4:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
     default:
 	Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
 		  Tcl_GetString(instNameObj));
diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h
index 0c8cd61..7f1a36e 100644
--- a/generic/tclAssembly.h
+++ b/generic/tclAssembly.h
@@ -49,7 +49,12 @@ typedef enum TalInstType {
     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 */
+		     * produces 1, N > 0 */
+    ASSEM_DICT_SET, /* specifies key count and LVT index, consumes N+1 operands,
+		     * produces 1, N > 0 */
+    ASSEM_DICT_UNSET,
+		    /* specifies key count and LVT index, consumes N 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 */
@@ -74,6 +79,9 @@ typedef enum TalInstType {
     ASSEM_PUSH,     /* one literal operand */
     ASSEM_REVERSE,  /* REVERSE: 4-byte operand count, consumes N, produces N */
     ASSEM_SINT1,    /* One 1-byte signed-integer operand (INCR_STK_IMM) */
+    ASSEM_SINT4_LVT4,
+                    /* Signed 4-byte integer operand followed by LVT entry. 
+		     * Fixed arity */
 } TalInstType;
 
 /* Description of an instruction recognized by the assembler. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6f3701c..3f7c420 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,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.494.2.4 2010/10/02 01:38:27 kennykb Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.494.2.5 2010/10/02 16:04:29 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -5768,6 +5768,16 @@ TEBCresume(
 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
 	    } else {
 		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
+
+		/*
+		 * Must invalidate the string representation of dictionary
+		 * here because we have directly updated the internal
+		 * representation; if we don't, callers could see the wrong
+		 * string rep despite the internal version of the dictionary
+		 * having the correct value. [Bug 3079830]
+		 */
+
+		TclInvalidateStringRep(dictPtr);
 	    }
 	    break;
 	case INST_DICT_LAPPEND:
@@ -5798,6 +5808,16 @@ TEBCresume(
 		    }
 		    goto gotError;
 		}
+
+		/*
+		 * Must invalidate the string representation of dictionary
+		 * here because we have directly updated the internal
+		 * representation; if we don't, callers could see the wrong
+		 * string rep despite the internal version of the dictionary
+		 * having the correct value. [Bug 3079830]
+		 */
+
+		TclInvalidateStringRep(dictPtr);
 	    }
 	    break;
 	default:
@@ -6021,6 +6041,9 @@ TEBCresume(
 	if (allocdict) {
 	    dictPtr = Tcl_DuplicateObj(dictPtr);
 	}
+	if (length > 0) {
+	    TclInvalidateStringRep(dictPtr);
+	}
 	for (i=0 ; i<length ; i++) {
 	    Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 24a29a5..3161a46 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.174.2.2 2010/10/01 13:34:09 kennykb Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.174.2.3 2010/10/02 16:04:29 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -55,9 +55,9 @@ char *tclEmptyStringRep = &tclEmptyString;
 
 #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
 /*
- * Structure for tracking the source file and line number where a given Tcl_Obj
- * was allocated.  We also track the pointer to the Tcl_Obj itself, for sanity
- * checking purposes.
+ * Structure for tracking the source file and line number where a given
+ * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
+ * for sanity checking purposes.
  */
 
 typedef struct ObjData {
@@ -1486,7 +1486,7 @@ TclFreeObj(
 	}
     }
 }
-#endif
+#endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------------
@@ -1512,7 +1512,6 @@ TclObjBeingDeleted(
 {
     return (objPtr->length == -1);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -1706,7 +1705,6 @@ Tcl_InvalidateStringRep(
 {
     TclInvalidateStringRep(objPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -3259,7 +3257,7 @@ UpdateStringOfBignum(
 	Tcl_Panic("conversion failure in UpdateStringOfBignum");
     }
     objPtr->bytes = stringVal;
-    objPtr->length = size - 1;	/* size includes a trailing null byte */
+    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
 }
 
 /*
@@ -3566,6 +3564,24 @@ Tcl_SetBignumObj(
     TclSetBignumIntRep(objPtr, bignumValue);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetBignumIntRep --
+ *
+ *	Install a bignum into the internal representation of an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Object internal representation is updated and object type is set. The
+ *	bignum value is cleared, since ownership has transferred to the
+ *	object.
+ *
+ *----------------------------------------------------------------------
+ */
+
 void
 TclSetBignumIntRep(
     Tcl_Obj *objPtr,
@@ -3576,8 +3592,9 @@ TclSetBignumIntRep(
 
     /*
      * Clear the mp_int value.
-     * Don't call mp_clear() because it would free the digit array
-     * we just packed into the Tcl_Obj.
+     *
+     * Don't call mp_clear() because it would free the digit array we just
+     * packed into the Tcl_Obj.
      */
 
     bignumValue->dp = NULL;
@@ -3590,9 +3607,17 @@ TclSetBignumIntRep(
  *
  * TclGetNumberFromObj --
  *
+ *      Extracts a number (of any possible numeric type) from an object.
+ *
  * Results:
+ *      Whether the extraction worked. The type is stored in the variable
+ *      referred to by the typePtr argument, and a pointer to the
+ *      representation is stored in the variable referred to by the
+ *      clientDataPtr.
  *
  * Side effects:
+ *      Can allocate thread-specific data for handling the copy-out space for
+ *      bignums; this space is shared within a thread.
  *
  *----------------------------------------------------------------------
  */
@@ -3611,18 +3636,18 @@ TclGetNumberFromObj(
 	    } else {
 		*typePtr = TCL_NUMBER_DOUBLE;
 	    }
-	    *clientDataPtr = &(objPtr->internalRep.doubleValue);
+	    *clientDataPtr = &objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclIntType) {
 	    *typePtr = TCL_NUMBER_LONG;
-	    *clientDataPtr = &(objPtr->internalRep.longValue);
+	    *clientDataPtr = &objPtr->internalRep.longValue;
 	    return TCL_OK;
 	}
 #ifndef NO_WIDE_TYPE
 	if (objPtr->typePtr == &tclWideIntType) {
 	    *typePtr = TCL_NUMBER_WIDE;
-	    *clientDataPtr = &(objPtr->internalRep.wideValue);
+	    *clientDataPtr = &objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
 #endif