Commit changes received from Brad Lanam via email

10 files changed, 542 insertions, 124 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 574b49b..1990457 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2324,6 +2324,19 @@ declare 630 {
 	    Tcl_Obj *compressionDictionaryObj)
 }
 
+# TIP #421
+declare 632 {
+    void Tcl_ArrayObjFirst(Tcl_Interp *interp,
+	Tcl_Obj *arrayObj,
+	Tcl_ArraySearch *searchPtr)
+}
+declare 633 {
+    int Tcl_ArrayObjNext(Tcl_Interp *interp,
+	Tcl_ArraySearch *searchPtr,
+	Tcl_Obj **keyPtrPtr,
+	Tcl_Obj **valuePtrPtr)
+}
+
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
 ##############################################################################
diff --git a/generic/tcl.h b/generic/tcl.h
index 7984005..ba7f997 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1335,6 +1335,37 @@ typedef struct Tcl_HashSearch {
 #define TCL_CUSTOM_PTR_KEYS	(-1)
 
 /*
+ * The following structure describes an enumerative search in progress on an
+ * array variable; this are invoked with options to the "array" command.
+ */
+
+# define TCL_ARRAYSEARCH_FOR_VALUE 0x0001
+typedef struct ArraySearch {
+    Tcl_Obj *name;		/* Name of this search */
+    int id;			/* Integer id used to distinguish among
+				 * multiple concurrent searches for the same
+				 * array. */
+    struct Var *varPtr;		/* Pointer to array variable that's being
+				 * searched. */
+    Tcl_Obj *arrayNameObj; 	/* Name of the array variable in the current
+                         	 * resolution context. Usually NULL except for
+				 * in "array for". */
+    int flags;                  /* Used by 'array for' to check if the
+                                 * value is wanted. */
+    Tcl_HashSearch search;	/* Info kept by the hash module about progress
+				 * through the array. */
+    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
+				 * be enumerated (it's leftover from the
+				 * Tcl_FirstHashEntry call or from an "array
+				 * anymore" command). NULL means must call
+				 * Tcl_NextHashEntry to get value to
+				 * return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches for
+				 * this variable, or NULL if this is the last
+				 * one. */
+} Tcl_ArraySearch;
+
+/*
  * Structure definition for information used to keep track of searches through
  * dictionaries. These fields should not be accessed by code outside
  * tclDictObj.c
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5f4c298..6c3b3f9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -49,6 +49,9 @@ static int		CompileEachloopCmd(Tcl_Interp *interp,
 static int		CompileDictEachCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr, int collect);
+static int		CompileArrayEachCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 
 /*
  * The structures below define the AuxData types defined in this file.
@@ -288,6 +291,221 @@ TclCompileArrayExistsCmd(
 }
 
 int
+TclCompileArrayForCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    return CompileArrayEachCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+CompileArrayEachCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr		/* Holds resulting instructions. */
+    )
+{
+    DefineLineInformation;
+    Tcl_Token *varsTokenPtr, *arrayTokenPtr, *bodyTokenPtr;
+    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
+    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
+    int numVars, endTargetOffset;
+    const char **argv;
+    Tcl_DString buffer;
+
+    /*
+     * There must be three arguments after the command.
+     */
+
+    if (parsePtr->numWords != 4) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    arrayTokenPtr = TokenAfter(varsTokenPtr);
+    bodyTokenPtr = TokenAfter(arrayTokenPtr);
+    if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+            arrayTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * Check we've got one or two variables and that they are local variables.
+     * Then extract their indices in the LVT.
+     */
+
+    Tcl_DStringInit(&buffer);
+    TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
+    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
+	    &argv) != TCL_OK) {
+	Tcl_DStringFree(&buffer);
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+    Tcl_DStringFree(&buffer);
+    /*
+     * both
+     *   array for {k} a {}
+     *   array for {k v} a {}
+     * are supported.
+     */
+    if (numVars != 1 && numVars != 2) {
+	ckfree(argv);
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    nameChars = strlen(argv[0]);
+    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
+    valueVarIndex = -1;
+    if (numVars == 2) {
+    nameChars = strlen(argv[1]);
+    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
+    }
+    ckfree(argv);
+
+    if ((keyVarIndex < 0) || (numVars == 2 && valueVarIndex < 0)) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * Allocate a temporary variable to store the iterator reference. The
+     * variable will contain a Tcl_ArraySearch reference which will be
+     * allocated by INST_ARRAY_FIRST and disposed when the variable is unset
+     * (at which point it should also have been finished with).
+     */
+
+    infoIndex = AnonymousLocal(envPtr);
+    if (infoIndex < 0) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * Preparation complete; issue instructions. Note that this code issues
+     * fixed-sized jumps. That simplifies things a lot!
+     */
+
+    /*
+     * Get the array and start the iteration. No catching of errors at
+     * this point.
+     */
+
+    CompileWord(envPtr, arrayTokenPtr, interp, 2);
+
+    /*
+     * Now we catch errors from here on
+     */
+
+    TclEmitInstInt4(	INST_ARRAY_FIRST, infoIndex,		envPtr);
+
+    catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
+    ExceptionRangeStarts(envPtr, catchRange);
+
+    /*
+     * Set up the loop exception targets.
+     */
+
+    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    ExceptionRangeStarts(envPtr, loopRange);
+
+    /*
+     * Inside the iteration, fetch and write the loop variables.
+     */
+
+    bodyTargetOffset = CurrentOffset(envPtr);
+
+    TclEmitInstInt4(	INST_ARRAY_NEXT, infoIndex,		envPtr);
+    emptyTargetOffset = CurrentOffset(envPtr);
+
+    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
+    TclEmitOpcode(	INST_POP,				envPtr);
+    if (valueVarIndex != -1) {
+	Emit14Inst(		INST_STORE_SCALAR, valueVarIndex,	envPtr);
+    }
+    TclEmitOpcode(	INST_POP,				envPtr);
+
+    /*
+     * Compile the loop body itself. It should be stack-neutral.
+     */
+
+    BODY(bodyTokenPtr, 3);
+    TclEmitOpcode(	INST_POP, 				envPtr);
+
+    /*
+     * 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.
+     */
+
+    TclAdjustStackDepth(-1, envPtr);
+    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+    TclEmitInstInt4(	INST_ARRAY_NEXT, infoIndex,		envPtr);
+    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
+    /*
+     * checks the 'done' boolean on the stack and if false,
+     * goes back to the top of the loop
+     */
+    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
+    endTargetOffset = CurrentOffset(envPtr);
+    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);
+
+    /*
+     * Error handler "finally" clause, which force-terminates the iteration
+     * and rethrows the error.
+     */
+
+    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+    TclEmitOpcode(	INST_END_CATCH,				envPtr);
+    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
+    TclEmitInt4(		infoIndex,			envPtr);
+    TclEmitOpcode(	INST_RETURN_STK,			envPtr);
+
+    /*
+     * Otherwise we're done and we
+     * need to pop the bogus key/value pair (pushed to keep stack calculations
+     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
+     */
+
+    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
+    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
+	    envPtr->codeStart + emptyTargetOffset);
+    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
+    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
+	    envPtr->codeStart + endTargetOffset);
+    TclEmitOpcode(	INST_POP,				envPtr);
+    TclEmitOpcode(	INST_POP,				envPtr);
+    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+    TclFinalizeLoopExceptionRange(envPtr, loopRange);
+    TclEmitOpcode(	INST_END_CATCH,				envPtr);
+
+    /*
+     * Final stage of the command (normal case) is that we push an empty
+     * object (or push the accumulator as the result object). This is done
+     * last to promote peephole optimization when it's dropped immediately.
+     */
+
+    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
+    TclEmitInt4(		infoIndex,			envPtr);
+    PushStringLiteral(envPtr, "");
+    return TCL_OK;
+}
+
+
+int
 TclCompileArraySetCmd(
     Tcl_Interp *interp,		/* Used for looking up stuff. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c0724ee..47093f3 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -522,7 +522,6 @@ InstructionDesc const tclInstructionTable[] = {
     {"arrayMakeImm",	 5,	0,	  1,	{OPERAND_LVT4}},
 	/* Forces the variable indexed by opnd to be an array. Does not touch
 	 * the stack. */
-
     {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
 	/* Invoke command named objv[0], replacing the first two words with
 	 * the word at the top of the stack;
@@ -653,7 +652,11 @@ InstructionDesc const tclInstructionTable[] = {
     {"lappendListStk",	 1,	-1,	0,	{OPERAND_NONE}},
 	/* Lappend list to general variable.
 	 * Stack:  ... varName list => ... listVarContents */
-
+    {"arrayFirst",	 5,	0,	  1,	{OPERAND_LVT4}},
+        /* Set up iteration over the array
+         * no stack effect */
+    {"arrayNext",	 5,	+3,	  1,	{OPERAND_LVT4}},
+        /* Stack: key value done */
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5ef154e..23939fc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -821,8 +821,11 @@ typedef struct ByteCode {
 #define INST_LAPPEND_LIST_ARRAY_STK	187
 #define INST_LAPPEND_LIST_STK		188
 
+#define INST_ARRAY_FIRST		189
+#define INST_ARRAY_NEXT			190
+
 /* The last opcode */
-#define LAST_INST_OPCODE		188
+#define LAST_INST_OPCODE		190
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1241,7 +1244,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	int dd = (depth);						\
 	if (dd != (envPtr)->currStackDepth) {				\
 	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
-		    (envPtr)->currStackDepth, dd);		\
+		    (envPtr)->currStackDepth, dd); \
 	}								\
     } while (0)
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b022d3c..a212fd4 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1816,6 +1816,15 @@ EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
 EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 				Tcl_ZlibStream zhandle,
 				Tcl_Obj *compressionDictionaryObj);
+/* Slot 631 is reserved */
+/* 632 */
+EXTERN void		Tcl_ArrayObjFirst(Tcl_Interp *interp,
+				Tcl_Obj *arrayObj,
+				Tcl_ArraySearch *searchPtr);
+/* 633 */
+EXTERN int		Tcl_ArrayObjNext(Tcl_Interp *interp,
+				Tcl_ArraySearch *searchPtr,
+				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2482,6 +2491,9 @@ typedef struct TclStubs {
     void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
+    void (*reserved631)(void);
+    void (*tcl_ArrayObjFirst) (Tcl_Interp *interp, Tcl_Obj *arrayObj, Tcl_ArraySearch *searchPtr); /* 632 */
+    int (*tcl_ArrayObjNext) (Tcl_Interp *interp, Tcl_ArraySearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr); /* 633 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3774,6 +3786,11 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
 #define Tcl_ZlibStreamSetCompressionDictionary \
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
+/* Slot 631 is reserved */
+#define Tcl_ArrayObjFirst \
+	(tclStubsPtr->tcl_ArrayObjFirst) /* 632 */
+#define Tcl_ArrayObjNext \
+	(tclStubsPtr->tcl_ArrayObjNext) /* 633 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1f78ead..2ef784c 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -766,6 +766,7 @@ static void		IllegalExprOperandType(Tcl_Interp *interp,
 static void		InitByteCodeExecution(Tcl_Interp *interp);
 static inline int	wordSkip(void *ptr);
 static void		ReleaseDictIterator(Tcl_Obj *objPtr);
+static void		ReleaseArrayIterator(Tcl_Obj *objPtr);
 /* Useful elsewhere, make available in tclInt.h or stubs? */
 static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
 static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
@@ -798,6 +799,11 @@ static const Tcl_ObjType dictIteratorType = {
     ReleaseDictIterator,
     NULL, NULL, NULL
 };
+static const Tcl_ObjType arrayIteratorType = {
+    "arrayIterator",
+    ReleaseArrayIterator,
+    NULL, NULL, NULL
+};
 
 /*
  *----------------------------------------------------------------------
@@ -837,6 +843,45 @@ ReleaseDictIterator(
 
     objPtr->typePtr = NULL;
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseArrayIterator --
+ *
+ *	This takes apart an array iterator that is stored in the given Tcl
+ *	object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates memory, marks the object as being untyped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseArrayIterator(
+    Tcl_Obj *objPtr)
+{
+    Tcl_ArraySearch *searchPtr;
+    Tcl_Obj *arrayPtr;
+
+    /*
+     * First kill the search, and then release the reference to the dictionary
+     * that we were holding.
+     */
+
+    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ckfree(searchPtr);
+
+    arrayPtr = objPtr->internalRep.twoPtrValue.ptr2;
+    TclDecrRefCount(arrayPtr);
+
+    objPtr->typePtr = NULL;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -4180,6 +4225,60 @@ TEBCresume(
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_V(pcAdjustment, cleanup, 1);
 
+    {
+	int done;
+	Tcl_Obj *arrayObj, *statePtr, *keyPtr, *valuePtr;
+	Tcl_Obj *emptyPtr;
+	Tcl_ArraySearch *searchPtr;
+
+    case INST_ARRAY_FIRST:
+        pcAdjustment = 1;
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	arrayObj = POP_OBJECT();
+	searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
+	Tcl_ArrayObjFirst(interp, arrayObj, searchPtr);
+	TclNewObj(statePtr);
+	statePtr->typePtr = &arrayIteratorType;
+	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
+	statePtr->internalRep.twoPtrValue.ptr2 = arrayObj;
+	varPtr = LOCAL(opnd);
+	if (varPtr->value.objPtr) {
+	    if (varPtr->value.objPtr->typePtr == &arrayIteratorType) {
+		Tcl_Panic("mis-issued arrayFirst!");
+	    }
+	    TclDecrRefCount(varPtr->value.objPtr);
+	}
+	varPtr->value.objPtr = statePtr;
+	Tcl_IncrRefCount(statePtr);
+	NEXT_INST_F(1, 0, 0); /*### ??? */
+
+    case INST_ARRAY_NEXT:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	statePtr = (*LOCAL(opnd)).value.objPtr;
+	if (statePtr == NULL || statePtr->typePtr != &arrayIteratorType) {
+	    Tcl_Panic("mis-issued dictNext!");
+	}
+	searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
+	done = Tcl_ArrayObjNext(interp, searchPtr, &keyPtr, &valuePtr);
+	if (done) {
+	    TclNewObj(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	} else {
+	    if (valuePtr != NULL) {
+		PUSH_OBJECT(valuePtr);
+	    } else {
+		PUSH_OBJECT(emptyPtr);
+	    }
+	    PUSH_OBJECT(keyPtr);
+	}
+	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
+	JUMP_PEEPHOLE_F(done, 5, 0); /* ### ??? */
+    }
+
     case INST_ARRAY_MAKE_IMM:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4257ea1..f539d1e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3497,6 +3497,9 @@ MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileArrayExistsCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArrayForCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileArraySetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2f1bb8b..2bfe27b 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1416,6 +1416,9 @@ const TclStubs tclStubs = {
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+    0, /* 631 */
+    Tcl_ArrayObjFirst, /* 632 */
+    Tcl_ArrayObjNext, /* 633 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index f162d76..60989c1 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -144,34 +144,6 @@ static const char *isArrayElement =
 #define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
 
 /*
- * The following structure describes an enumerative search in progress on an
- * array variable; this are invoked with options to the "array" command.
- */
-
-typedef struct ArraySearch {
-    Tcl_Obj *name;		/* Name of this search */
-    int id;			/* Integer id used to distinguish among
-				 * multiple concurrent searches for the same
-				 * array. */
-    struct Var *varPtr;		/* Pointer to array variable that's being
-				 * searched. */
-    Tcl_Obj *arrayNameObj;	/* Name of the array variable in the current
-				 * resolution context. Usually NULL except for
-				 * in "array for". */
-    Tcl_HashSearch search;	/* Info kept by the hash module about progress
-				 * through the array. */
-    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
-				 * be enumerated (it's leftover from the
-				 * Tcl_FirstHashEntry call or from an "array
-				 * anymore" command). NULL means must call
-				 * Tcl_NextHashEntry to get value to
-				 * return. */
-    struct ArraySearch *nextPtr;/* Next in list of all active searches for
-				 * this variable, or NULL if this is the last
-				 * one. */
-} ArraySearch;
-
-/*
  * Forward references to functions defined later in this file:
  */
 
@@ -188,7 +160,7 @@ static int		ObjMakeUpvar(Tcl_Interp *interp,
 			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
 			    const char *otherP2, const int otherFlags,
 			    Tcl_Obj *myNamePtr, int myFlags, int index);
-static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
+static Tcl_ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
 			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
 static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
 			    Interp *iPtr, Tcl_Obj *part1Ptr,
@@ -2836,13 +2808,23 @@ TclArraySet(
  *----------------------------------------------------------------------
  *
  * ArrayForNRCmd --
+ * ArrayForLoopCallback
  *
- *	These functions implement the "array for" Tcl command.  See the user
- *	documentation for details on what it does.
+ *	These functions implement the "array for" Tcl command.
+ *    array for {k} a {}
+ *    array for {k v} a {}
+ *  The array for command iterates over the array, setting the
+ *  the specified loop variables, and executing the body each iteration.
  *
- * Results:
+ *  ArrayForNRCmd() sets up the Tcl_ArraySearch structure, sets arrayNamePtr
+ *  inside the structure and calls VarHashFirstEntry to start the hash
+ *  iteration.
  *
- * Side effects:
+ *  ArrayForNRCmd() does not execute the body or set the loop variables,
+ *  it only initializes the iterator.
+ *
+ *  ArrayForLoopCallback() iterates over the entire array, executing
+ *  the body each time.
  *
  *----------------------------------------------------------------------
  */
@@ -2857,8 +2839,8 @@ ArrayForNRCmd(
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
     Tcl_Obj **varv;
-    Tcl_Obj *varNameObj;
-    ArraySearch *searchPtr = NULL;
+    Tcl_Obj *arrayNameObj;
+    Tcl_ArraySearch *searchPtr = NULL;
     Var *varPtr;
     Var *arrayPtr;
     int varc;
@@ -2888,7 +2870,7 @@ ArrayForNRCmd(
 	return TCL_ERROR;
     }
 
-    varNameObj = objv[2];
+    arrayNameObj = objv[2];
     keyVarObj = varv[0];
     valueVarObj = (varc < 2 ? NULL : varv[1]);
     scriptObj = objv[3];
@@ -2897,7 +2879,7 @@ ArrayForNRCmd(
      * Locate the array variable.
      */
 
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
 	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
     /*
@@ -2907,7 +2889,7 @@ ArrayForNRCmd(
 
     if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
 		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
 		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
 	    return TCL_ERROR;
@@ -2922,7 +2904,7 @@ ArrayForNRCmd(
 
     if ((varPtr == NULL) || !TclIsVarArray(varPtr)
 	    || TclIsVarUndefined(varPtr)) {
-	const char *varName = Tcl_GetString(varNameObj);
+	const char *varName = Tcl_GetString(arrayNameObj);
 
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"\"%s\" isn't an array", varName));
@@ -2934,19 +2916,8 @@ ArrayForNRCmd(
      * Make a new array search, put it on the stack.
      */
 
-    searchPtr = TclStackAlloc(interp, sizeof(ArraySearch));
-    searchPtr->id = 1;
-
-    /*
-     * Do not turn on VAR_SEARCH_ACTIVE in varPtr->flags. This search is not
-     * stored in the search list.
-     */
-
-    searchPtr->nextPtr = NULL;
-    searchPtr->varPtr = varPtr;
-    searchPtr->arrayNameObj = varNameObj;
-    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
-	    &searchPtr->search);
+    searchPtr = TclStackAlloc(interp, sizeof(Tcl_ArraySearch));
+    Tcl_ArrayObjFirst(interp, arrayNameObj, searchPtr);
 
     /*
      * Make sure that these objects (which we need throughout the body of the
@@ -2958,7 +2929,6 @@ ArrayForNRCmd(
 	Tcl_IncrRefCount(valueVarObj);
     }
     Tcl_IncrRefCount(scriptObj);
-    Tcl_IncrRefCount(varNameObj);
 
     /*
      * Run the script.
@@ -2969,63 +2939,67 @@ ArrayForNRCmd(
     return TCL_OK;
 }
 
-static int
-ArrayForLoopCallback(
-    ClientData data[],
+/*
+ * Tcl_ArrayObjFirst
+ *
+ * Does not execute the body or set the key/value variables.
+ *
+ */
+void
+Tcl_ArrayObjFirst(
     Tcl_Interp *interp,
-    int result)
+    Tcl_Obj *arrayObj,
+    Tcl_ArraySearch *searchPtr)
 {
-    Interp *iPtr = (Interp *) interp;
-    ArraySearch *searchPtr = data[0];
-    Tcl_Obj *keyVarObj = data[1];
-    Tcl_Obj *valueVarObj = data[2];
-    Tcl_Obj *scriptObj = data[3];
-    Tcl_Obj *arrayNameObj = searchPtr->arrayNameObj;
-    Tcl_Obj *keyObj;
-    Tcl_Obj *valueObj = NULL;
     Var *varPtr;
-    int gotValue;
+    Var *arrayPtr;
 
+    searchPtr->id = 1;
     /*
-     * Process the result from the previous execution of the script body.
+     * Do not turn on VAR_SEARCH_ACTIVE in varPtr->flags. This search is not
+     * stored in the search list.
      */
+    searchPtr->nextPtr = NULL;
+    varPtr = TclObjLookupVarEx(interp, arrayObj, NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    searchPtr->varPtr = varPtr;
+    searchPtr->arrayNameObj = arrayObj;
+    searchPtr->flags = TCL_ARRAYSEARCH_FOR_VALUE;
+    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
+	    &searchPtr->search);
+}
 
-    if (result == TCL_CONTINUE) {
-	result = TCL_OK;
-    } else if (result != TCL_OK) {
-	if (result == TCL_BREAK) {
-	    Tcl_ResetResult(interp);
-	    result = TCL_OK;
-	} else if (result == TCL_ERROR) {
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (\"array for\" body line %d)",
-		    Tcl_GetErrorLine(interp)));
-	}
-	goto done;
-    }
+int
+Tcl_ArrayObjNext(
+    Tcl_Interp *interp,
+    Tcl_ArraySearch *searchPtr,
+    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the key
+				 * written into, or NULL. */
+    Tcl_Obj **valuePtrPtr	/* Pointer to a variable to have the
+				 * value written into, or NULL.*/
+    )
+{
+    Tcl_Obj *keyObj;
+    Tcl_Obj *valueObj = NULL;
+    Var     *varPtr;
+    int     gotValue;
+    int     donerc;
 
-    /*
-     * Get the next mapping from the array.
-     */
+    donerc = 1;
 
+    gotValue = 0;
     while (1) {
 	Tcl_HashEntry *hPtr = searchPtr->nextEntry;
 
 	/*
 	 * The only time hPtr will be non-NULL is when first started.
 	 * nextEntry is set by the Tcl_FirstHashEntry call in the
-	 * ArrayForNRCmd
+	 * call to Tcl_ArrayObjFirst from ArrayForNRCmd.
 	 */
 
 	if (hPtr != NULL) {
 	    searchPtr->nextEntry = NULL;
-	    varPtr = VarHashGetValue(hPtr);
-	    if (!TclIsVarUndefined(varPtr)) {
-		gotValue = 1;
-		break;
-	    }
-	}
-	if (hPtr == NULL) {
+	} else {
 	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
 	    if (hPtr == NULL) {
 		gotValue = 0;
@@ -3040,27 +3014,81 @@ ArrayForLoopCallback(
     }
 
     if (!gotValue) {
-	Tcl_ResetResult(interp);
-	goto done;
+	donerc = 1;
+	return donerc;
     }
 
+    donerc = 0;
+
     keyObj = VarHashGetKey(varPtr);
+    *keyPtrPtr = keyObj;
+    *valuePtrPtr = NULL;
+    if (searchPtr->flags & TCL_ARRAYSEARCH_FOR_VALUE) {
+	valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj,
+                keyObj, TCL_LEAVE_ERR_MSG);
+        *valuePtrPtr = valueObj;
+    }
+
+    return donerc;
+}
+
+static int
+ArrayForLoopCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_ArraySearch *searchPtr = data[0];
+    Tcl_Obj *keyObj, *valueObj;
+    Tcl_Obj *keyVarObj = data[1];
+    Tcl_Obj *valueVarObj = data[2];
+    Tcl_Obj *scriptObj = data[3];
+    int done;
+
+    /*
+     * Process the result from the previous execution of the script body.
+     */
+
+    if (result == TCL_CONTINUE) {
+	result = TCL_OK;
+    } else if (result != TCL_OK) {
+	if (result == TCL_BREAK) {
+	    Tcl_ResetResult(interp);
+	    result = TCL_OK;
+	} else if (result == TCL_ERROR) {
+	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		    "\n    (\"array for\" body line %d)",
+		    Tcl_GetErrorLine(interp)));
+	}
+	goto done;
+    }
+
+    /*
+     * Get the next mapping from the array.
+     */
+
+    keyObj = NULL;
+    valueObj = NULL;
     if (valueVarObj != NULL) {
-	valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj,
-		TCL_LEAVE_ERR_MSG);
+      valueObj = Tcl_NewObj();
     }
+    done = Tcl_ArrayObjNext (interp, searchPtr, &keyObj, &valueObj);
 
-    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
-	    TCL_LEAVE_ERR_MSG) == NULL) {
-	result = TCL_ERROR;
+    result = TCL_OK;
+    if (done) {
+	Tcl_ResetResult(interp);
 	goto done;
     }
+    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
+      result = TCL_ERROR;
+      goto done;
+    }
     if (valueVarObj != NULL) {
-	if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    result = TCL_ERROR;
-	    goto done;
-	}
+      if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
+        result = TCL_ERROR;
+        goto done;
+      }
     }
 
     /*
@@ -3081,7 +3109,6 @@ ArrayForLoopCallback(
 	TclDecrRefCount(valueVarObj);
     }
     TclDecrRefCount(scriptObj);
-    TclDecrRefCount(arrayNameObj);
     TclStackFree(interp, searchPtr);
     return result;
 }
@@ -3163,7 +3190,7 @@ ArrayStartSearchCmd(
     Var *varPtr;
     Tcl_HashEntry *hPtr;
     int isNew;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
@@ -3179,18 +3206,19 @@ ArrayStartSearchCmd(
      * Make a new array search with a free name.
      */
 
-    searchPtr = ckalloc(sizeof(ArraySearch));
+    searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
     hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
     if (isNew) {
 	searchPtr->id = 1;
 	varPtr->flags |= VAR_SEARCH_ACTIVE;
 	searchPtr->nextPtr = NULL;
     } else {
-	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
-	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+	searchPtr->id = ((Tcl_ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
+	searchPtr->nextPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr);
     }
     searchPtr->varPtr = varPtr;
     searchPtr->arrayNameObj = NULL;
+    searchPtr->flags = 0;
     searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
 	    &searchPtr->search);
     Tcl_SetHashValue(hPtr, searchPtr);
@@ -3229,7 +3257,7 @@ ArrayAnyMoreCmd(
     Var *varPtr;
     Tcl_Obj *varNameObj, *searchObj;
     int gotValue;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3303,7 +3331,7 @@ ArrayNextElementCmd(
 {
     Var *varPtr;
     Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3382,7 +3410,7 @@ ArrayDoneSearchCmd(
     Var *varPtr;
     Tcl_HashEntry *hPtr;
     Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr, *prevPtr;
+    Tcl_ArraySearch *searchPtr, *prevPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3411,7 +3439,7 @@ ArrayDoneSearchCmd(
      */
 
     hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
-    if (searchPtr == Tcl_GetHashValue(hPtr)) {
+    if (searchPtr == (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr)) {
 	if (searchPtr->nextPtr) {
 	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
 	} else {
@@ -3419,7 +3447,7 @@ ArrayDoneSearchCmd(
 	    Tcl_DeleteHashEntry(hPtr);
 	}
     } else {
-	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+	for (prevPtr= (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
 	    if (prevPtr->nextPtr == searchPtr) {
 		prevPtr->nextPtr = searchPtr->nextPtr;
 		break;
@@ -4285,7 +4313,7 @@ TclInitArrayCmd(
 	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
-	{"for",		NULL,			TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
+	{"for",		NULL,			TclCompileArrayForCmd, ArrayForNRCmd, NULL, 0},
 	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
 	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
 	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -5080,7 +5108,7 @@ Tcl_UpvarObjCmd(
  *----------------------------------------------------------------------
  */
 
-static ArraySearch *
+static Tcl_ArraySearch *
 ParseSearchId(
     Tcl_Interp *interp,		/* Interpreter containing variable. */
     const Var *varPtr,		/* Array variable search is for. */
@@ -5092,7 +5120,7 @@ ParseSearchId(
 				 * name. */
 {
     Interp *iPtr = (Interp *) interp;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
     const char *handle = TclGetString(handleObj);
     char *end;
 
@@ -5101,14 +5129,14 @@ ParseSearchId(
 		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
 
 	/* First look for same (Tcl_Obj *) */
-	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
 		searchPtr = searchPtr->nextPtr) {
 	    if (searchPtr->name == handleObj) {
 		return searchPtr;
 	    }
 	}
 	/* Fallback: do string compares. */
-	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
 		searchPtr = searchPtr->nextPtr) {
 	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
 		return searchPtr;
@@ -5155,12 +5183,12 @@ DeleteSearches(
     register Var *arrayVarPtr)	/* Variable whose searches are to be
 				 * deleted. */
 {
-    ArraySearch *searchPtr, *nextPtr;
+    Tcl_ArraySearch *searchPtr, *nextPtr;
     Tcl_HashEntry *sPtr;
 
     if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
 	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
-	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
+	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(sPtr); searchPtr != NULL;
 		searchPtr = nextPtr) {
 	    nextPtr = searchPtr->nextPtr;
 	    Tcl_DecrRefCount(searchPtr->name);