Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.2709
diff -u -r1.2709 ChangeLog
--- ChangeLog	14 Jul 2005 10:50:08 -0000	1.2709
+++ ChangeLog	14 Jul 2005 14:02:55 -0000
@@ -15,6 +15,9 @@
 
 2005-07-12  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclCompCmds.c (TclCompileDictCmd): First run at a compiler 
+	* generic/tclExecute.c (TclExecuteByteCode): for dictionaries.
+
 	* doc/lsearch.n: Clarify documentation of -exact option; wording was
 	open to misinterpretation by non-English speakers.
 
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.162
diff -u -r1.162 tclBasic.c
--- generic/tclBasic.c	21 Jun 2005 18:33:02 -0000	1.162
+++ generic/tclBasic.c	14 Jul 2005 14:02:55 -0000
@@ -154,7 +154,7 @@
     {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	1},
     {"concat",		Tcl_ConcatObjCmd,	(CompileProc *) NULL,	1},
     {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	1},
-    {"dict",		Tcl_DictObjCmd,		(CompileProc *) NULL,	1},
+    {"dict",		Tcl_DictObjCmd,		TclCompileDictCmd,	1},
     {"encoding",	Tcl_EncodingObjCmd,	(CompileProc *) NULL,	0},
     {"error",		Tcl_ErrorObjCmd,	(CompileProc *) NULL,	1},
     {"eval",		Tcl_EvalObjCmd,		(CompileProc *) NULL,	1},
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.76
diff -u -r1.76 tclCompCmds.c
--- generic/tclCompCmds.c	13 Jul 2005 20:33:11 -0000	1.76
+++ generic/tclCompCmds.c	14 Jul 2005 14:02:56 -0000
@@ -7,7 +7,7 @@
  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2002 ActiveState Corporation.
- * Copyright (c) 2004 Donal K. Fellows.
+ * Copyright (c) 2004-2005 by Donal K. Fellows.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -79,6 +79,26 @@
     ((envPtr)->codeNext - (envPtr)->codeStart)
 
 /*
+ * static int	DeclareExceptionRange(CompileEnv *envPtr, int type);
+ * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
+ */
+
+#define DeclareExceptionRange(envPtr, type) \
+    (((envPtr)->exceptDepth++), \
+    ((envPtr)->maxExceptDepth = \
+	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
+    (TclCreateExceptRange((type), (envPtr))))
+#define ExceptionRangeStarts(envPtr, index) \
+    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr))
+#define ExceptionRangeEnds(envPtr, index) \
+    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
+	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset)
+#define ExceptionRangeTarget(envPtr, index, targetType) \
+    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+
+/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -266,7 +286,7 @@
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
     CONST char *name;
-    int resultIndex, optsIndex, nameChars, range, startOffset;
+    int resultIndex, optsIndex, nameChars, range;
     int savedStackDepth = envPtr->currStackDepth;
 
     /*
@@ -330,10 +350,7 @@
      * start of the catch body: the subcommand it controls.
      */
 
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
     TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
 
     /*
@@ -346,17 +363,16 @@
      */
 
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	startOffset = CurrentOffset(envPtr);
+	ExceptionRangeStarts(envPtr, range);
 	CompileBody(envPtr, cmdTokenPtr, interp);
+	ExceptionRangeEnds(envPtr, range);
     } else {
 	TclCompileTokens(interp, cmdTokenPtr+1,
 		cmdTokenPtr->numComponents, envPtr);
-	startOffset = CurrentOffset(envPtr);
+	ExceptionRangeStarts(envPtr, range);
 	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	ExceptionRangeEnds(envPtr, range);
     }
-    envPtr->exceptArrayPtr[range].codeOffset = startOffset;
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    CurrentOffset(envPtr) - startOffset;
 
     /*
      * The "no errors" epilogue code: store the body's result into the
@@ -401,7 +417,7 @@
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    envPtr->exceptArrayPtr[range].catchOffset = CurrentOffset(envPtr);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
     if (resultIndex != -1) {
 	if (optsIndex != -1) {
 	    TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
@@ -484,6 +500,515 @@
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileDictCmd --
+ *
+ *	Procedure called to compile the "dict" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile.  Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "dict" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileDictCmd(interp, parsePtr, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
+				 * command created by Tcl_ParseCommand. */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int numWords, size, i;
+    const char *cmd;
+    Proc *procPtr = envPtr->procPtr;
+
+    /*
+     * There must be at least one argument after the command.
+     */
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    numWords = parsePtr->numWords-2;
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * The following commands are in fairly common use and are possibly worth
+     * bytecoding:
+     *     dict append
+     *     dict create	[*]
+     *     dict exists	[*]
+     *     dict for
+     *     dict get	[*]
+     *     dict incr
+     *     dict keys	[*]
+     *     dict lappend
+     *     dict set
+     *     dict unset
+     * In practice, those that are pure-value operators (marked with [*]) can
+     * probably be left alone (except perhaps [dict get] which is very very
+     * common) and [dict update] should be considered instead (really big
+     * win!)
+     */
+
+    size = tokenPtr[1].size;
+    cmd = tokenPtr[1].start;
+    if (size==3 && strncmp(cmd, "set", 3)==0) {
+	Tcl_Token *varTokenPtr;
+	int dictVarIndex, nameChars;
+	const char *name;
+
+	if (numWords < 3 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	varTokenPtr = TokenAfter(tokenPtr);
+	tokenPtr = TokenAfter(varTokenPtr);
+	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	name = varTokenPtr[1].start;
+	nameChars = varTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
+		procPtr);
+	for (i=1 ; i<numWords ; i++) {
+	    CompileWord(envPtr, tokenPtr, interp);
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+	TclEmitInstInt4( INST_DICT_SET, numWords-2,		envPtr);
+	TclEmitInt4(	 dictVarIndex,				envPtr);
+	return TCL_OK;
+    } else if (size==4 && strncmp(cmd, "incr", 4)==0) {
+	Tcl_Token *varTokenPtr, *keyTokenPtr, *incrTokenPtr = NULL;
+	int dictVarIndex, nameChars, incrAmount = 1;
+	const char *name;
+
+	if (numWords < 2 || numWords > 3 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	varTokenPtr = TokenAfter(tokenPtr);
+	keyTokenPtr = TokenAfter(varTokenPtr);
+	if (numWords == 3) {
+	    const char *word;
+	    int numBytes, code;
+	    Tcl_Obj *intObj;
+
+	    incrTokenPtr = TokenAfter(keyTokenPtr);
+	    if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		return TCL_ERROR;
+	    }
+	    word = incrTokenPtr[1].start;
+	    numBytes = incrTokenPtr[1].size;
+
+	    /*
+	     * Note there is a danger that modifying the string could have
+	     * undesirable side effects.  In this case, TclLooksLikeInt has no
+	     * dependencies on shared strings so we should be safe.
+	     */
+
+	    if (!TclLooksLikeInt(word, numBytes)) {
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Now try to really parse the number.
+	     */
+
+	    intObj = Tcl_NewStringObj(word, numBytes);
+	    Tcl_IncrRefCount(intObj);
+	    code = Tcl_GetIntFromObj(NULL, intObj, &incrAmount);
+	    Tcl_DecrRefCount(intObj);
+	    if (code != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	name = varTokenPtr[1].start;
+	nameChars = varTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
+		procPtr);
+	CompileWord(envPtr, keyTokenPtr, interp);
+	TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount,	envPtr);
+	TclEmitInt4(	 dictVarIndex,				envPtr);
+	return TCL_OK;
+    } else if (size==3 && strncmp(cmd, "get", 3)==0) {
+	/*
+	 * Only compile this because we need INST_DICT_GET anyway.
+	 */
+	if (numWords < 2) {
+	    return TCL_ERROR;
+	}
+	for (i=0 ; i<numWords ; i++) {
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp);
+	}
+	TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
+	return TCL_OK;
+    } else if (size==3 && strncmp(cmd, "for", 3)==0) {
+	Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
+	int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
+	int infoIndex, jumpDisplacement, bodyTargetOffset, doneTargetOffset;
+	int endTargetOffset;
+	const char **argv;
+	Tcl_DString buffer;
+	int savedStackDepth = envPtr->currStackDepth;
+
+	if (numWords != 3 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+
+	varsTokenPtr = TokenAfter(tokenPtr);
+	dictTokenPtr = TokenAfter(varsTokenPtr);
+	bodyTokenPtr = TokenAfter(dictTokenPtr);
+	if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+		bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Check we've got a pair of variables and that they are local
+	 * variables. Then extract their indices in the LVT.
+	 */
+
+	Tcl_DStringInit(&buffer);
+	Tcl_DStringAppend(&buffer, varsTokenPtr[1].start,
+		varsTokenPtr[1].size);
+	if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numWords,
+		&argv) != TCL_OK) {
+	    Tcl_DStringFree(&buffer);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringFree(&buffer);
+	if (numWords != 2) {
+	    ckfree((char *) argv);
+	    return TCL_ERROR;
+	}
+	nameChars = strlen(argv[0]);
+	if (!TclIsLocalScalar(argv[0], nameChars)) {
+	    ckfree((char *) argv);
+	    return TCL_ERROR;
+	}
+	keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, VAR_SCALAR,
+		procPtr);
+	nameChars = strlen(argv[1]);
+	if (!TclIsLocalScalar(argv[1], nameChars)) {
+	    ckfree((char *) argv);
+	    return TCL_ERROR;
+	}
+	valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, VAR_SCALAR,
+		procPtr);
+	ckfree((char *) argv);
+
+	/*
+	 * Allocate a temporary variable to store the iterator reference. The
+	 * variable will contain a Tcl_DictSearch reference which will be
+	 * allocated by INST_DICT_FIRST and disposed when the variable is
+	 * unset (at which point it should also have been finished with).
+	 */
+
+	infoIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
+
+	/*
+	 * Preparation complete; issue instructions. Note that this code
+	 * issues fixed-sized jumps. That simplifies things a lot!
+	 *
+	 * First up, get the dictionary and start the iteration. No catching
+	 * of errors at this point.
+	 */
+
+	CompileWord(envPtr, dictTokenPtr, interp);
+	TclEmitInstInt4( INST_DICT_FIRST, infoIndex,		envPtr);
+	doneTargetOffset = CurrentOffset(envPtr);
+	TclEmitInstInt4( INST_JUMP_TRUE4, 0,			envPtr);
+
+	/*
+	 * Now we catch errors from here on so that we can finalize the search
+	 * started by Tcl_DictObjFirst above.
+	 */
+
+	catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+	TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange,		envPtr);
+	ExceptionRangeStarts(envPtr, catchRange);
+
+	/*
+	 * Inside the iteration, write the loop variables.
+	 */
+
+	bodyTargetOffset = CurrentOffset(envPtr);
+	TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex,	envPtr);
+	TclEmitOpcode(   INST_POP,				envPtr);
+	TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex,	envPtr);
+	TclEmitOpcode(   INST_POP,				envPtr);
+
+	/*
+	 * Set up the loop exception targets.
+	 */
+
+	loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+	ExceptionRangeStarts(envPtr, loopRange);
+
+	/*
+	 * Compile the loop body itself. It should be stack-neutral.
+	 */
+
+	CompileBody(envPtr, bodyTokenPtr, interp);
+	envPtr->currStackDepth = savedStackDepth + 1;
+	TclEmitOpcode(   INST_POP,				envPtr);
+	envPtr->currStackDepth = savedStackDepth;
+
+	/*
+	 * Both exception target ranges (error and loop) end here.
+	 */
+
+	ExceptionRangeEnds(envPtr, loopRange);
+	ExceptionRangeEnds(envPtr, catchRange);
+
+	/*
+	 * Continue (or just normally process) by getting the next pair of
+	 * items from the dictionary and jumping back to the code to write
+	 * them into variables if there is another pair.
+	 */
+
+	ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+	TclEmitInstInt4( INST_DICT_NEXT, infoIndex,		envPtr);
+	jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
+	TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
+
+	/*
+	 * Otherwise we're done (the jump after the DICT_FIRST points here)
+	 * and we need to pop the bogus key/value pair (pushed to keep stack
+	 * calculations easy!)
+	 */
+
+	jumpDisplacement = CurrentOffset(envPtr) - doneTargetOffset;
+	TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
+		envPtr->codeStart + doneTargetOffset);
+	TclEmitOpcode(   INST_POP,				envPtr);
+	TclEmitOpcode(   INST_POP,				envPtr);
+
+	/*
+	 * Now do the final cleanup for the no-error case (this is where we
+	 * break out of the loop to) by force-terminating the iteration (if
+	 * not already terminated), ditching the exception info and jumping to
+	 * the last instruction for this command. In theory, this could be
+	 * done using the "finally" clause (next generated) but this is
+	 * faster.
+	 */
+
+	ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+	TclEmitInstInt4( INST_DICT_DONE, infoIndex,		envPtr);
+	TclEmitOpcode(	 INST_END_CATCH,			envPtr);
+	endTargetOffset = CurrentOffset(envPtr);
+	TclEmitInstInt4( INST_JUMP4, 0,				envPtr);
+
+	/*
+	 * Error handler "finally" clause, which force-terminates the
+	 * iteration and rethrows the error.
+	 */
+
+	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+	TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,		envPtr);
+	TclEmitOpcode(   INST_PUSH_RESULT,			envPtr);
+	TclEmitInstInt4( INST_DICT_DONE, infoIndex,		envPtr);
+	TclEmitOpcode(   INST_END_CATCH,			envPtr);
+	TclEmitOpcode(   INST_RETURN_STK,			envPtr);
+
+	/*
+	 * Final stage of the command (normal case) is that we push an empty
+	 * object. This is done last to promote peephole optimization when
+	 * it's dropped immediately.
+	 */
+
+	jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
+	TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
+		envPtr->codeStart + endTargetOffset);
+	PushLiteral(envPtr, "", 0);
+	envPtr->exceptDepth -= 2;
+	return TCL_OK;
+    } else if (size==6 && strncmp(cmd, "update", 6)==0) {
+	const char *name;
+	int nameChars, dictIndex, keyTmpIndex, numVars, range;
+	Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr;
+	Tcl_DString localVarsLiteral;
+
+	/*
+	 * Parse the command. Expect the following:
+	 *   dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
+	 */
+
+	if (numWords < 4 || numWords & 1 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	numVars = numWords/2 - 1;
+	dictVarTokenPtr = TokenAfter(tokenPtr);
+	if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	name = dictVarTokenPtr[1].start;
+	nameChars = dictVarTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
+		procPtr);
+
+	Tcl_DStringInit(&localVarsLiteral);
+	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 *) keyTokenPtrs);
+		return TCL_ERROR;
+	    }
+	    name = tokenPtr[1].start;
+	    nameChars = tokenPtr[1].size;
+	    if (!TclIsLocalScalar(name, nameChars)) {
+		Tcl_DStringFree(&localVarsLiteral);
+		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);
+	    }
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    Tcl_DStringFree(&localVarsLiteral);
+	    ckfree((char *) keyTokenPtrs);
+	    return TCL_ERROR;
+	}
+	bodyTokenPtr = tokenPtr;
+
+	keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
+
+	for (i=0 ; i<numVars ; i++) {
+	    CompileWord(envPtr, keyTokenPtrs[i], interp);
+	}
+	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);
+
+	range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+	TclEmitInstInt4( INST_BEGIN_CATCH4, range,		envPtr);
+
+	ExceptionRangeStarts(envPtr, range);
+	CompileBody(envPtr, bodyTokenPtr, interp);
+	ExceptionRangeEnds(envPtr, range);
+
+	ExceptionRangeTarget(envPtr, range, catchOffset);
+	TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,		envPtr);
+	TclEmitOpcode(   INST_PUSH_RESULT,			envPtr);
+	TclEmitOpcode(   INST_END_CATCH,			envPtr);
+	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...
+	 */
+	TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex,	envPtr);
+	TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,	envPtr);
+
+	TclEmitOpcode(   INST_RETURN_STK,			envPtr);
+
+	Tcl_DStringFree(&localVarsLiteral);
+	ckfree((char *) keyTokenPtrs);
+	return TCL_OK;
+    } else if (size==6 && strncmp(cmd, "append", 6) == 0) {
+	Tcl_Token *varTokenPtr;
+	int dictVarIndex, nameChars;
+	const char *name;
+
+	/*
+	 * Arbirary safe limit; anyone exceeding it should stop worrying about
+	 * speed quite so much. ;-)
+	 */
+	if (numWords < 3 || numWords > 100 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	varTokenPtr = TokenAfter(tokenPtr);
+	tokenPtr = TokenAfter(varTokenPtr);
+	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	name = varTokenPtr[1].start;
+	nameChars = varTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
+		procPtr);
+	for (i=1 ; i<numWords ; i++) {
+	    CompileWord(envPtr, tokenPtr, interp);
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+	if (numWords > 3) {
+	    TclEmitInstInt1( INST_CONCAT1, numWords-2,		envPtr);
+	}
+	TclEmitInstInt4( INST_DICT_APPEND, dictVarIndex,	envPtr);
+	return TCL_OK;
+    } else if (size==7 && strncmp(cmd, "lappend", 7) == 0) {
+	Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
+	int dictVarIndex, nameChars;
+	const char *name;
+
+	if (numWords != 3 || procPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	varTokenPtr = TokenAfter(tokenPtr);
+	keyTokenPtr = TokenAfter(varTokenPtr);
+	valueTokenPtr = TokenAfter(keyTokenPtr);
+	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	name = varTokenPtr[1].start;
+	nameChars = varTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
+		procPtr);
+	CompileWord(envPtr, keyTokenPtr, interp);
+	CompileWord(envPtr, valueTokenPtr, interp);
+	TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex,	envPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * Something we do not know how to compile.
+     */
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileExprCmd --
  *
  *	Procedure called to compile the "expr" command.
@@ -581,10 +1106,7 @@
      * has a -1 continueOffset).
      */
 
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     /*
@@ -612,12 +1134,10 @@
      * Compile the loop body.
      */
 
-    bodyCodeOffset = CurrentOffset(envPtr);
-
+    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
     CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, bodyRange);
     envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
-	    CurrentOffset(envPtr) - bodyCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
 
 
@@ -625,13 +1145,11 @@
      * Compile the "next" subcommand.
      */
 
-    nextCodeOffset = CurrentOffset(envPtr);
-
     envPtr->currStackDepth = savedStackDepth;
+    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
     CompileBody(envPtr, nextTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, nextRange);
     envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptArrayPtr[nextRange].numCodeBytes =
-	    CurrentOffset(envPtr) - nextCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
     envPtr->currStackDepth = savedStackDepth;
 
@@ -661,7 +1179,8 @@
     }
 
     /*
-     * Set the loop's offsets and break target.
+     * Fix the starting points of the exception ranges (may have moved due to
+     * jump type modification) and set where the exceptions target.
      */
 
     envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
@@ -669,9 +1188,8 @@
 
     envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
 
-    envPtr->exceptArrayPtr[bodyRange].breakOffset =
-	    envPtr->exceptArrayPtr[nextRange].breakOffset =
-	    CurrentOffset(envPtr);
+    ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
+    ExceptionRangeTarget(envPtr, nextRange, breakOffset);
 
     /*
      * The for command's result is an empty string.
@@ -777,14 +1295,6 @@
     }
 
     /*
-     * Set the exception stack depth.
-     */
-
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-
-    /*
      * Break up each var list and set the varcList and varvList arrays. Don't
      * compile the foreach inline if any var name needs substitutions or isn't
      * a scalar, or if any var list needs substitutions.
@@ -879,10 +1389,14 @@
     infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
 
     /*
-     * Evaluate then store each value list in the associated temporary.
+     * Create an exception record to handle [break] and [continue].
      */
 
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+
+    /*
+     * Evaluate then store each value list in the associated temporary.
+     */
 
     loopIndex = 0;
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
@@ -914,7 +1428,7 @@
      * to terminate the loop.
      */
 
-    envPtr->exceptArrayPtr[range].continueOffset = CurrentOffset(envPtr);
+    ExceptionRangeTarget(envPtr, range, continueOffset);
     TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
 
@@ -922,11 +1436,10 @@
      * Inline compile the loop body.
      */
 
-    envPtr->exceptArrayPtr[range].codeOffset = CurrentOffset(envPtr);
+    ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, range);
     envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    CurrentOffset(envPtr) - envPtr->exceptArrayPtr[range].codeOffset;
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -974,7 +1487,7 @@
      * Set the loop's break target.
      */
 
-    envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr);
+    ExceptionRangeTarget(envPtr, range, breakOffset);
 
     /*
      * The foreach command's result is an empty string.
@@ -2309,6 +2822,31 @@
     int objc;
     Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
 
+    /*
+     * Check for special case which can always be compiled:
+     *	    return -options <opts> <msg>
+     * Unlike the normal [return] compilation, this version does everything at
+     * runtime so it can handle arbitrary words and not just literals. Note
+     * that if INST_RETURN_STK wasn't already needed for something else
+     * ('finally' clause processing) this piece of code would not be present.
+     */
+
+    if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
+	    && (wordTokenPtr[1].size == 8)
+	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
+	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
+	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);
+
+	CompileWord(envPtr, optsTokenPtr, interp);
+	CompileWord(envPtr, msgTokenPtr, interp);
+	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * Allocate some working space if needed
+     */
+
     if (numOptionWords > NUM_STATIC_OBJS) {
 	objv = (Tcl_Obj **) ckalloc(numOptionWords * sizeof(Tcl_Obj *));
     } else {
@@ -2398,11 +2936,11 @@
 
     /*
      * Could not use the optimization, so we push the return options dict, and
-     * emit the INST_RETURN instruction with code and level as operands.
+     * emit the INST_RETURN_IMM instruction with code and level as operands.
      */
 
     TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
-    TclEmitInstInt4(INST_RETURN, code, envPtr);
+    TclEmitInstInt4(INST_RETURN_IMM, code, envPtr);
     TclEmitInt4(level, envPtr);
     return TCL_OK;
 }
@@ -3318,10 +3856,7 @@
      * implement break and continue.
      */
 
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
 
     /*
      * Jump to the evaluation of the condition. This code uses the "loop
@@ -3348,11 +3883,10 @@
      * Compile the loop body.
      */
 
-    bodyCodeOffset = CurrentOffset(envPtr);
+    bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, range);
     envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    CurrentOffset(envPtr) - bodyCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -3393,7 +3927,7 @@
 
     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
     envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
-    envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr);
+    ExceptionRangeTarget(envPtr, range, breakOffset);
 
     /*
      * The while command's result is an empty string.
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.89
diff -u -r1.89 tclCompile.c
--- generic/tclCompile.c	14 Jul 2005 13:41:41 -0000	1.89
+++ generic/tclCompile.c	14 Jul 2005 14:02:56 -0000
@@ -274,10 +274,9 @@
 	 * (operand-2) indices; pushes the new value.
 	 */
 
-    {"return",		  9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
-	/* Compiled [return], code, level are operands; options and result are
-	 * on the stack. */
-
+    {"returnImm",	  9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
+	/* Compiled [return], code, level are operands; options and result
+	 * are on the stack. */
     {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
 	/* Binary exponentiation operator: push (stknext ** stktop) */
 
@@ -311,6 +310,58 @@
     {"pushReturnOpts",	  1,	+1,	   0,	{OPERAND_NONE}},
 	/* Push the interpreter's return option dictionary as an object on the
 	 * stack. */
+    {"returnStk",	  1,	-2,	   0,	{OPERAND_NONE}},
+	/* Compiled [return]; options and result are on the stack, code and
+	 * level are in the options. */
+
+    {"dictGet",		  5,	INT_MIN,   1,	{OPERAND_UINT4}},
+	/* The top op4 words (min 1) are a key path into the dictionary just
+	 * below the keys on the stack, and all those values are replaced by
+	 * the value read out of that key-path (like [dict get]).
+	 * Stack:  ... dict key1 ... keyN => ... value */
+    {"dictSet",		  5,	INT_MIN,   2,	{OPERAND_UINT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the keys are a path pointing to
+	 * the value. op4#1 = numKeys, op4#2 = LVTindex
+	 * Stack:  ... key1 ... keyN value => ... newDict */
+    {"dictUnset",	  5,	INT_MIN,   2,	{OPERAND_UINT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the keys are not a path pointing
+	 * to any value. op4#1 = numKeys, op4#2 = LVTindex
+	 * Stack:  ... key1 ... keyN => ... newDict */
+    {"dictIncrImm",	  5,	0,	   2,	{OPERAND_INT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key is
+	 * incremented by some value (or set to it if the key isn't in the
+	 * dictionary at all). op4#1 = incrAmount, op4#2 = LVTindex
+	 * Stack:  ... key => ... newDict */
+    {"dictAppend",	  5,	-1,	   1,	{OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key has
+	 * some value string-concatenated onto it. op4 = LVTindex
+	 * Stack:  ... key valueToAppend => ... newDict */
+    {"dictLappend",	  5,	-1,	   1,	{OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key has
+	 * some value list-appended onto it. op4 = LVTindex
+	 * Stack:  ... key valueToAppend => ... newDict */
+    {"dictFirst",	  5,	+2,	   1,	{OPERAND_LVT4}},
+	/* Begin iterating over the dictionary, using the local scalar
+	 * indicated by op4 to hold the iterator state. If doneBool is true,
+	 * dictDone *must* be called later on.
+	 * Stack:  ... dict => ... value key doneBool */
+    {"dictNext",	  5,	+3,	   1,	{OPERAND_LVT4}},
+	/* Get the next iteration from the iterator in op4's local scalar.
+	 * 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. */
     {0}
 };
 
@@ -1216,7 +1267,7 @@
 	     * offsets of the source and code for the command.
 	     */
 
-	    finishCommand:
+	finishCommand:
 	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
 		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 	    isFirstCmd = 0;
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.58
diff -u -r1.58 tclCompile.h
--- generic/tclCompile.h	14 Jul 2005 12:12:39 -0000	1.58
+++ generic/tclCompile.h	14 Jul 2005 14:02:56 -0000
@@ -518,7 +518,7 @@
 
 /* TIP#90 - 'return' command. */
 
-#define INST_RETURN			98
+#define INST_RETURN_IMM			98
 
 /* TIP#123 - exponentiation operator. */
 
@@ -544,9 +544,26 @@
 #define INST_LIST_NOT_IN		107
 
 #define INST_PUSH_RETURN_OPTIONS	108
+#define INST_RETURN_STK			109
+
+/*
+ * Dictionary (TIP#111) related commands.
+ */
+
+#define INST_DICT_GET			110
+#define INST_DICT_SET			111
+#define INST_DICT_UNSET			112
+#define INST_DICT_INCR_IMM		113
+#define INST_DICT_APPEND		114
+#define INST_DICT_LAPPEND		115
+#define INST_DICT_FIRST			116
+#define INST_DICT_NEXT			117
+#define INST_DICT_DONE			118
+#define INST_DICT_UPDATE_START		119
+#define INST_DICT_UPDATE_END		120
 
 /* The last opcode */
-#define LAST_INST_OPCODE		108
+#define LAST_INST_OPCODE		120
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
Index: generic/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.32
diff -u -r1.32 tclDictObj.c
--- generic/tclDictObj.c	4 Jul 2005 21:19:34 -0000	1.32
+++ generic/tclDictObj.c	14 Jul 2005 14:02:56 -0000
@@ -20,33 +20,6 @@
 struct Dict;
 
 /*
- * Flag values for TraceDictPath().
- *
- * DICT_PATH_READ indicates that all entries on the path must exist
- * but no updates will be needed.
- *
- * DICT_PATH_UPDATE indicates that we are going to be doing an update
- * at the tip of the path, so duplication of shared objects should be
- * done along the way.
- *
- * DICT_PATH_EXISTS indicates that we are performing an existance test
- * and a lookup failure should therefore not be an error.  If (and
- * only if) this flag is set, TraceDictPath() will return the special
- * value DICT_PATH_NON_EXISTENT if the path is not traceable.
- *
- * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to
- * be set) indicates that we are to create non-existant dictionaries
- * on the path.
- */
-
-#define DICT_PATH_READ   0
-#define DICT_PATH_UPDATE 1
-#define DICT_PATH_EXISTS 2
-#define DICT_PATH_CREATE 5
-
-#define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1)
-
-/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -95,9 +68,6 @@
 static void		InvalidateDictChain _ANSI_ARGS_((Tcl_Obj *dictObj));
 static int		SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
-static Tcl_Obj *	TraceDictPath _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[],
-			    int flags));
 static void		UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr));
 
 /*
@@ -588,7 +558,7 @@
 /*
  *----------------------------------------------------------------------
  *
- * TraceDictPath --
+ * TclTraceDictPath --
  *
  *	Trace through a tree of dictionaries using the array of keys
  *	given. If the flags argument has the DICT_PATH_UPDATE flag is
@@ -619,8 +589,8 @@
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-TraceDictPath(interp, dictPtr, keyc, keyv, flags)
+Tcl_Obj *
+TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
     Tcl_Interp *interp;
     Tcl_Obj *dictPtr, *CONST keyv[];
     int keyc, flags;
@@ -697,8 +667,8 @@
  * InvalidateDictChain --
  *
  *	Go through a dictionary chain (built by an updating invokation
- *	of TraceDictPath) and invalidate the string representations of
- *	all the dictionaries on the chain.
+ *	of TclTraceDictPath) and invalidate the string representations
+ *	of all the dictionaries on the chain.
  *
  * Results:
  *	None
@@ -1135,7 +1105,7 @@
 	Tcl_Panic("Tcl_DictObjPutKeyList called with empty key list");
     }
 
-    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE);
+    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1191,7 +1161,7 @@
 	Tcl_Panic("Tcl_DictObjRemoveKeyList called with empty key list");
     }
 
-    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE);
+    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1426,7 +1396,7 @@
      * executes at least once.
      */
 
-    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, DICT_PATH_READ);
+    dictPtr = TclTraceDictPath(interp, objv[2], objc-4,objv+3, DICT_PATH_READ);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1815,7 +1785,8 @@
 	return TCL_ERROR;
     }
 
-    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, DICT_PATH_EXISTS);
+    dictPtr = TclTraceDictPath(interp, objv[2], objc-4, objv+3,
+	    DICT_PATH_EXISTS);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -2879,7 +2850,7 @@
 	return TCL_ERROR;
     }
     if (objc > 4) {
-	dictPtr = TraceDictPath(interp, dictPtr, objc-4, objv+3,
+	dictPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3,
 		DICT_PATH_READ);
 	if (dictPtr == NULL) {
 	    return TCL_ERROR;
@@ -2957,7 +2928,7 @@
 	 * on to update; it's just less than perfectly efficient (but
 	 * no memory should be leaked).
 	 */
-	leafPtr = TraceDictPath(interp, dictPtr, objc-4, objv+3,
+	leafPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3,
 		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
 	if (leafPtr == NULL) {
 	    TclDecrRefCount(keysPtr);
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.195
diff -u -r1.195 tclExecute.c
--- generic/tclExecute.c	11 Jul 2005 15:04:11 -0000	1.195
+++ generic/tclExecute.c	14 Jul 2005 14:02:57 -0000
@@ -6,6 +6,8 @@
  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2002-2005 by Miguel Sofer.
+ * Copyright (c) 2005 by Donal K. Fellows.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -350,6 +352,11 @@
     }
 #endif /* TCL_WIDE_INT_IS_LONG */
 
+static Tcl_ObjType dictIteratorType = {
+    "dictIterator",
+    NULL, NULL, NULL, NULL
+};
+
 /*
  * Declarations for local procedures to this file:
  */
@@ -1258,11 +1265,13 @@
     }
 
     switch (*pc) {
-    case INST_RETURN: {
+    case INST_RETURN_IMM: {
 	int code = TclGetInt4AtPtr(pc+1);
 	int level = TclGetUInt4AtPtr(pc+5);
-	Tcl_Obj *returnOpts = POP_OBJECT();
+	Tcl_Obj *returnOpts;
 
+	TRACE(("%u %u => ", code, level));
+	returnOpts = POP_OBJECT();
 	result = TclProcessReturn(interp, code, level, returnOpts);
 	Tcl_DecrRefCount(returnOpts);
 	if (result != TCL_OK) {
@@ -1270,9 +1279,25 @@
 	    cleanup = 1;
 	    goto processExceptionReturn;
 	}
+	TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+		O2S(objResultPtr)));
 	NEXT_INST_F(9, 0, 0);
     }
 
+    case INST_RETURN_STK:
+	TRACE(("=> "));
+	objResultPtr = POP_OBJECT();
+	result = Tcl_SetReturnOptions(interp, POP_OBJECT());
+	if (result != TCL_OK) {
+	    Tcl_SetObjResult(interp, objResultPtr);
+	    Tcl_DecrRefCount(objResultPtr);
+	    cleanup = 0;
+	    goto processExceptionReturn;
+	}
+	TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+		O2S(objResultPtr)));
+	NEXT_INST_F(1, 0, -1);
+
     case INST_DONE:
 	if (tosPtr <= eePtr->stackPtr + initStackTop) {
 	    tosPtr--;
@@ -4763,6 +4788,502 @@
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
+    {
+	int opnd, opnd2, allocateDict;
+	Tcl_Obj *dictPtr, *valPtr;
+	Var *varPtr;
+	char *part1;
+
+    case INST_DICT_GET:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	dictPtr = *(tosPtr - opnd);
+	if (opnd > 1) {
+	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
+		    tosPtr - (opnd-1), DICT_PATH_READ);
+	    if (dictPtr == NULL) {
+		TRACE_WITH_OBJ((
+			"%u => ERROR tracing dictionary path into \"%s\": ",
+			opnd, O2S(*(tosPtr - opnd))),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		cleanup = opnd + 1;
+		goto checkForCatch;
+	    }
+	}
+	result = Tcl_DictObjGet(interp, dictPtr, *tosPtr, &objResultPtr);
+	if (result != TCL_OK) {
+	    TRACE_WITH_OBJ((
+		    "%u => ERROR reading leaf dictionary key \"%s\": ",
+			opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+	    cleanup = opnd + 1;
+	    goto checkForCatch;
+	}
+	if (objResultPtr == NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "key \"", TclGetString(*tosPtr),
+		    "\" not known in dictionary", NULL);
+	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	    cleanup = opnd + 1;
+	    goto checkForCatch;
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(5, opnd+1, 1);
+
+    case INST_DICT_SET:
+    case INST_DICT_UNSET:
+    case INST_DICT_INCR_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
+
+	varPtr = &(compiledLocals[opnd2]);
+	part1 = varPtr->name;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u %u => ", opnd, opnd2));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    CACHE_STACK_INFO();
+	}
+	if (dictPtr == NULL) {
+	    TclNewObj(dictPtr);
+	    allocateDict = 1;
+	} else {
+	    allocateDict = Tcl_IsShared(dictPtr);
+	    if (allocateDict) {
+		dictPtr = Tcl_DuplicateObj(dictPtr);
+	    }
+	}
+
+	switch (*pc) {
+	case INST_DICT_SET:
+	    cleanup = opnd + 1;
+	    result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd, tosPtr-opnd,
+		    *tosPtr);
+	    break;
+	case INST_DICT_INCR_IMM: {
+	    long value;
+
+	    cleanup = 1;
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    result = Tcl_DictObjGet(interp, dictPtr, *tosPtr, &valPtr);
+	    if (result != TCL_OK) {
+		break;
+	    }
+	    if (valPtr == NULL) {
+		Tcl_DictObjPut(NULL, dictPtr, *tosPtr, Tcl_NewLongObj(opnd));
+	    } else {
+#warning non-long incrementing broken
+		result = Tcl_GetLongFromObj(interp, valPtr, &value);
+		if (result != TCL_OK) {
+		    break;
+		}
+		Tcl_DictObjPut(NULL, dictPtr, *tosPtr,
+			Tcl_NewLongObj(value + opnd));
+	    }
+	    break;
+	}
+	case INST_DICT_UNSET:
+	    cleanup = opnd;
+	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
+		    tosPtr - (opnd-1));
+	    break;
+	default:
+	    Tcl_Panic("Should not happen!");
+	}
+
+	if (result != TCL_OK) {
+	    if (allocateDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
+	    TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",opnd,opnd2),
+		    Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
+
+	if (TclIsVarDirectWritable(varPtr)) {
+	    if (allocateDict) {
+		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
+
+		Tcl_IncrRefCount(dictPtr);
+		if (oldValuePtr != NULL) {
+		    Tcl_DecrRefCount(oldValuePtr);
+		} else {
+		    TclSetVarScalar(varPtr);
+		    TclClearVarUndefined(varPtr);
+		}
+		varPtr->value.objPtr = dictPtr;
+	    }
+	    objResultPtr = dictPtr;
+	} else {
+	    Tcl_IncrRefCount(dictPtr);
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    Tcl_DecrRefCount(dictPtr);
+	    if (objResultPtr == NULL) {
+		TRACE_APPEND(("ERROR: %.30s\n",O2S(Tcl_GetObjResult(interp))));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+#ifndef TCL_COMPILE_DEBUG
+	if (*(pc+9) == INST_POP) {
+	    NEXT_INST_V(10, cleanup, 0);
+	}
+#endif
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(9, cleanup, 1);
+
+    case INST_DICT_APPEND:
+    case INST_DICT_LAPPEND:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	cleanup = 2;
+
+	varPtr = &(compiledLocals[opnd]);
+	part1 = varPtr->name;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    CACHE_STACK_INFO();
+	}
+	if (dictPtr == NULL) {
+	    TclNewObj(dictPtr);
+	    allocateDict = 1;
+	} else {
+	    allocateDict = Tcl_IsShared(dictPtr);
+	    if (allocateDict) {
+		dictPtr = Tcl_DuplicateObj(dictPtr);
+	    }
+	}
+
+	result = Tcl_DictObjGet(interp, dictPtr, *(tosPtr - 1), &valPtr);
+	if (result != TCL_OK) {
+	    if (allocateDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
+	    goto checkForCatch;
+	}
+
+	/*
+	 * Note that a non-existent key results in a NULL valPtr, which is a
+	 * case handled separately below. What we *can* say at this point is
+	 * that the write-back will always succeed.
+	 */
+
+	switch (*pc) {
+	case INST_DICT_APPEND:
+	    if (valPtr == NULL) {
+		valPtr = *tosPtr;
+	    } else {
+		if (Tcl_IsShared(valPtr)) {
+		    valPtr = Tcl_DuplicateObj(valPtr);
+		}
+		Tcl_AppendObjToObj(valPtr, *tosPtr);
+	    }
+	    break;
+	case INST_DICT_LAPPEND:
+	    /*
+	     * More complex because list-append can fail.
+	     */
+	    if (valPtr == NULL) {
+		valPtr = Tcl_NewListObj(1, tosPtr);
+	    } else if (Tcl_IsShared(valPtr)) {
+		Tcl_Obj *dupPtr = Tcl_DuplicateObj(valPtr);
+
+		result = Tcl_ListObjAppendElement(interp, dupPtr, *tosPtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(dupPtr);
+		    if (allocateDict) {
+			Tcl_DecrRefCount(dictPtr);
+		    }
+		    goto checkForCatch;
+		}
+	    } else {
+		result = Tcl_ListObjAppendElement(interp, valPtr, *tosPtr);
+		if (result != TCL_OK) {
+		    if (allocateDict) {
+			Tcl_DecrRefCount(dictPtr);
+		    }
+		    goto checkForCatch;
+		}
+	    }
+	    break;
+	default:
+	    Tcl_Panic("Should not happen!");
+	}
+
+	Tcl_DictObjPut(NULL, dictPtr, *(tosPtr - 1), valPtr);
+
+	if (TclIsVarDirectWritable(varPtr)) {
+	    if (allocateDict) {
+		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
+
+		Tcl_IncrRefCount(dictPtr);
+		if (oldValuePtr != NULL) {
+		    Tcl_DecrRefCount(oldValuePtr);
+		} else {
+		    TclSetVarScalar(varPtr);
+		    TclClearVarUndefined(varPtr);
+		}
+		varPtr->value.objPtr = dictPtr;
+	    }
+	    objResultPtr = dictPtr;
+	} else {
+	    Tcl_IncrRefCount(dictPtr);
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    Tcl_DecrRefCount(dictPtr);
+	    if (objResultPtr == NULL) {
+		TRACE_APPEND(("ERROR: %.30s\n",O2S(Tcl_GetObjResult(interp))));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+#ifndef TCL_COMPILE_DEBUG
+	if (*(pc+9) == INST_POP) {
+	    NEXT_INST_F(6, 2, 0);
+	}
+#endif
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(5, 2, 1);
+    }
+
+    {
+	int opnd, done;
+	Tcl_Obj *statePtr, *dictPtr, *keyPtr, *valuePtr, *emptyPtr;
+	Var *varPtr;
+	Tcl_DictSearch *searchPtr;
+
+    case INST_DICT_FIRST:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	dictPtr = POP_OBJECT();
+	searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
+	result = Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
+		&valuePtr, &done);
+	Tcl_DecrRefCount(dictPtr);
+	if (result != TCL_OK) {
+	    ckfree((char *) searchPtr);
+	    cleanup = 0;
+	    goto checkForCatch;
+	}
+	TclNewObj(statePtr);
+	statePtr->typePtr = &dictIteratorType;
+	statePtr->internalRep.otherValuePtr = (void *) searchPtr;
+	varPtr = compiledLocals + opnd;
+	if (varPtr->value.objPtr == NULL) {
+	    TclSetVarScalar(compiledLocals + opnd);
+	    TclClearVarUndefined(compiledLocals + opnd);
+	} else if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+	    Tcl_Panic("mis-issued dictFirst!");
+	} else {
+	    Tcl_DecrRefCount(varPtr->value.objPtr);
+	}
+	varPtr->value.objPtr = statePtr;
+	Tcl_IncrRefCount(statePtr);
+	goto pushDictIteratorResult;
+
+    case INST_DICT_NEXT:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	statePtr = compiledLocals[opnd].value.objPtr;
+	if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
+	    Tcl_Panic("mis-issued dictNext!");
+	}
+	searchPtr = (Tcl_DictSearch *) statePtr->internalRep.otherValuePtr;
+	Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+    pushDictIteratorResult:
+	if (done) {
+	    TclNewObj(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	} else {
+	    PUSH_OBJECT(valuePtr);
+	    PUSH_OBJECT(keyPtr);
+	}
+	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
+		O2S(*(tosPtr-1)), O2S(*tosPtr), done));
+	objResultPtr = Tcl_NewBooleanObj(done);
+	NEXT_INST_F(5, 0, 1);
+
+    case INST_DICT_DONE:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	statePtr = compiledLocals[opnd].value.objPtr;
+	if (statePtr == NULL) {
+	    Tcl_Panic("mis-issued dictDone!");
+	}
+	if (statePtr->typePtr == &dictIteratorType) {
+	    searchPtr = (Tcl_DictSearch *) statePtr->internalRep.otherValuePtr;
+	    Tcl_DictObjDone(searchPtr);
+	    ckfree((char *) searchPtr);
+	}
+	/*
+	 * Set the internal variable to an empty object to signify
+	 * that we don't hold an iterator.
+	 */
+	Tcl_DecrRefCount(statePtr);
+	TclNewObj(emptyPtr);
+	compiledLocals[opnd].value.objPtr = emptyPtr;
+	Tcl_IncrRefCount(emptyPtr);
+	NEXT_INST_F(5, 0, 0);
+    }
+
+    {
+	int opnd, i, length, length2, allocdict;
+	Tcl_Obj **keyPtrPtr, **varIdxPtrPtr, *dictPtr;
+	Var *varPtr;
+	char *part1;
+
+    case INST_DICT_UPDATE_START:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	varPtr = &(compiledLocals[opnd]);
+	part1 = varPtr->name;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL,
+		    TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (dictPtr == NULL) {
+		goto dictUpdateStartFailed;
+	    }
+	}
+	if (Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length,
+			&keyPtrPtr) != TCL_OK ||
+		Tcl_ListObjGetElements(interp, *tosPtr, &length2,
+			&varIdxPtrPtr) != TCL_OK) {
+	    goto dictUpdateStartFailed;
+	}
+	if (length != length2) {
+	    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]);
+	    part1 = varPtr->name;
+	    while (TclIsVarLink(varPtr)) {
+		varPtr = varPtr->value.linkPtr;
+	    }
+	    DECACHE_STACK_INFO();
+	    if (valPtr == NULL) {
+		Tcl_UnsetVar(interp, part1, 0);
+	    } else if (TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
+		    valPtr, TCL_LEAVE_ERR_MSG) == NULL) {
+		CACHE_STACK_INFO();
+	    dictUpdateStartFailed:
+		cleanup = 2;
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    CACHE_STACK_INFO();
+	}
+	NEXT_INST_F(5, 2, 0);
+
+    case INST_DICT_UPDATE_END:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	varPtr = &(compiledLocals[opnd]);
+	part1 = varPtr->name;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    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;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+	allocdict = Tcl_IsShared(dictPtr);
+	if (allocdict) {
+	    dictPtr = Tcl_DuplicateObj(dictPtr);
+	}	
+	for (i=0 ; i<length ; i++) {
+	    Tcl_Obj *valPtr;
+	    int varIdx;
+	    Var *var2Ptr;
+	    char *part1a;
+
+	    Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx);
+	    var2Ptr = &(compiledLocals[varIdx]);
+	    part1a = var2Ptr->name;
+	    while (TclIsVarLink(var2Ptr)) {
+		var2Ptr = var2Ptr->value.linkPtr;
+	    }
+	    if (TclIsVarDirectReadable(var2Ptr)) {
+		valPtr = var2Ptr->value.objPtr;
+	    } else {
+		DECACHE_STACK_INFO();
+		valPtr = TclPtrGetVar(interp, var2Ptr, NULL, part1a, NULL, 0);
+		CACHE_STACK_INFO();
+	    }
+	    if (valPtr == NULL) {
+		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
+	    } else {
+		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valPtr);
+	    }
+	}
+	if (TclIsVarDirectWritable(varPtr)) {
+	    Tcl_IncrRefCount(dictPtr);
+	    Tcl_DecrRefCount(varPtr->value.objPtr);
+	    varPtr->value.objPtr = dictPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (objResultPtr == NULL) {
+		if (allocdict) {
+		    Tcl_DecrRefCount(dictPtr);
+		}
+		cleanup = 2;
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+	NEXT_INST_F(5, 2, 0);
+    }
+
     default:
 	Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
     } /* end of switch on opCode */
@@ -4912,7 +5433,7 @@
 
 	while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
 		((ptrdiff_t) eePtr->stackPtr[catchTop] <=
-			(ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
+		(ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
 	    Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
 	    TclDecrRefCount(expandNestList);
 	    expandNestList = objPtr;
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.90
diff -u -r1.90 tclInt.decls
--- generic/tclInt.decls	5 Jul 2005 18:15:55 -0000	1.90
+++ generic/tclInt.decls	14 Jul 2005 14:02:57 -0000
@@ -897,6 +897,12 @@
     TclPlatformType *TclGetPlatform(void)
 }
 
+# 
+declare 225 generic {
+    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
+	    int keyc, Tcl_Obj *CONST keyv[], int flags)
+}
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.241
diff -u -r1.241 tclInt.h
--- generic/tclInt.h	5 Jul 2005 18:15:56 -0000	1.241
+++ generic/tclInt.h	14 Jul 2005 14:02:57 -0000
@@ -1711,6 +1711,33 @@
     }
 
 /*
+ * Flag values for TclTraceDictPath().
+ *
+ * DICT_PATH_READ indicates that all entries on the path must exist
+ * but no updates will be needed.
+ *
+ * DICT_PATH_UPDATE indicates that we are going to be doing an update
+ * at the tip of the path, so duplication of shared objects should be
+ * done along the way.
+ *
+ * DICT_PATH_EXISTS indicates that we are performing an existance test
+ * and a lookup failure should therefore not be an error.  If (and
+ * only if) this flag is set, TclTraceDictPath() will return the special
+ * value DICT_PATH_NON_EXISTENT if the path is not traceable.
+ *
+ * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to
+ * be set) indicates that we are to create non-existant dictionaries
+ * on the path.
+ */
+
+#define DICT_PATH_READ   0
+#define DICT_PATH_UPDATE 1
+#define DICT_PATH_EXISTS 2
+#define DICT_PATH_CREATE 5
+
+#define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1)
+
+/*
  *----------------------------------------------------------------
  * Data structures related to the filesystem internals
  *----------------------------------------------------------------
@@ -1724,6 +1751,7 @@
  * virtual filesystem interfaces, more efficiency in 'path' manipulation
  * and usage, and cleaner filesystem code internally.
  */
+
 #define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
 typedef ClientData (TclFSGetCwdProc2) _ANSI_ARGS_((ClientData clientData));
 
@@ -2441,6 +2469,8 @@
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 MODULE_SCOPE int	TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+MODULE_SCOPE int	TclCompileDictCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 MODULE_SCOPE int	TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 MODULE_SCOPE int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.81
diff -u -r1.81 tclIntDecls.h
--- generic/tclIntDecls.h	5 Jul 2005 18:15:56 -0000	1.81
+++ generic/tclIntDecls.h	14 Jul 2005 14:02:58 -0000
@@ -1157,6 +1157,13 @@
 /* 224 */
 EXTERN TclPlatformType * TclGetPlatform _ANSI_ARGS_((void));
 #endif
+#ifndef TclTraceDictPath_TCL_DECLARED
+#define TclTraceDictPath_TCL_DECLARED
+/* 225 */
+EXTERN Tcl_Obj *	TclTraceDictPath _ANSI_ARGS_((Tcl_Interp * interp, 
+				Tcl_Obj * rootPtr, int keyc, 
+				Tcl_Obj *CONST keyv[], int flags));
+#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1402,6 +1409,7 @@
     int (*tclBN_mp_init) _ANSI_ARGS_((mp_int * a)); /* 222 */
     int (*tclBN_mp_read_radix) _ANSI_ARGS_((mp_int * a, const char * str, int radix)); /* 223 */
     TclPlatformType * (*tclGetPlatform) _ANSI_ARGS_((void)); /* 224 */
+    Tcl_Obj * (*tclTraceDictPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags)); /* 225 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -2177,6 +2185,10 @@
 #define TclGetPlatform \
 	(tclIntStubsPtr->tclGetPlatform) /* 224 */
 #endif
+#ifndef TclTraceDictPath
+#define TclTraceDictPath \
+	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.119
diff -u -r1.119 tclStubInit.c
--- generic/tclStubInit.c	5 Jul 2005 18:15:58 -0000	1.119
+++ generic/tclStubInit.c	14 Jul 2005 14:02:58 -0000
@@ -309,6 +309,7 @@
     TclBN_mp_init, /* 222 */
     TclBN_mp_read_radix, /* 223 */
     TclGetPlatform, /* 224 */
+    TclTraceDictPath, /* 225 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
Index: tests/dict.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/dict.test,v
retrieving revision 1.12
diff -u -r1.12 dict.test
--- tests/dict.test	19 Oct 2004 22:20:05 -0000	1.12
+++ tests/dict.test	14 Jul 2005 14:02:58 -0000
@@ -306,6 +306,17 @@
     catch {unset dictVar}
     set result
 } {1 {can't set "dictVar": variable is array}}
+test dict-11.16 {dict incr command: compilation} {
+    proc dicttest {} {
+	set v {a 0 b 0 c 0}
+	dict incr v a
+	dict incr v b 1
+	dict incr v c 2
+	dict incr v d 3
+	list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d]
+    }
+    dicttest
+} {1 1 2 3}
 
 test dict-12.1 {dict lappend command} {
     set dictv {a a}
@@ -511,6 +522,17 @@
     catch {unset accum}
     set result
 } {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+test dict-14.16 {dict for command in compilation context} {
+    proc dicttest {} {
+	set res {x x x x x x}
+	dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
+	    lset res $v $k
+	    continue
+	}
+	return $res
+    }
+    dicttest
+} {a b c d e f}
 # There's probably a lot more tests to add here.  Really ought to use
 # a coverage tool for this job...
 
@@ -968,6 +990,19 @@
     }
     getOrder $a b d f
 } {b c d e f g 3}
+test dict-21.13 {dict update command: compilation} {
+    proc dicttest {d} {
+	while 1 {
+	    dict update d a alpha b beta {
+		set beta $alpha
+		unset alpha
+		break
+	    }
+	}
+	return $d
+    }
+    getOrder [dicttest {a 1 c 2}] b c
+} {b 1 c 2 2}
 
 test dict-22.1 {dict with command} -body {
     dict with
