Added a scheme to allow aux-data to be printed out for debugging. For this to work, immediate operands referring to aux-data must be identified as such in the instruction descriptor table using OPERAND_AUX4 (all are always 4 bytes).

Rewrote the compiled [dict update] so that it stores critical non-varying data in an aux-data value instead of a (shimmerable) literal. [Bug 1671001]

6 files changed, 304 insertions, 73 deletions

diff --git a/ChangeLog b/ChangeLog
index a1ff2e7..20836aa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2007-03-02  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>
+
+	* generic/tclCompile.c (TclPrintInstruction): Added a scheme to allow
+	* generic/tclCompile.h (AuxDataPrintProc):    aux-data to be printed
+	* generic/tclCompCmds.c (Print*Info):	      out for debugging. For
+	this to work, immediate operands referring to aux-data must be
+	identified as such in the instruction descriptor table using
+	OPERAND_AUX4 (all are always 4 bytes).
+
+	* generic/tclExecute.c (TclExecuteByteCode): Rewrote the compiled
+	* generic/tclCompCmds.c (TclCompileDictCmd): [dict update] so that it
+	* generic/tclCompile.h (DictUpdateInfo):     stores critical
+	* tests/dict.test (dict-21.{14,15}):	     non-varying data in an
+	aux-data value instead of a (shimmerable) literal.
+
 2007-03-01  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCmdIL.c (Tcl_LinsertObjCmd):	Code simplifications
@@ -15,7 +30,7 @@
 
 	* generic/tclCmdIL.c (Tcl_LassignObjCmd):	Rewrite to make an
 	efficient private copy of the list argument, so we can operate on the
-	list elements directly with no fear of shimmering effects.  Replaces
+	list elements directly with no fear of shimmering effects. Replaces
 	defensive coding schemes that are otherwise required.
 
 	* generic/tclCmdAH.c (Tcl_ForeachObjCmd):	Rewrite to make
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c0721fa..8ceb0b9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.101 2007/03/01 10:07:12 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.102 2007/03/02 10:32:11 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -128,10 +128,18 @@
  * Prototypes for procedures defined later in this file:
  */
 
+static ClientData	DupDictUpdateInfo(ClientData clientData);
+static void		FreeDictUpdateInfo(ClientData clientData);
+static void		PrintDictUpdateInfo(ClientData clientData,
+			    ByteCode *codePtr, unsigned int pcOffset);
 static ClientData	DupForeachInfo(ClientData clientData);
 static void		FreeForeachInfo(ClientData clientData);
+static void		PrintForeachInfo(ClientData clientData,
+			    ByteCode *codePtr, unsigned int pcOffset);
 static ClientData	DupJumptableInfo(ClientData clientData);
 static void		FreeJumptableInfo(ClientData clientData);
+static void		PrintJumptableInfo(ClientData clientData,
+			    ByteCode *codePtr, unsigned int pcOffset);
 static int		PushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
@@ -163,13 +171,22 @@ static int		CompileUnaryOpCmd(Tcl_Interp *interp,
 AuxDataType tclForeachInfoType = {
     "ForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
-    FreeForeachInfo		/* freeProc */
+    FreeForeachInfo,		/* freeProc */
+    PrintForeachInfo		/* printProc */
 };
 
 AuxDataType tclJumptableInfoType = {
     "JumptableInfo",		/* name */
     DupJumptableInfo,		/* dupProc */
-    FreeJumptableInfo		/* freeProc */
+    FreeJumptableInfo,		/* freeProc */
+    PrintJumptableInfo		/* printProc */
+};
+
+AuxDataType tclDictUpdateInfoType = {
+    "DictUpdateInfo",		/* name */
+    DupDictUpdateInfo,		/* dupProc */
+    FreeDictUpdateInfo,		/* freeProc */
+    PrintDictUpdateInfo		/* printProc */
 };
 
 /*
@@ -890,9 +907,9 @@ TclCompileDictCmd(
 	return TCL_OK;
     } else if (size==6 && strncmp(cmd, "update", 6)==0) {
 	const char *name;
-	int nameChars, dictIndex, keyTmpIndex, numVars, range;
+	int nameChars, dictIndex, keyTmpIndex, numVars, range, infoIndex;
 	Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr;
-	Tcl_DString localVarsLiteral;
+	DictUpdateInfo *duiPtr;
 
 	/*
 	 * Parse the command. Expect the following:
@@ -915,35 +932,32 @@ TclCompileDictCmd(
 	dictIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
 		procPtr);
 
-	Tcl_DStringInit(&localVarsLiteral);
+	duiPtr = (DictUpdateInfo *)
+		ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+	duiPtr->length = numVars;
 	keyTokenPtrs = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numVars);
 	tokenPtr = TokenAfter(dictVarTokenPtr);
 	for (i=0 ; i<numVars ; i++) {
 	    keyTokenPtrs[i] = tokenPtr;
 	    tokenPtr = TokenAfter(tokenPtr);
 	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		Tcl_DStringFree(&localVarsLiteral);
+		ckfree((char *) duiPtr);
 		ckfree((char *) keyTokenPtrs);
 		return TCL_ERROR;
 	    }
 	    name = tokenPtr[1].start;
 	    nameChars = tokenPtr[1].size;
 	    if (!TclIsLocalScalar(name, nameChars)) {
-		Tcl_DStringFree(&localVarsLiteral);
+		ckfree((char *) duiPtr);
 		ckfree((char *) keyTokenPtrs);
 		return TCL_ERROR;
-	    } else {
-		int localVar = TclFindCompiledLocal(name, nameChars, 1,
-			VAR_SCALAR, procPtr);
-		char buf[12];
-
-		sprintf(buf, "%d", localVar);
-		Tcl_DStringAppendElement(&localVarsLiteral, buf);
 	    }
+	    duiPtr->varIndices[i] = TclFindCompiledLocal(name, nameChars, 1,
+		    VAR_SCALAR, procPtr);
 	    tokenPtr = TokenAfter(tokenPtr);
 	}
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    Tcl_DStringFree(&localVarsLiteral);
+	    ckfree((char *) duiPtr);
 	    ckfree((char *) keyTokenPtrs);
 	    return TCL_ERROR;
 	}
@@ -951,14 +965,21 @@ TclCompileDictCmd(
 
 	keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
 
+	/*
+	 * The list of variables to bind is stored in auxiliary data so that
+	 * it can't be snagged by literal sharing and forced to shimmer
+	 * dangerously.
+	 */
+
+	infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+
 	for (i=0 ; i<numVars ; i++) {
 	    CompileWord(envPtr, keyTokenPtrs[i], interp, i);
 	}
 	TclEmitInstInt4( INST_LIST, numVars,			envPtr);
 	TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex,	envPtr);
-	PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral),
-		Tcl_DStringLength(&localVarsLiteral));
 	TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex,	envPtr);
+	TclEmitInt4(				 infoIndex,	envPtr);
 
 	range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
 	TclEmitInstInt4( INST_BEGIN_CATCH4, range,		envPtr);
@@ -974,19 +995,21 @@ TclCompileDictCmd(
 	envPtr->exceptDepth--;
 
 	TclEmitInstInt4( INST_LOAD_SCALAR4, keyTmpIndex,	envPtr);
-	PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral),
-		Tcl_DStringLength(&localVarsLiteral));
 
 	/*
-	 * Any literal would do, but this one is handy...
+	 * Now remove the contents of the temporary key variable so that the
+	 * reference counts of the keys end up correct. Unsetting the variable
+	 * would be better, but there's no opcode for that.
 	 */
 
+	PushLiteral(envPtr, "", 0);
 	TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex,	envPtr);
-	TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,	envPtr);
+	TclEmitOpcode(	 INST_POP,				envPtr);
 
+	TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,	envPtr);
+	TclEmitInt4(			       infoIndex,	envPtr);
 	TclEmitOpcode(   INST_RETURN_STK,			envPtr);
 
-	Tcl_DStringFree(&localVarsLiteral);
 	ckfree((char *) keyTokenPtrs);
 	return TCL_OK;
     } else if (size==6 && strncmp(cmd, "append", 6) == 0) {
@@ -1060,6 +1083,65 @@ TclCompileDictCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * DupDictUpdateInfo, FreeDictUpdateInfo --
+ *
+ *	Functions to duplicate, release and print the aux data created for use
+ *	with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions.
+ *
+ * Results:
+ *	DupDictUpdateInfo: a copy of the auxiliary data
+ *	FreeDictUpdateInfo: none
+ *	PrintDictUpdateInfo: none
+ *
+ * Side effects:
+ *	DupDictUpdateInfo: allocates memory
+ *	FreeDictUpdateInfo: releases memory
+ *	PrintDictUpdateInfo: none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupDictUpdateInfo(
+    ClientData clientData)
+{
+    DictUpdateInfo *dui1Ptr, *dui2Ptr;
+    unsigned len;
+
+    dui1Ptr = clientData;
+    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
+    dui2Ptr = (DictUpdateInfo *) ckalloc(len);
+    memcpy(dui2Ptr, dui1Ptr, len);
+    return dui2Ptr;
+}
+
+static void
+FreeDictUpdateInfo(
+    ClientData clientData)
+{
+    ckfree(clientData);
+}
+
+static void
+PrintDictUpdateInfo(
+    ClientData clientData,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    DictUpdateInfo *duiPtr = clientData;
+    int i;
+
+    for (i=0 ; i<duiPtr->length ; i++) {
+	if (i) {
+	    fprintf(stdout, ", ");
+	}
+	fprintf(stdout, "%%v%u", duiPtr->varIndices[i]);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileExprCmd --
  *
  *	Procedure called to compile the "expr" command.
@@ -1683,6 +1765,59 @@ FreeForeachInfo(
 /*
  *----------------------------------------------------------------------
  *
+ * PrintForeachInfo --
+ *
+ *	Function to write a human-readable representation of a ForeachInfo
+ *	structure to stdout for debugging.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintForeachInfo(
+    ClientData clientData,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
+
+    fprintf(stdout, "data=[");
+
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    fprintf(stdout, ", ");
+	}
+	fprintf(stdout, "%%v%u", (unsigned) (infoPtr->firstValueTemp + i));
+    }
+    fprintf(stdout, "], loop=%%v%u", (unsigned) infoPtr->loopCtTemp);
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    fprintf(stdout, ",");
+	}
+	fprintf(stdout, "\n\t\t it%%v%u\t[",
+		(unsigned) (infoPtr->firstValueTemp + i));
+	varsPtr = infoPtr->varLists[i];
+	for (j=0 ; j<varsPtr->numVars ; j++) {
+	    if (j) {
+		fprintf(stdout, ", ");
+	    }
+	    fprintf(stdout, "%%v%u", (unsigned) varsPtr->varIndexes[j]);
+	}
+	fprintf(stdout, "]");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileIfCmd --
  *
  *	Procedure called to compile the "if" command.
@@ -4097,16 +4232,18 @@ TclCompileSwitchCmd(
  *
  * DupJumptableInfo, FreeJumptableInfo --
  *
- *	Functions to duplicate and release a jump-table created for use with
- *	the INST_JUMP_TABLE instruction.
+ *	Functions to duplicate, release and print a jump-table created for use
+ *	with the INST_JUMP_TABLE instruction.
  *
  * Results:
  *	DupJumptableInfo: a copy of the jump-table
  *	FreeJumptableInfo: none
+ *	PrintJumptableInfo: none
  *
  * Side effects:
  *	DupJumptableInfo: allocates memory
  *	FreeJumptableInfo: releases memory
+ *	PrintJumptableInfo: none
  *
  *----------------------------------------------------------------------
  */
@@ -4141,6 +4278,33 @@ FreeJumptableInfo(
     Tcl_DeleteHashTable(&jtPtr->hashTable);
     ckfree((char *) jtPtr);
 }
+
+static void
+PrintJumptableInfo(
+    ClientData clientData,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register JumptableInfo *jtPtr = clientData;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    const char *keyPtr;
+    int offset, i = 0;
+
+    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+	offset = (int) Tcl_GetHashValue(hPtr);
+
+	if (i++) {
+	    fprintf(stdout, ", ");
+	    if (i%4==0) {
+		fprintf(stdout, "\n\t\t");
+	    }
+	}
+	fprintf(stdout, "\"%s\"->pc %d", keyPtr, pcOffset + offset);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 8509b60..02e23c7 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.107 2007/02/20 23:24:02 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.108 2007/03/02 10:32:12 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -196,10 +196,10 @@ InstructionDesc tclInstructionTable[] = {
 	/* Skip to next iteration of closest enclosing loop; if none, return
 	 * TCL_CONTINUE code. */
 
-    {"foreach_start4",	  5,   0,          1,	{OPERAND_UINT4}},
+    {"foreach_start4",	  5,   0,          1,	{OPERAND_AUX4}},
 	/* Initialize execution of a foreach loop. Operand is aux data index
 	 * of the ForeachInfo structure for the foreach command. */
-    {"foreach_step4",	  5,   +1,         1,	{OPERAND_UINT4}},
+    {"foreach_step4",	  5,   +1,         1,	{OPERAND_AUX4}},
 	/* "Step" or begin next iteration of foreach loop. Push 0 if to
 	 * terminate loop, else push 1. */
 
@@ -350,19 +350,21 @@ InstructionDesc tclInstructionTable[] = {
 	 * Stack:  ... => ... value key doneBool */
     {"dictDone",	  5,	0,	   1,	{OPERAND_LVT4}},
 	/* Terminate the iterator in op4's local scalar. */
-    {"dictUpdateStart",   5,    -2,	   1,	{OPERAND_LVT4}},
-	/* Create the variables to mirror the state of the dictionary in the
-	 * variable referred to by the immediate argument.
-	 * Stack:  ... keyList LVTindexList => ...
-	 * Note that the list of LVT indices is assumed to be the same length
-	 * as the keyList, and the indices should be only ever generated by the
-	 * compiler. */
-    {"dictUpdateEnd",	  5,    -2,	   1,	{OPERAND_LVT4}},
-	/* Reflect the state of local variables back to the state of the
-	 * dictionary in the variable referred to by the immediate argument.
-	 * Stack:  ... keyList LVTindexList => ...
-	 * Same notes as in "dictUpdateStart" apply here. */
-    {"jumpTable",	  5,	-1,	   1,	{OPERAND_UINT4}},
+    {"dictUpdateStart",   5,    -1,	   2,	{OPERAND_LVT4, OPERAND_AUX4}},
+	/* Create the variables (described in the aux data referred to by the
+	 * second immediate argument) to mirror the state of the dictionary in
+	 * the variable referred to by the first immediate argument. The list
+	 * of keys (popped from the stack) must be the same length as the list
+	 * of variables.
+	 * Stack:  ... keyList => ... */
+    {"dictUpdateEnd",	  5,    -1,	   1,	{OPERAND_LVT4, OPERAND_AUX4}},
+	/* Reflect the state of local variables (described in the aux data
+	 * referred to by the second immediate argument) back to the state of
+	 * the dictionary in the variable referred to by the first immediate
+	 * argument. The list of keys (popped from the stack) must be the same
+	 * length as the list of variables.
+	 * Stack:  ... keyList => ... */
+    {"jumpTable",	  5,	-1,	   1,	{OPERAND_AUX4}},
 	/* Jump according to the jump-table (in AuxData as indicated by the
 	 * operand) and the argument popped from the list. Always executes the
 	 * next instruction if no match against the table's entries was found.
@@ -3641,6 +3643,7 @@ TclPrintInstruction(
 				 * and immediates. */
     char *suffixSrc = NULL;
     Tcl_Obj *suffixObj = NULL;
+    AuxData *auxPtr = NULL;
 
     suffixBuffer[0] = '\0';
     fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
@@ -3669,6 +3672,7 @@ TclPrintInstruction(
 	    }
 	    fprintf(stdout, "%u ", (unsigned int) opnd);
 	    break;
+	case OPERAND_AUX4:
 	case OPERAND_UINT4:
 	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
 	    if (opCode == INST_PUSH4) {
@@ -3677,6 +3681,9 @@ TclPrintInstruction(
 		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
 	    }
 	    fprintf(stdout, "%u ", (unsigned int) opnd);
+	    if (instDesc->opTypes[i] == OPERAND_AUX4) {
+		auxPtr = &codePtr->auxDataArrayPtr[opnd];
+	    }
 	    break;
 	case OPERAND_IDX4:
 	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
@@ -3728,6 +3735,11 @@ TclPrintInstruction(
 	}
     }
     fprintf(stdout, "\n");
+    if (auxPtr && auxPtr->type->printProc) {
+	fprintf(stdout, "\t\t[");
+	auxPtr->type->printProc(auxPtr->clientData, codePtr, pcOffset);
+	fprintf(stdout, "]\n");
+    }
     return numBytes;
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index cba0888..b5ad0ba 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.68 2007/01/19 14:06:10 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.69 2007/03/02 10:32:12 dkf Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -16,6 +16,8 @@
 
 #include "tclInt.h"
 
+struct ByteCode;		/* Forward declaration. */
+
 /*
  *------------------------------------------------------------------------
  * Variables related to compilation. These are used in tclCompile.c,
@@ -157,6 +159,8 @@ typedef struct ExtCmdLoc {
 
 typedef ClientData (AuxDataDupProc)  (ClientData clientData);
 typedef void       (AuxDataFreeProc) (ClientData clientData);
+typedef void	   (AuxDataPrintProc)(ClientData clientData,
+			    struct ByteCode *codePtr, unsigned int pcOffset);
 
 /*
  * We define a separate AuxDataType struct to hold type-related information
@@ -177,6 +181,9 @@ typedef struct AuxDataType {
     AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the aux
 				 * data is freed. NULL means no proc need be
 				 * called. */
+    AuxDataPrintProc *printProc;/* Callback function to invoke when printing
+				 * the aux data as part of debugging. NULL
+				 * means that the data can't be printed. */
 } AuxDataType;
 
 /*
@@ -281,8 +288,8 @@ typedef struct CompileEnv {
     AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
 				/* Initial storage for aux data array. */
     /* TIP #280 */
-    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information
-				 * for 'info frame'. */
+    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
+				 * 'info frame'. */
     int line;			/* First line of the script, based on the
 				 * invoking context, then the line of the
 				 * command currently compiled. */
@@ -631,8 +638,10 @@ typedef enum InstOperandType {
 				 * integer, but displayed differently.) */
     OPERAND_LVT1,		/* One byte unsigned index into the local
 				 * variable table. */
-    OPERAND_LVT4		/* Four byte unsigned index into the local
+    OPERAND_LVT4,		/* Four byte unsigned index into the local
 				 * variable table. */
+    OPERAND_AUX4,		/* Four byte unsigned index into the aux data
+				 * table. */
 } InstOperandType;
 
 typedef struct InstructionDesc {
@@ -754,6 +763,24 @@ typedef struct JumptableInfo {
 MODULE_SCOPE AuxDataType	tclJumptableInfoType;
 
 /*
+ * Structure used to hold information about a [dict update] command that is
+ * needed during program execution. These structures are stored in CompileEnv
+ * and ByteCode structures as auxiliary data.
+ */
+
+typedef struct {
+    int length;			/* Size of array */
+    int varIndices[1];		/* Array of variable indices to manage when
+				 * processing the start and end of a [dict
+				 * update]. There is really more than one
+				 * entry, and the structure is allocated to
+				 * take account of this. MUST BE LAST FIELD IN
+				 * STRUCTURE. */
+} DictUpdateInfo;
+
+MODULE_SCOPE AuxDataType	tclDictUpdateInfoType;
+
+/*
  * ClientData type used by the math operator commands.
  */
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 94207b3..c64f171 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.259 2007/02/20 23:24:03 nijtmans Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.260 2007/03/02 10:32:12 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -5786,14 +5786,17 @@ TclExecuteByteCode(
     }
 
     {
-	int opnd, i, length, length2, allocdict;
-	Tcl_Obj **keyPtrPtr, **varIdxPtrPtr, *dictPtr;
+	int opnd, opnd2, i, length, allocdict;
+	Tcl_Obj **keyPtrPtr, *dictPtr;
+	DictUpdateInfo *duiPtr;
 	Var *varPtr;
 	char *part1;
 
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
 	varPtr = &(compiledLocals[opnd]);
+	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
 	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
@@ -5810,25 +5813,21 @@ TclExecuteByteCode(
 		goto dictUpdateStartFailed;
 	    }
 	}
-	if (Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length,
-			&keyPtrPtr) != TCL_OK ||
-		Tcl_ListObjGetElements(interp, *tosPtr, &length2,
-			&varIdxPtrPtr) != TCL_OK) {
+	if (Tcl_ListObjGetElements(interp, *tosPtr, &length,
+		&keyPtrPtr) != TCL_OK) {
 	    goto dictUpdateStartFailed;
 	}
-	if (length != length2) {
+	if (length != duiPtr->length) {
 	    Tcl_Panic("dictUpdateStart argument length mismatch");
 	}
 	for (i=0 ; i<length ; i++) {
 	    Tcl_Obj *valPtr;
-	    int varIdx;
 
 	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
 		    &valPtr) != TCL_OK) {
 		goto dictUpdateStartFailed;
 	    }
-	    Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx);
-	    varPtr = &(compiledLocals[varIdx]);
+	    varPtr = &(compiledLocals[duiPtr->varIndices[i]]);
 	    part1 = varPtr->name;
 	    while (TclIsVarLink(varPtr)) {
 		varPtr = varPtr->value.linkPtr;
@@ -5840,17 +5839,19 @@ TclExecuteByteCode(
 		    valPtr, TCL_LEAVE_ERR_MSG) == NULL) {
 		CACHE_STACK_INFO();
 	    dictUpdateStartFailed:
-		cleanup = 2;
+		cleanup = 1;
 		result = TCL_ERROR;
 		goto checkForCatch;
 	    }
 	    CACHE_STACK_INFO();
 	}
-	NEXT_INST_F(5, 2, 0);
+	NEXT_INST_F(9, 1, 0);
 
     case INST_DICT_UPDATE_END:
 	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
 	varPtr = &(compiledLocals[opnd]);
+	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
 	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
@@ -5864,14 +5865,12 @@ TclExecuteByteCode(
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
-	    NEXT_INST_F(5, 2, 0);
-	}
-	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK ||
-		Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length,
-			&keyPtrPtr) != TCL_OK ||
-		Tcl_ListObjGetElements(interp, *tosPtr, &length2,
-			&varIdxPtrPtr) != TCL_OK) {
-	    cleanup = 2;
+	    NEXT_INST_F(9, 1, 0);
+	}
+	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
+		|| Tcl_ListObjGetElements(interp, *tosPtr, &length,
+			&keyPtrPtr) != TCL_OK) {
+	    cleanup = 1;
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
@@ -5881,12 +5880,10 @@ TclExecuteByteCode(
 	}
 	for (i=0 ; i<length ; i++) {
 	    Tcl_Obj *valPtr;
-	    int varIdx;
 	    Var *var2Ptr;
 	    char *part1a;
 
-	    Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx);
-	    var2Ptr = &(compiledLocals[varIdx]);
+	    var2Ptr = &(compiledLocals[duiPtr->varIndices[i]]);
 	    part1a = var2Ptr->name;
 	    while (TclIsVarLink(var2Ptr)) {
 		var2Ptr = var2Ptr->value.linkPtr;
@@ -5922,7 +5919,7 @@ TclExecuteByteCode(
 		goto checkForCatch;
 	    }
 	}
-	NEXT_INST_F(5, 2, 0);
+	NEXT_INST_F(9, 1, 0);
     }
 
     default:
@@ -6302,7 +6299,7 @@ ValidatePcAndStackTop(
     if (checkStack &&
 	    ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
 	int numChars;
-	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
 
 	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
 		stackTop, relativePc, stackLowerBound, stackUpperBound);
diff --git a/tests/dict.test b/tests/dict.test
index cf9fc1f..c6e8987 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -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: dict.test,v 1.19 2006/08/09 13:51:02 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.20 2007/03/02 10:32:13 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1042,6 +1042,22 @@ test dict-21.13 {dict update command: compilation} {
     }
     getOrder [dicttest {a 1 c 2}] b c
 } {b 1 c 2 2}
+test dict-21.14 {dict update command: compilation} {
+    proc dicttest x {
+	set indices {2 3}
+	trace add variable aa write "string length \$indices ;#"
+	dict update x k aa l bb {}
+    }
+    dicttest {k 1 l 2}
+} {}
+test dict-21.15 {dict update command: compilation} {
+    proc dicttest x {
+	set indices {2 3}
+	trace add variable aa read "string length \$indices ;#"
+	dict update x k aa l bb {}
+    }
+    dicttest {k 1 l 2}
+} {}
 
 test dict-22.1 {dict with command} -body {
     dict with