Merge trunk

Commit changes received from Brad Lanam via email
Implementation of [array for] from Brad Lanam. See https://github.com/flightaware/Tcl-bounties/issues/12 for details.
2016-12-13 01:27:25 +00:00 · 2016-12-12 04:42:52 +00:00 · 2016-11-24 13:47:47 +00:00
45 changed files with 1082 additions and 360 deletions
@@ -23,11 +23,11 @@ Tcl interpreter handle.
 A version string consisting of one or more decimal numbers
 separated by dots.
 .AP int exact in
-1 means that only the particular version specified by
+Non-zero means that only the particular version specified by
 \fIversion\fR is acceptable.
-0 means that versions newer than \fIversion\fR are also
+Zero means that versions newer than \fIversion\fR are also
 acceptable as long as they have the same major version number
-as \fIversion\fR. Other bits have no effect.
+as \fIversion\fR.
 .BE
 .SH INTRODUCTION
 .PP
@@ -47,6 +47,13 @@ been the return value from a previous invocation of
 Returns 1 if \fIarrayName\fR is an array variable, 0 if there
 is no variable by that name or if it is a scalar variable.
 .TP
+\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR
+The first argument is a one or two element list of variable names for the
+key and value of each entry in the array.  The second argument is the
+array name to iterate over.  The third argument is the body to execute
+for each key and value returned.
+The ordering of the returned keys is undefined.
+.TP
 \fBarray get \fIarrayName\fR ?\fIpattern\fR?
 Returns a list containing pairs of elements.  The first
 element in each pair is the name of an element in \fIarrayName\fR
@@ -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 ----- #

 ##############################################################################
@@ -1334,6 +1334,37 @@ typedef struct Tcl_HashSearch {
 #define TCL_CUSTOM_TYPE_KEYS	(-2)
 #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
@@ -2409,6 +2440,10 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
 #endif

+/*
+ * TODO - tommath stubs export goes here!
+ */
+
 /*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
@@ -32,7 +32,7 @@
 */

 #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
-typedef size_t caddr_t;
+typedef unsigned long caddr_t;
 #endif

 /*
@@ -56,7 +56,7 @@ union overhead {
 	unsigned char magic1;		/* other magic number */
 #ifndef NDEBUG
 	unsigned short rmagic;		/* range magic number */
-	size_t size;		/* actual block size */
+	unsigned long size;		/* actual block size */
 	unsigned short unused2;		/* padding to 8-byte align */
 #endif
    } ovu;
@@ -133,7 +133,7 @@ static int allocInit = 0;
 * a given block size.
 */

-static	size_t numMallocs[NBUCKETS+1];
+static	unsigned int numMallocs[NBUCKETS+1];
 #endif

 #if !defined(NDEBUG)
@@ -148,7 +148,7 @@ static	size_t numMallocs[NBUCKETS+1];
 * Prototypes for functions used only in this file.
 */

-static void		MoreCore(size_t bucket);
+static void		MoreCore(int bucket);

 /*
 *-------------------------------------------------------------------------
@@ -254,7 +254,7 @@ TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
 {
    register union overhead *overPtr;
-    register size_t bucket;
+    register long bucket;
    register unsigned amount;
    struct block *bigBlockPtr = NULL;

@@ -385,12 +385,12 @@ TclpAlloc(

 static void
 MoreCore(
-    size_t bucket)	/* What bucket to allocate to. */
+    int bucket)			/* What bucket to allocat to. */
 {
    register union overhead *overPtr;
-    register size_t size;	/* size of desired block */
-    size_t amount;		/* amount to allocate */
-    size_t numBlocks;		/* how many blocks we get */
+    register long size;		/* size of desired block */
+    long amount;		/* amount to allocate */
+    int numBlocks;		/* how many blocks we get */
    struct block *blockPtr;

    /*
@@ -398,14 +398,14 @@ MoreCore(
     * VAX, I think) or for a negative arg.
     */

-    size = ((size_t)1) << (bucket + 3);
+    size = 1 << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

-    blockPtr = (struct block *) TclpSysAlloc(
+    blockPtr = (struct block *) TclpSysAlloc((unsigned)
 	    (sizeof(struct block) + amount), 1);
    /* no more room! */
    if (blockPtr == NULL) {
@@ -448,7 +448,7 @@ void
 TclpFree(
    char *oldPtr)		/* Pointer to memory to free. */
 {
-    register size_t size;
+    register long size;
    register union overhead *overPtr;
    struct block *bigBlockPtr;

@@ -518,7 +518,7 @@ TclpRealloc(
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
-    size_t maxSize;
+    unsigned long maxSize;

    if (oldPtr == NULL) {
 	return TclpAlloc(numBytes);
@@ -645,30 +645,30 @@ void
 mstats(
    char *s)			/* Where to write info. */
 {
-    register unsigned int i, j;
+    register int i, j;
    register union overhead *overPtr;
-    size_t totalFree = 0, totalUsed = 0;
+    int totalFree = 0, totalUsed = 0;

    Tcl_MutexLock(allocMutexPtr);

    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
    for (i = 0; i < NBUCKETS; i++) {
 	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
-	    fprintf(stderr, " %u", j);
+	    fprintf(stderr, " %d", j);
 	}
-	totalFree += ((size_t)j) * (1 << (i + 3));
+	totalFree += j * (1 << (i + 3));
    }

    fprintf(stderr, "\nused:\t");
    for (i = 0; i < NBUCKETS; i++) {
-	fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]);
+	fprintf(stderr, " %d", numMallocs[i]);
 	totalUsed += numMallocs[i] * (1 << (i + 3));
    }

-    fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n",
-	(Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree);
-    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n",
-	    MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]);
+    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
+	    totalUsed, totalFree);
+    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
+	    MAXMALLOC, numMallocs[NBUCKETS]);

    Tcl_MutexUnlock(allocMutexPtr);
 }
@@ -1543,7 +1543,7 @@ AssembleOneLine(
 	 * Add the (label_name, address) pair to the hash table.
 	 */

-	if (DefineLabel(assemEnvPtr, TclGetString(operand1Obj)) != TCL_OK) {
+	if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
 	    goto cleanup;
 	}
 	break;
@@ -1722,7 +1722,7 @@ AssembleOneLine(

    default:
 	Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
-		TclGetString(instNameObj));
+		Tcl_GetString(instNameObj));
    }

    status = TCL_OK;
@@ -1985,15 +1985,15 @@ CreateMirrorJumpTable(

    DEBUG_PRINT("jump table {\n");
    for (i = 0; i < objc; i+=2) {
-	DEBUG_PRINT("  %s -> %s\n", TclGetString(objv[i]),
-		TclGetString(objv[i+1]));
-	hashEntry = Tcl_CreateHashEntry(jtHashPtr, TclGetString(objv[i]),
+	DEBUG_PRINT("  %s -> %s\n", Tcl_GetString(objv[i]),
+		Tcl_GetString(objv[i+1]));
+	hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
 		&isNew);
 	if (!isNew) {
 	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"duplicate entry in jump table for \"%s\"",
-			TclGetString(objv[i])));
+			Tcl_GetString(objv[i])));
 		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
 		DeleteMirrorJumpTable(jtPtr);
 		return TCL_ERROR;
@@ -2801,7 +2801,7 @@ CalculateJumpRelocations(

 	    if (bbPtr->jumpTarget != NULL) {
 		entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-			TclGetString(bbPtr->jumpTarget));
+			Tcl_GetString(bbPtr->jumpTarget));
 		if (entry == NULL) {
 		    ReportUndefinedLabel(assemEnvPtr, bbPtr,
 			    bbPtr->jumpTarget);
@@ -2882,10 +2882,10 @@ CheckJumpTableLabels(
 	    symEntryPtr = Tcl_NextHashEntry(&search)) {
 	symbolObj = Tcl_GetHashValue(symEntryPtr);
 	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		TclGetString(symbolObj));
+		Tcl_GetString(symbolObj));
 	DEBUG_PRINT("  %s -> %s (%d)\n",
 		(char*) Tcl_GetHashKey(symHash, symEntryPtr),
-		TclGetString(symbolObj), (valEntryPtr != NULL));
+		Tcl_GetString(symbolObj), (valEntryPtr != NULL));
 	if (valEntryPtr == NULL) {
 	    ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
 	    return TCL_ERROR;
@@ -2923,9 +2923,9 @@ ReportUndefinedLabel(

    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"undefined label \"%s\"", TclGetString(jumpTarget)));
+		"undefined label \"%s\"", Tcl_GetString(jumpTarget)));
 	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
-		TclGetString(jumpTarget), NULL);
+		Tcl_GetString(jumpTarget), NULL);
 	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
    }
 }
@@ -3008,7 +3008,7 @@ FillInJumpOffsets(
 	    bbPtr = bbPtr->successor1) {
 	if (bbPtr->jumpTarget != NULL) {
 	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    TclGetString(bbPtr->jumpTarget));
+		    Tcl_GetString(bbPtr->jumpTarget));
 	    jumpTarget = Tcl_GetHashValue(entry);
 	    fromOffset = bbPtr->jumpOffset;
 	    targetOffset = jumpTarget->startOffset;
@@ -3080,17 +3080,17 @@ ResolveJumpTableTargets(
 	    symEntryPtr != NULL;
 	    symEntryPtr = Tcl_NextHashEntry(&search)) {
 	symbolObj = Tcl_GetHashValue(symEntryPtr);
-	DEBUG_PRINT("     symbol %s\n", TclGetString(symbolObj));
+	DEBUG_PRINT("     symbol %s\n", Tcl_GetString(symbolObj));

 	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		TclGetString(symbolObj));
+		Tcl_GetString(symbolObj));
 	jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);

 	realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
 		Tcl_GetHashKey(symHash, symEntryPtr), &junk);
 	DEBUG_PRINT("  %s -> %s -> bb %p (pc %d)    hash entry %p\n",
 		(char*) Tcl_GetHashKey(symHash, symEntryPtr),
-		TclGetString(symbolObj), jumpTargetBBPtr,
+		Tcl_GetString(symbolObj), jumpTargetBBPtr,
 		jumpTargetBBPtr->startOffset, realJumpEntryPtr);

 	Tcl_SetHashValue(realJumpEntryPtr,
@@ -3462,7 +3462,7 @@ StackCheckBasicBlock(

    if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
 	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		TclGetString(blockPtr->jumpTarget));
+		Tcl_GetString(blockPtr->jumpTarget));
 	jumpTarget = Tcl_GetHashValue(entry);
 	result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
 		stackDepth);
@@ -3479,7 +3479,7 @@ StackCheckBasicBlock(
 		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
 	    targetLabel = Tcl_GetHashValue(jtEntry);
 	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    TclGetString(targetLabel));
+		    Tcl_GetString(targetLabel));
 	    jumpTarget = Tcl_GetHashValue(entry);
 	    result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
 		    blockPtr, stackDepth);
@@ -3784,7 +3784,7 @@ ProcessCatchesInBasicBlock(
    }
    if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
 	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		TclGetString(bbPtr->jumpTarget));
+		Tcl_GetString(bbPtr->jumpTarget));
 	jumpTarget = Tcl_GetHashValue(entry);
 	result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
 		jumpEnclosing, jumpState, catchDepth);
@@ -3800,7 +3800,7 @@ ProcessCatchesInBasicBlock(
 		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
 	    targetLabel = Tcl_GetHashValue(jtEntry);
 	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    TclGetString(targetLabel));
+		    Tcl_GetString(targetLabel));
 	    jumpTarget = Tcl_GetHashValue(entry);
 	    result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
 		    jumpEnclosing, jumpState, catchDepth);
@@ -4104,7 +4104,7 @@ StackFreshCatches(
 	    range->codeOffset = bbPtr->startOffset;

 	    entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    TclGetString(catch->jumpTarget));
+		    Tcl_GetString(catch->jumpTarget));
 	    if (entryPtr == NULL) {
 		Tcl_Panic("undefined label in tclAssembly.c:"
 			"BuildExceptionRanges, can't happen");
@@ -531,8 +531,7 @@ SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
 {
-    size_t length;
-    int improper = 0;
+    int length, improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    ByteArray *byteArrayPtr;
@@ -545,8 +544,7 @@ SetByteArrayFromAny(
 	return TCL_OK;
    }

-    src = TclGetString(objPtr);
-    length = objPtr->length;
+    src = TclGetStringFromObj(objPtr, &length);
    srcEnd = src + length;

    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
@@ -92,7 +92,7 @@ static const char *const literals[] = {
 */

 typedef struct ClockClientData {
-    size_t refCount;		/* Number of live references. */
+    int refCount;		/* Number of live references. */
    Tcl_Obj **literals;		/* Pool of object literals. */
 } ClockClientData;

@@ -2060,7 +2060,8 @@ ClockDeleteCmdProc(
    ClockClientData *data = clientData;
    int i;

-    if (data->refCount-- <= 1) {
+    data->refCount--;
+    if (data->refCount == 0) {
 	for (i = 0; i < LIT__END; ++i) {
 	    Tcl_DecrRefCount(data->literals[i]);
 	}
@@ -4157,7 +4157,7 @@ TclNRTryObjCmd(
 	    }

 	    info[0] = objv[i];			/* type */
-	    TclNewLongObj(info[1], code);	/* returnCode */
+	    TclNewIntObj(info[1], code);	/* returnCode */
 	    if (info[2] == NULL) {		/* errorCodePrefix */
 		TclNewObj(info[2]);
 	    }
@@ -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.
@@ -287,6 +290,221 @@ TclCompileArrayExistsCmd(
    return TCL_OK;
 }

+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. */
@@ -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}}
 };

@@ -765,8 +768,7 @@ TclSetByteCodeFromAny(
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
 				 * in frame. */
-    size_t length;
-    int result = TCL_OK;
+    int length, result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;
@@ -781,8 +783,7 @@ TclSetByteCodeFromAny(
    }
 #endif

-    stringPtr = TclGetString(objPtr);
-    length = objPtr->length;
+    stringPtr = TclGetStringFromObj(objPtr, &length);

    /*
     * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
@@ -2978,8 +2979,7 @@ TclFindCompiledLocal(
 	varNamePtr = &cachePtr->varName0;
 	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
 	    if (*varNamePtr) {
-		localName = TclGetString(*varNamePtr);
-		len = (*varNamePtr)->length;
+		localName = TclGetStringFromObj(*varNamePtr, &len);
 		if ((len == nameBytes) && !strncmp(name, localName, len)) {
 		    return i;
 		}
@@ -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)

@@ -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) */

@@ -46,7 +46,7 @@ typedef struct Encoding {
 				 * nullSize is 2, this is a function that
 				 * returns the number of bytes in a 0x0000
 				 * terminated string. */
-    size_t refCount;		/* Number of uses of this structure. */
+    int refCount;		/* Number of uses of this structure. */
    Tcl_HashEntry *hPtr;	/* Hash table entry that owns this encoding. */
 } Encoding;

@@ -844,7 +844,11 @@ FreeEncoding(
    if (encodingPtr == NULL) {
 	return;
    }
-    if (encodingPtr->refCount-- <= 1) {
+    if (encodingPtr->refCount<=0) {
+	Tcl_Panic("FreeEncoding: refcount problem !!!");
+    }
+    encodingPtr->refCount--;
+    if (encodingPtr->refCount == 0) {
 	if (encodingPtr->freeProc != NULL) {
 	    encodingPtr->freeProc(encodingPtr->clientData);
 	}
@@ -3306,7 +3306,7 @@ CompileToInvokedCommand(
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    char *bytes;
-    int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
+    int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
    DefineLineInformation;

    /*
@@ -3319,8 +3319,8 @@ CompileToInvokedCommand(
    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
 	    i++, tokPtr = TokenAfter(tokPtr)) {
 	if (i > 0 && i < numWords+1) {
-	    bytes = TclGetString(words[i-1]);
-	    PushLiteral(envPtr, bytes, words[i-1]->length);
+	    bytes = TclGetStringFromObj(words[i-1], &length);
+	    PushLiteral(envPtr, bytes, length);
 	    continue;
 	}

@@ -3348,11 +3348,11 @@ CompileToInvokedCommand(

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
-    bytes = TclGetString(objPtr);
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
 	extraLiteralFlags |= LITERAL_UNSHARED;
    }
-    cmdLit = TclRegisterLiteral(envPtr, bytes, objPtr->length, extraLiteralFlags);
+    cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);
@@ -325,7 +325,7 @@ VarHashCreateVar(
 	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
 	default:							\
 	    if ((condition) < 0) {					\
-		TclNewLongObj(objResultPtr, -1);				\
+		TclNewIntObj(objResultPtr, -1);				\
 	    } else {							\
 		objResultPtr = TCONST((condition) > 0);			\
 	    }								\
@@ -346,7 +346,7 @@ VarHashCreateVar(
 	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
 	default:							\
 	    if ((condition) < 0) {					\
-		TclNewLongObj(objResultPtr, -1);				\
+		TclNewIntObj(objResultPtr, -1);				\
 	    } else {							\
 		objResultPtr = TCONST((condition) > 0);			\
 	    }								\
@@ -357,7 +357,7 @@ VarHashCreateVar(
 #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
    do{									\
 	if ((condition) < 0) {						\
-	    TclNewLongObj(objResultPtr, -1);				\
+	    TclNewIntObj(objResultPtr, -1);				\
 	} else {							\
 	    objResultPtr = TCONST((condition) > 0);			\
 	}								\
@@ -366,7 +366,7 @@ VarHashCreateVar(
 #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
    do{									\
 	if ((condition) < 0) {						\
-	    TclNewLongObj(objResultPtr, -1);				\
+	    TclNewIntObj(objResultPtr, -1);				\
 	} else {							\
 	    objResultPtr = TCONST((condition) > 0);			\
 	}								\
@@ -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;
+}

 /*
 *----------------------------------------------------------------------
@@ -1541,10 +1586,11 @@ CompileExprObj(
 	 * TIP #280: No invoker (yet) - Expression compilation.
 	 */

-	const char *string = TclGetString(objPtr);
+	int length;
+	const char *string = TclGetStringFromObj(objPtr, &length);

-	TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
-	TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);
+	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+	TclCompileExpr(interp, string, length, &compEnv, 0);

 	/*
 	 * Successful compilation. If the expression yielded no instructions,
@@ -4034,13 +4080,12 @@ TEBCresume(
 	}
 	TRACE(("%s %u \"%.30s\" => ",
 		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
-	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
-		&& !TclIsVarArraySearched(arrayPtr)) {
+	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
 	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
 		/*
-		 * No nasty traces or searchesw and element exists, so we can
-		 * proceed to unset it. Might still not exist though...
+		 * No nasty traces and element exists, so we can proceed to
+		 * unset it. Might still not exist though...
 		 */

 		if (!TclIsVarUndefined(varPtr)) {
@@ -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;
@@ -4529,7 +4628,7 @@ TEBCresume(
 	NEXT_INST_F(1, 0, 1);
    }
    case INST_INFO_LEVEL_NUM:
-	TclNewLongObj(objResultPtr, iPtr->varFramePtr->level);
+	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
    case INST_INFO_LEVEL_ARGS: {
@@ -4898,7 +4997,7 @@ TEBCresume(
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
-	TclNewLongObj(objResultPtr, length);
+	TclNewIntObj(objResultPtr, length);
 	TRACE_APPEND(("%d\n", length));
 	NEXT_INST_F(1, 1, 1);

@@ -5369,7 +5468,7 @@ TEBCresume(
    case INST_STR_LEN:
 	valuePtr = OBJ_AT_TOS;
 	length = Tcl_GetCharLength(valuePtr);
-	TclNewLongObj(objResultPtr, length);
+	TclNewIntObj(objResultPtr, length);
 	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);

@@ -5724,7 +5823,7 @@ TEBCresume(

 	TRACE(("%.20s %.20s => %d\n",
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-	TclNewLongObj(objResultPtr, match);
+	TclNewIntObj(objResultPtr, match);
 	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
@@ -5732,7 +5831,7 @@ TEBCresume(

 	TRACE(("%.20s %.20s => %d\n",
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-	TclNewLongObj(objResultPtr, match);
+	TclNewIntObj(objResultPtr, match);
 	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
@@ -5936,7 +6035,7 @@ TEBCresume(
 		type1 = TCL_NUMBER_WIDE;
 	    }
 	}
-	TclNewLongObj(objResultPtr, type1);
+	TclNewIntObj(objResultPtr, type1);
 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
 	NEXT_INST_F(1, 1, 1);

@@ -6143,7 +6242,7 @@ TEBCresume(
 			if (l1 > 0L) {
 			    objResultPtr = TCONST(0);
 			} else {
-			    TclNewLongObj(objResultPtr, -1);
+			    TclNewIntObj(objResultPtr, -1);
 			}
 			TRACE(("%s\n", O2S(objResultPtr)));
 			NEXT_INST_F(1, 2, 1);
@@ -7043,7 +7142,7 @@ TEBCresume(
 	NEXT_INST_F(1, 0, -1);

    case INST_PUSH_RETURN_CODE:
-	TclNewLongObj(objResultPtr, result);
+	TclNewIntObj(objResultPtr, result);
 	TRACE(("=> %u\n", result));
 	NEXT_INST_F(1, 0, 1);

@@ -323,7 +323,7 @@ typedef struct ResolvedChanName {
    Tcl_Interp *interp;		/* The interp in which the lookup was done. */
    int epoch;			/* The epoch of the channel when the lookup
 				 * was done. Use to verify validity. */
-    size_t refCount;		/* Share this struct among many Tcl_Obj. */
+    int refCount;		/* Share this struct among many Tcl_Obj. */
 } ResolvedChanName;

 static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
@@ -11194,7 +11194,7 @@ FreeChannelIntRep(
    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
-    if (resPtr->refCount-- > 1) {
+    if (--resPtr->refCount) {
 	return;
    }
    Tcl_Release(resPtr->statePtr);
@@ -804,7 +804,6 @@ typedef struct VarInHash {
 * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);
- * MODULE_SCOPE int	TclIsVarArraySearched(Var *varPtr);
 */

 #define TclIsVarScalar(varPtr) \
@@ -846,9 +845,6 @@ typedef struct VarInHash {
 #define TclIsVarDeadHash(varPtr) \
    ((varPtr)->flags & VAR_DEAD_HASH)

-#define TclIsVarArraySearched(varPtr) \
-    ((varPtr)->flags & VAR_SEARCH_ACTIVE)
-
 #define TclGetVarNsPtr(varPtr) \
    (TclIsVarInHash(varPtr) \
 	? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
@@ -3503,6 +3499,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);
@@ -4566,12 +4565,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
+ * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, int i);
 * MODULE_SCOPE void	TclNewLongObj(Tcl_Obj *objPtr, long l);
 * MODULE_SCOPE void	TclNewBooleanObj(Tcl_Obj *objPtr, int b);
 * MODULE_SCOPE void	TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
- * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
- * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
+ * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
+ * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
 *
 *----------------------------------------------------------------
 */
@@ -4588,6 +4588,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
 	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

+#define TclNewIntObj(objPtr, l) \
+    TclNewLongObj(objPtr, l)
+
 /*
 * NOTE: There is to be no such thing as a "pure" boolean.
 * See comment above TclSetBooleanObj macro above.
@@ -4617,6 +4620,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
    } while (0)

 #else /* TCL_MEM_DEBUG */
+#define TclNewIntObj(objPtr, i) \
+    (objPtr) = Tcl_NewIntObj(i)
+
 #define TclNewLongObj(objPtr, l) \
    (objPtr) = Tcl_NewLongObj(l)

@@ -410,7 +410,6 @@ Tcl_Init(
 "	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
 "	{file join $parentDir library} \\\n"
 "	{file join $grandParentDir library} \\\n"
-"	{file join $grandParentDir tcl[info tclversion] library} \\\n"
 "	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
 "	{\n"
 "file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
@@ -393,9 +393,8 @@ LinkTraceProc(
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have integer value";
-	} else {
-	    LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	}
+	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	break;

    case TCL_LINK_DOUBLE:
@@ -408,9 +407,8 @@ LinkTraceProc(
 			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
 		return (char *) "variable must have real value";
 #ifdef ACCEPT_NAN
-	    } else {
-		linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
 	    }
+	    linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
 #endif
 	}
 	LinkedVar(double) = linkPtr->lastValue.d;
@@ -427,7 +425,7 @@ LinkTraceProc(
 	break;

    case TCL_LINK_CHAR:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -438,7 +436,7 @@ LinkTraceProc(
 	break;

    case TCL_LINK_UCHAR:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < 0 || valueInt > UCHAR_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -449,7 +447,7 @@ LinkTraceProc(
 	break;

    case TCL_LINK_SHORT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -460,7 +458,7 @@ LinkTraceProc(
 	break;

    case TCL_LINK_USHORT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < 0 || valueInt > USHRT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -471,38 +469,35 @@ LinkTraceProc(
 	break;

    case TCL_LINK_UINT:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < 0 || valueWide > UINT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have unsigned int value";
-	} else {
-	    linkPtr->lastValue.ui = (unsigned int)valueWide;
 	}
+	linkPtr->lastValue.ui = (unsigned int)valueWide;
 	LinkedVar(unsigned int) = linkPtr->lastValue.ui;
 	break;

    case TCL_LINK_LONG:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have long value";
-	} else {
-	    linkPtr->lastValue.l = (long)valueWide;
 	}
+	linkPtr->lastValue.l = (long)valueWide;
 	LinkedVar(long) = linkPtr->lastValue.l;
 	break;

    case TCL_LINK_ULONG:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have unsigned long value";
-	} else {
-	    linkPtr->lastValue.ul = (unsigned long)valueWide;
 	}
+	linkPtr->lastValue.ul = (unsigned long)valueWide;
 	LinkedVar(unsigned long) = linkPtr->lastValue.ul;
 	break;

@@ -510,25 +505,23 @@ LinkTraceProc(
 	/*
 	 * FIXME: represent as a bignum.
 	 */
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have unsigned wide int value";
-	} else {
-	    linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
 	}
+	linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
 	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
 	break;

    case TCL_LINK_FLOAT:
-	if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
+	if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
 		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return (char *) "variable must have float value";
-	} else {
-	    linkPtr->lastValue.f = (float)valueDouble;
 	}
+	linkPtr->lastValue.f = (float)valueDouble;
 	LinkedVar(float) = linkPtr->lastValue.f;
 	break;

@@ -584,7 +577,7 @@ ObjValue(
 	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:
 	linkPtr->lastValue.i = LinkedVar(int);
-	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
+	return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
    case TCL_LINK_CHAR:
 	linkPtr->lastValue.c = LinkedVar(char);
 	return Tcl_NewIntObj(linkPtr->lastValue.c);
@@ -1810,7 +1810,7 @@ Tcl_DbNewBooleanObj(
    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

-    objPtr->internalRep.longValue = (boolValue != 0);
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
    objPtr->typePtr = &tclIntType;
    return objPtr;
 }
@@ -2425,7 +2425,7 @@ Tcl_NewIntObj(
 {
    register Tcl_Obj *objPtr;

-    TclNewLongObj(objPtr, intValue);
+    TclNewIntObj(objPtr, intValue);
    return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -1865,14 +1865,6 @@ Tcl_AppendFormatToObj(
 		useWide = 1;
 #endif
 	    }
-	} else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) {
-	    format += (step + 2);
-	    step = Tcl_UtfToUniChar(format, &ch);
-	    useBig = 1;
-	} else if (ch == 'L') {
-	    format += step;
-	    step = Tcl_UtfToUniChar(format, &ch);
-	    useBig = 1;
 	}

 	format += step;
@@ -2517,17 +2509,6 @@ AppendPrintfToObjVA(
 		++size;
 		p++;
 		break;
-	    case 'L':
-		size = 2;
-		p++;
-		break;
-	    case 'I':
-		if (p[1]=='6' && p[2]=='4') {
-		    p += 2;
-		    size = 2;
-		}
-		p++;
-		break;
 	    case 'h':
 		size = -1;
 	    default:
@@ -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. */
@@ -101,16 +101,12 @@ Tcl_InitStubs(
 	    }
 	}
    }
-    if (((exact&0xff00) < 0x900)) {
-	/* We are running Tcl 8.x */
-	stubsPtr = (TclStubs *)pkgData;
-    }
-    tclStubsPtr = stubsPtr;
+    tclStubsPtr = (TclStubs *)pkgData;

-    if (stubsPtr->hooks) {
-	tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
-	tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
-	tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;
+    if (tclStubsPtr->hooks) {
+	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
    } else {
 	tclPlatStubsPtr = NULL;
 	tclIntStubsPtr = NULL;
@@ -318,9 +318,6 @@ static int		TestparsevarnameObjCmd(ClientData dummy,
 static int		TestpreferstableObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static int		TestprintObjCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 static int		TestregexpObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -544,10 +541,10 @@ Tcltest_Init(
 	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
 	return TCL_ERROR;
    }
-    if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) {
+    if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
 	return TCL_ERROR;
    }
    if (Tcl_OOInitStubs(interp) == NULL) {
@@ -652,8 +649,6 @@ Tcltest_Init(
 	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
 	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
-	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
 	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -786,7 +781,7 @@ int
 Tcltest_SafeInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
 {
-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
 	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
@@ -3822,43 +3817,6 @@ TestpreferstableObjCmd(
    return TCL_OK;
 }

-/*
- *----------------------------------------------------------------------
- *
- * TestprintObjCmd --
- *
- *	This procedure implements the "testprint" command.  It is
- *	used for being able to test the Tcl_ObjPrintf() function.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestprintObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
-{
-    Tcl_WideInt argv1 = 0;
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");   
-    }
-
-    if (objc > 1) {
-	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
-    }
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1));
-    return TCL_OK;
-}
-
 /*
 *----------------------------------------------------------------------
 *
@@ -4639,7 +4597,7 @@ TestpanicCmd(
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
 {
-    char *argString;
+    const char *argString;

    /*
     *  Put the arguments into a var args structure
@@ -143,37 +143,13 @@ 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_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:
 */

 static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *patternPtr, int includeLinks);
+static Tcl_NRPostProc	ArrayForLoopCallback;
 static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
 static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
 			    Var *varPtr, int flags, int index);
@@ -184,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,
@@ -2828,6 +2804,315 @@ TclArraySet(
    return TCL_OK;
 }

+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayForNRCmd --
+ * ArrayForLoopCallback
+ *
+ *	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.
+ *
+ *  ArrayForNRCmd() sets up the Tcl_ArraySearch structure, sets arrayNamePtr
+ *  inside the structure and calls VarHashFirstEntry to start the hash
+ *  iteration.
+ *
+ *  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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ArrayForNRCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
+    Tcl_Obj **varv;
+    Tcl_Obj *arrayNameObj;
+    Tcl_ArraySearch *searchPtr = NULL;
+    Var *varPtr;
+    Var *arrayPtr;
+    int varc;
+
+    /*
+     * array for {k} a body
+     * array for {k v} a body
+     */
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"{keyVarName ?valueVarName?} array script");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse arguments.
+     */
+
+    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (varc < 1 || varc > 2) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"must have one or two variable names", -1));
+	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
+	return TCL_ERROR;
+    }
+
+    arrayNameObj = objv[2];
+    keyVarObj = varv[0];
+    valueVarObj = (varc < 2 ? NULL : varv[1]);
+    scriptObj = objv[3];
+
+    /*
+     * Locate the array variable.
+     */
+
+    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+    /*
+     * Special array trace used to keep the env array in sync for array names,
+     * array get, etc.
+     */
+
+    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+	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;
+	}
+    }
+
+    /*
+     * Verify that it is indeed an array variable. This test comes after the
+     * traces; the variable may actually become an array as an effect of said
+     * traces.
+     */
+
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	const char *varName = Tcl_GetString(arrayNameObj);
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", varName));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make a new array search, put it on the stack.
+     */
+
+    searchPtr = TclStackAlloc(interp, sizeof(Tcl_ArraySearch));
+    Tcl_ArrayObjFirst(interp, arrayNameObj, searchPtr);
+
+    /*
+     * Make sure that these objects (which we need throughout the body of the
+     * loop) don't vanish.
+     */
+
+    Tcl_IncrRefCount(keyVarObj);
+    if (valueVarObj != NULL) {
+	Tcl_IncrRefCount(valueVarObj);
+    }
+    Tcl_IncrRefCount(scriptObj);
+
+    /*
+     * Run the script.
+     */
+
+    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
+	    valueVarObj, scriptObj);
+    return TCL_OK;
+}
+
+/*
+ * Tcl_ArrayObjFirst
+ *
+ * Does not execute the body or set the key/value variables.
+ *
+ */
+void
+Tcl_ArrayObjFirst(
+    Tcl_Interp *interp,
+    Tcl_Obj *arrayObj,
+    Tcl_ArraySearch *searchPtr)
+{
+    Var *varPtr;
+    Var *arrayPtr;
+
+    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;
+    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);
+}
+
+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;
+
+    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
+	 * call to Tcl_ArrayObjFirst from ArrayForNRCmd.
+	 */
+
+	if (hPtr != NULL) {
+	    searchPtr->nextEntry = NULL;
+	} else {
+	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
+	    if (hPtr == NULL) {
+		gotValue = 0;
+		break;
+	    }
+	}
+	varPtr = VarHashGetValue(hPtr);
+	if (!TclIsVarUndefined(varPtr)) {
+	    gotValue = 1;
+	    break;
+	}
+    }
+
+    if (!gotValue) {
+	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_NewObj();
+    }
+    done = Tcl_ArrayObjNext (interp, searchPtr, &keyObj, &valueObj);
+
+    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;
+      }
+    }
+
+    /*
+     * Run the script.
+     */
+
+    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
+	    valueVarObj, scriptObj);
+    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+    /*
+     * For unwinding everything once the iterating is done.
+     */
+
+  done:
+    TclDecrRefCount(keyVarObj);
+    if (valueVarObj != NULL) {
+	TclDecrRefCount(valueVarObj);
+    }
+    TclDecrRefCount(scriptObj);
+    TclStackFree(interp, searchPtr);
+    return result;
+}
+
 /*
 *----------------------------------------------------------------------
 *
@@ -2905,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");
@@ -2921,17 +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);
@@ -2970,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");
@@ -3044,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");
@@ -3123,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");
@@ -3152,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 {
@@ -3160,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;
@@ -4026,6 +4313,7 @@ TclInitArrayCmd(
 	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, 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},
@@ -4820,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. */
@@ -4832,7 +5120,7 @@ ParseSearchId(
 				 * name. */
 {
    Interp *iPtr = (Interp *) interp;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
    const char *handle = TclGetString(handleObj);
    char *end;

@@ -4841,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;
@@ -4895,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);
@@ -373,7 +373,7 @@ ConvertErrorToList(

    default:
 	TclNewLiteralStringObj(objv[2], "UNKNOWN");
-	TclNewLongObj(objv[3], code);
+	TclNewIntObj(objv[3], code);
 	return Tcl_NewListObj(4, objv);
    }
 }
@@ -23,7 +23,7 @@ cd [temporaryDirectory]
 testConstraint testsetplatform [llength [info commands testsetplatform]]
 testConstraint testchmod [llength [info commands testchmod]]
 testConstraint winVista 0
-testConstraint winXP 0
+testConstraint win2000orXP 0
 # Don't know how to determine this constraint correctly
 testConstraint notNetworkFilesystem 0
 testConstraint reg 0
@@ -66,10 +66,12 @@ if {[testConstraint unix]} {
 # Also used in winFCmd...
 if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
-    if {$major > 5} {
-	testConstraint winVista 1
-    } else {
-	testConstraint winXP 1
+    if {[testConstraint nt] && $major > 4} {
+        if {$major > 5} {
+            testConstraint winVista 1
+        } elseif {$major == 5} {
+            testConstraint win2000orXP 1
+        }
    }
 }

@@ -790,7 +792,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
 } -result {{tf3 tf4} 1 0}
 test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
    cleanup
-} -constraints {win testchmod} -body {
+} -constraints {win win2000orXP testchmod} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    file rename td1 td3
@@ -822,7 +824,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
 } -result {tf1 tf2 1 0}
 test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
    cleanup
-} -constraints {win winXP testchmod} -body {
+} -constraints {win win2000orXP testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
@@ -283,7 +283,7 @@ test registry-4.7 {GetKeyNames: Unicode} {win reg english} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
 } "baz\u00c7bar blat"
-test registry-4.8 {GetKeyNames: Unicode} {win reg} {
+test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
@@ -487,7 +487,7 @@ test registry-6.17 {GetValue: Unicode value names} {win reg} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
 } foobar
-test registry-6.18 {GetValue: values with Unicode strings} {win reg} {
+test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
@@ -505,7 +505,7 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
 } "foo ba r baz"
-test registry-6.21 {GetValue: very long value names and values} {win reg} {
+test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
@@ -604,7 +604,7 @@ test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
 test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\\\
 } -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
-test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body {
+test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
    registry values \\\\\\HKEY_CLASSES_ROOT
 } -returnCodes error -result {unable to open key: The network address is invalid.}
 test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
@@ -340,7 +340,7 @@ test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
 test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
@@ -20,7 +20,6 @@ testConstraint testbytestring [llength [info commands testbytestring]]
 testConstraint testdstring [llength [info commands testdstring]]
 testConstraint testconcatobj [llength [info commands testconcatobj]]
 testConstraint testdoubledigits [llength [info commands testdoubledigits]]
-testConstraint testprint [llength [info commands testprint]]

 # Big test for correct ordering of data in [expr]

@@ -4018,30 +4017,6 @@ test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    0x4400000000000000 0xc400000000000000
 }]

-test util-18.1 {Tcl_ObjPrintf} {testprint} {
-    testprint %lld [expr 2**63-1]
-} {9223372036854775807}
-
-test util-18.2 {Tcl_ObjPrintf} {testprint} {
-    testprint %I64d [expr 2**63-1]
-} {9223372036854775807}
-
-test util-18.3 {Tcl_ObjPrintf} {testprint} {
-    testprint %Ld [expr 2**63-1]
-} {9223372036854775807}
-
-test util-18.4 {Tcl_ObjPrintf} {testprint} {
-    testprint %lld [expr -2**63]
-} {-9223372036854775808}
-
-test util-18.5 {Tcl_ObjPrintf} {testprint} {
-    testprint %I64d [expr -2**63]
-} {-9223372036854775808}
-
-test util-18.6 {Tcl_ObjPrintf} {testprint} {
-    testprint %Ld [expr -2**63]
-} {-9223372036854775808}
-
 set ::tcl_precision $saved_precision

 # cleanup
@@ -22,6 +22,8 @@ if {"::tcltest" ni [namespace children]} {
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]

+verbose [list line error skip start]
+
 testConstraint testupvar [llength [info commands testupvar]]
 testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
 testConstraint testsetnoerr [llength [info commands testsetnoerr]]
@@ -778,24 +780,6 @@ test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
    set x "If you see this, it worked"
 } -result "If you see this, it worked"

-test var-13.2 {unset array with search, bug 46a2410650} -body {
-    apply {{} {
-	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
-	set s [array startsearch a]
-	unset a([array nextelement a $s])
-	array nextelement a $s
-    }}
-} -returnCodes error -result {couldn't find search "s-1-a"}
-
-test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
-    apply {{} {
-	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
-	set s [array startsearch a]
-        unset a(ff)
-	array nextelement a $s
-    }}
-} -returnCodes error -result {couldn't find search "s-1-a"}
-
 test var-14.1 {array names syntax} -body {
    array names foo bar baz snafu
 } -returnCodes 1 -match glob -result *
@@ -1015,6 +999,120 @@ test var-22.2 {leak in parsedVarName} -constraints memory -body {
    unset -nocomplain i x
 } -result 0

+unset -nocomplain a k v
+test var-23.1 {array command, for loop} -returnCodes error -body {
+    array for {k v} c d e {}
+} -result {wrong # args: should be "array for {keyVarName ?valueVarName?} array script"}
+test var-23.2 {array command, for loop} -returnCodes error -body {
+    array for d {}
+} -result {wrong # args: should be "array for {keyVarName ?valueVarName?} array script"}
+test var-23.3 {array command, for loop, wrong # of list args} -setup {
+    unset -nocomplain a
+} -returnCodes error -body {
+    array for {k v w} a {}
+} -result {must have one or two variable names}
+test var-23.4 {array command, for loop, no array} -setup {
+    unset -nocomplain a
+} -returnCodes error -body {
+    array for {k v} a {}
+} -result {"a" isn't an array}
+test var-23.5 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
+    catch {rename p ""}
+} -returnCodes error -body {
+    apply {{x} {
+        if {$x==1} {
+            return [array for {k v} a {}]
+        }
+        set a(x) 123
+    }} 1
+} -result {"a" isn't an array}
+test var-23.6 {array enumeration} -setup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+    set reslist [list]
+} -body {
+    array set a {a 1 b 2 c 3}
+    array for {k v} a {
+	lappend reslist $k $v
+    }
+    # if someone turns on varPtr->flags |= VAR_SEARCH_ACTIVE
+    # a segmentation violation will result.
+    unset a;		# this should not cause a segmentation violation.
+    # there is no guarantee in which order the array contents will be
+    # returned.
+    lsort -stride 2 -index 0 $reslist
+} -cleanup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+} -result {a 1 b 2 c 3}
+test var-23.7 {array enumeration, without value} -setup {
+    unset -nocomplain a
+    set reslist [list]
+} -body {
+    array set a {a 1 b 2 c 3}
+    array for {k} a {
+	lappend reslist $k
+    }
+    # there is no guarantee in which order the array contents will be
+    # returned.
+    lsort $reslist
+} -result {a b c}
+test var-23.8 {array enumeration, nested} -setup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+    set reslist [list]
+} -body {
+    array set a {a 1 b 2 c 3}
+    array for {k1 v1} a {
+	lappend reslist $k1 $v1
+	set r2 {}
+	array for {k2 v2} a {
+	    lappend r2 $k2 $v2
+	}
+	lappend reslist [lsort -stride 2 -index 0 $r2]
+    }
+    # there is no guarantee in which order the array contents will be
+    # returned.
+    lsort -stride 3 -index 0 $reslist
+} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
+test var-23.9 {array enumeration, continue} -setup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+    set reslist [list]
+} -body {
+    array set a {a 1 b 2 c 3}
+    array for {k v} a {
+	if { $k eq {b} } {
+	    continue
+	}
+	lappend reslist $k $v
+    }
+    # there is no guarantee in which order the array contents will be
+    # returned.
+    lsort -stride 2 -index 0 $reslist
+} -cleanup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+} -result {a 1 c 3}
+test var-23.10 {array enumeration, break} -setup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+    set reslist [list]
+} -body {
+    array set a {a 1 b 2 c 3}
+    array for {k v} a {
+	if { $k eq {b} } {
+	    break
+	}
+	lappend reslist $k $v
+    }
+    # there is no guarantee in which order the array contents will be
+    # returned.
+    lsort -stride 2 -index 0 $reslist
+} -cleanup {
+    unset -nocomplain a
+    unset -nocomplain reslist
+} -result {a 1}

 catch {namespace delete ns}
 catch {unset arr}
@@ -1029,6 +1127,7 @@ catch {unset x}
 catch {unset y}
 catch {unset i}
 catch {unset a}
+catch {unset reslist}
 catch {unset xxxxx}
 catch {unset aaaaa}

@@ -21,7 +21,8 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Initialise the test constraints

 testConstraint winVista 0
-testConstraint winXP 0
+testConstraint win2000orXP 0
+testConstraint winOlderThan2000 0
 testConstraint testvolumetype [llength [info commands testvolumetype]]
 testConstraint testfile       [llength [info commands testfile]]
 testConstraint testchmod      [llength [info commands testchmod]]
@@ -55,12 +56,16 @@ proc cleanup {args} {
    }
 }

-if {[testConstraint win]} {
+if {[testConstraint winOnly]} {
    set major [string index $tcl_platform(osVersion) 0]
-    if {$major > 5} {
-	testConstraint winVista 1
-    } elseif {$major == 5} {
-	testConstraint winXP 1
+    if {[testConstraint nt] && $major > 4} {
+        if {$major > 5} {
+            testConstraint winVista 1
+        } elseif {$major == 5} {
+            testConstraint win2000orXP 1
+        }
+    } else {
+	testConstraint winOlderThan2000 1
    }
 }

@@ -200,12 +205,17 @@ test winFCmd-1.12 {TclpRenameFile: errno: EACCES} -setup {
 } -returnCodes error -result EACCES
 test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
-} -constraints {win winXP testfile} -body {
+} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
 } -returnCodes error -result EINVAL
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
+    cleanup
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EACCES
 test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
-} -constraints {win testfile} -body {
+} -constraints {win nt testfile} -body {
    createfile tf1
    testfile mv tf1 nul
 } -returnCodes error -result EEXIST
@@ -228,12 +238,19 @@ test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
 } -returnCodes error -result ENOENT
 test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
-} -constraints {win winXP testfile} -body {
+} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
 } -returnCodes error -result EINVAL
+test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
+    cleanup
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EACCES
 test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    cleanup
-} -constraints {win testfile} -body {
+} -constraints {win nt testfile} -body {
+    # under 95, this would actually succeed and move the current dir out from
+    # under the current process!
    file delete /tf1
    testfile mv [pwd] /tf1
 } -returnCodes error -result EACCES
@@ -441,9 +458,14 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
 } -returnCodes error -result ENOENT
 test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
-} -constraints {win winXP testfile} -body {
+} -constraints {win win2000orXP testfile} -body {
    testfile cp nul tf1
 } -returnCodes error -result EINVAL
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
+    cleanup
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile cp nul tf1
+} -returnCodes error -result EACCES
 test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
 } -constraints {win testfile} -body {
@@ -601,7 +623,7 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {

 test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
-} -constraints {win cdrom testfile} -returnCodes error -result EACCES
+} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
 test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
 } -constraints {win testfile} -body {
@@ -699,7 +721,7 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
 } -result {td1 EACCES}
 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
-} -constraints {win testfile} -body {
+} -constraints {win nt testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
@@ -797,7 +819,7 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
 } -result {tf1}
 test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
-} -constraints {win cdrom testfile} -returnCodes error -match glob \
+} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
 test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
 	{win emptyTest} {
@@ -835,7 +857,7 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
 } -result {tf1}
 test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
-} -constraints {win testfile} -body {
+} -constraints {win nt testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
 } -cleanup {
@@ -1050,7 +1072,7 @@ test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
 } -constraints {win} -result {/ /}
 test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
    catch {file delete -force -- c:/td1}
-} -constraints {win winXP} -body {
+} -constraints {win win2000orXP} -body {
    createfile c:/td1 {}
    string tolower [file attributes c:/td1 -longname]
 } -cleanup {
@@ -1328,13 +1350,13 @@ test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
 } -result COM1

-test winFCmd-19.1 {Windows extended path names} -constraints win -body {
+test winFCmd-19.1 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/win.ini
 } -result //?/c:/windows/win.ini
-test winFCmd-19.2 {Windows extended path names} -constraints win -body {
+test winFCmd-19.2 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/../windows/win.ini
 } -result //?/c:/windows/win.ini
-test winFCmd-19.3 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile [file normalize $tmpfile]
 } -body {
@@ -1345,7 +1367,7 @@ test winFCmd-19.3 {Windows extended path names} -constraints win -setup {
 } -cleanup {
    catch {file delete $tmpfile}
 } -result [list 0 {}]
-test winFCmd-19.4 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile //?/[file normalize $tmpfile]
 } -body {
@@ -1356,7 +1378,7 @@ test winFCmd-19.4 {Windows extended path names} -constraints win -setup {
 } -cleanup {
    catch {file delete $tmpfile}
 } -result [list 0 {}]
-test winFCmd-19.5 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile [file normalize $tmpfile]
 } -body {
@@ -1367,7 +1389,7 @@ test winFCmd-19.5 {Windows extended path names} -constraints win -setup {
 } -cleanup {
    catch {file delete $tmpfile}
 } -result [list 0 {}]
-test winFCmd-19.6 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile //?/[file normalize $tmpfile]
 } -body {
@@ -1378,7 +1400,7 @@ test winFCmd-19.6 {Windows extended path names} -constraints win -setup {
 } -cleanup {
    catch {file delete $tmpfile}
 } -result [list 0 {}]
-test winFCmd-19.7 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile [file normalize $tmpfile]
 } -body {
@@ -1389,7 +1411,7 @@ test winFCmd-19.7 {Windows extended path names} -constraints win -setup {
 } -cleanup {
    catch {file delete $tmpfile}
 } -result [list 0 {} [list tcl[pid].tmp]]
-test winFCmd-19.8 {Windows extended path names} -constraints win -setup {
+test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile //?/[file normalize $tmpfile]
 } -body {
@@ -1401,7 +1423,7 @@ test winFCmd-19.8 {Windows extended path names} -constraints win -setup {
    catch {file delete $tmpfile}
 } -result [list 0 {} [list "tcl[pid].tmp "]]

-test winFCmd-19.9 {Windows devices path names} -constraints win -body {
+test winFCmd-19.9 {Windows devices path names} -constraints nt -body {
    file normalize //./com1
 } -result //./com1

@@ -21,19 +21,23 @@ catch [list package require -exact Tcltest [info patchlevel]]

 testConstraint testvolumetype [llength [info commands testvolumetype]]
 testConstraint notNTFS 0
+testConstraint win2000 0

 if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
 }
+if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
+    testConstraint win2000 1
+}

 test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
 } -returnCodes error -result {user "nosuchuser" doesn't exist}
-test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
+test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
 } -match glob -result *
-test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
+test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob ~stanton@workgroup}
 } {0}

@@ -150,7 +154,7 @@ if {[testConstraint win]} {
 test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
 } -constraints {
-    win notNTFS
+    win nt notNTFS win2000
 } -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
@@ -165,7 +169,7 @@ test winFile-4.0 {
 test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
 } -constraints {
-    win notNTFS
+    win nt notNTFS
 } -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
 } -body {
@@ -176,7 +180,7 @@ test winFile-4.1 {
 test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
 } -constraints {
-    win notNTFS
+    win nt notNTFS
 } -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
 } -body {
@@ -188,7 +192,7 @@ test winFile-4.2 {
 test winFile-4.3 {
    Enhanced NTFS user/group permissions: test read+write
 } -constraints {
-    win notNTFS
+    win nt notNTFS
 } -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
 } -body {
@@ -201,7 +205,7 @@ test winFile-4.3 {
 test winFile-4.4 {
    Enhanced NTFS user/group permissions: test full access
 } -constraints {
-    win notNTFS
+    win nt notNTFS
 } -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
 } -body {
@@ -74,11 +74,11 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
    exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
-test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win exec cat32} {
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
 } {little stderr32}
-test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win exec cat32} {
+test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
@@ -171,7 +171,7 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
    set r
 } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

-test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
+test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
    proc readResults {f} {
 	global x result
 	if { [eof $f] } {
@@ -40,7 +40,7 @@ tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const

 int
 Tsdperf_Init(Tcl_Interp *interp) {
-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }

@@ -123,7 +123,7 @@ Pkga_Init(
 {
    int code;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkga", "1.0");
@@ -113,7 +113,7 @@ Pkgc_Init(
 {
    int code;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
@@ -150,7 +150,7 @@ Pkgc_SafeInit(
 {
    int code;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
@@ -113,7 +113,7 @@ Pkgd_Init(
 {
    int code;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
@@ -150,7 +150,7 @@ Pkgd_SafeInit(
 {
    int code;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
@@ -38,7 +38,7 @@ Pkge_Init(
 {
    static const char script[] = "if 44 {open non_existent}";

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }
    return Tcl_EvalEx(interp, script, -1, 0);
@@ -96,7 +96,7 @@ Pkgooa_Init(
     * This worked in Tcl 8.6.0, and is expected
     * to keep working in all future Tcl 8.x releases.
     */
-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
 	return TCL_ERROR;
    }
    if (tclStubsPtr == NULL) {
@@ -199,7 +199,7 @@ Pkgua_Init(
    int code, cmdIndex = 0;
    Tcl_Command *cmdTokens;

-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return TCL_ERROR;
    }

@@ -1507,10 +1507,11 @@ SetGroupAttribute(
 	Tcl_DString ds;
 	struct group *groupPtr = NULL;
 	const char *string;
+	int length;

-	string = TclGetString(attributePtr);
+	string = TclGetStringFromObj(attributePtr, &length);

-	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
+	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
 	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
 	Tcl_DStringFree(&ds);

@@ -1573,10 +1574,11 @@ SetOwnerAttribute(
 	Tcl_DString ds;
 	struct passwd *pwPtr = NULL;
 	const char *string;
+	int length;

-	string = TclGetString(attributePtr);
+	string = TclGetStringFromObj(attributePtr, &length);

-	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
+	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
 	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
 	Tcl_DStringFree(&ds);

@@ -1944,9 +1946,9 @@ TclpObjNormalizePath(
    int nextCheckpoint)
 {
    const char *currentPathEndPosition;
+    int pathLen;
    char cur;
-    const char *path = TclGetString(pathPtr);
-    size_t pathLen = pathPtr->length;
+    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
 #ifndef NO_REALPATH
@@ -2175,15 +2177,15 @@ TclUnixOpenTemporaryFile(
 {
    Tcl_DString template, tmp;
    const char *string;
-    int fd;
+    int len, fd;

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
-	string = TclGetString(dirObj);
-	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template);
+	string = TclGetStringFromObj(dirObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &template);
    } else {
 	Tcl_DStringInit(&template);
 	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
@@ -2192,8 +2194,8 @@ TclUnixOpenTemporaryFile(
    TclDStringAppendLiteral(&template, "/");

    if (basenameObj) {
-	string = TclGetString(basenameObj);
-	Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
+	string = TclGetStringFromObj(basenameObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
 	TclDStringAppendDString(&template, &tmp);
 	Tcl_DStringFree(&tmp);
    } else {
@@ -2204,8 +2206,8 @@ TclUnixOpenTemporaryFile(

 #ifdef HAVE_MKSTEMPS
    if (extensionObj) {
-	string = TclGetString(extensionObj);
-	Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp);
+	string = TclGetStringFromObj(extensionObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
 	TclDStringAppendDString(&template, &tmp);
 	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
 	Tcl_DStringFree(&tmp);
@@ -262,15 +262,14 @@ TclpMatchInDirectory(
 	DIR *d;
 	Tcl_DirEntry *entryPtr;
 	const char *dirName;
-	size_t dirLength, nativeDirLen;
+	int dirLength, nativeDirLen;
 	int matchHidden, matchHiddenPat;
 	Tcl_StatBuf statBuf;
 	Tcl_DString ds;		/* native encoding of dir */
 	Tcl_DString dsOrig;	/* utf-8 encoding of dir */

 	Tcl_DStringInit(&dsOrig);
-	dirName = TclGetString(fileNamePtr);
-	dirLength = fileNamePtr->length;
+	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
 	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

 	/*
@@ -938,6 +937,7 @@ TclpObjLink(
 	 */

 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+	    int targetLen;
 	    Tcl_DString ds;
 	    Tcl_Obj *transPtr;

@@ -951,8 +951,8 @@ TclpObjLink(
 	    if (transPtr == NULL) {
 		return NULL;
 	    }
-	    target = TclGetString(transPtr);
-	    target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds);
+	    target = TclGetStringFromObj(transPtr, &targetLen);
+	    target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
 	    Tcl_DecrRefCount(transPtr);

 	    if (symlink(target, src) != 0) {
@@ -1080,7 +1080,7 @@ TclNativeCreateNativeRep(
    const char *str;
    Tcl_DString ds;
    Tcl_Obj *validPathPtr;
-    size_t len;
+    int len;

    if (TclFSCwdIsNative()) {
 	/*
@@ -1105,8 +1105,7 @@ TclNativeCreateNativeRep(
 	Tcl_IncrRefCount(validPathPtr);
    }

-    str = TclGetString(validPathPtr);
-    len = validPathPtr->length;
+    str = TclGetStringFromObj(validPathPtr, &len);
    Tcl_UtfToExternalDString(NULL, str, len, &ds);
    len = Tcl_DStringLength(&ds) + sizeof(char);
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
@@ -48,7 +48,7 @@ int
 Tclxttest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
 {
-    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
 	return TCL_ERROR;
    }
    XtToolkitInitialize();
Author	SHA1	Message	Date
andy	aa12f7d709	Merge trunk	2016-12-13 01:27:25 +00:00
andy	a7909595ec	Commit changes received from Brad Lanam via email	2016-12-12 04:42:52 +00:00
dkf	7d753e316a	Implementation of [array for] from Brad Lanam. See https://github.com/flightaware/Tcl-bounties/issues/12 for details.	2016-11-24 13:47:47 +00:00