Merge trunk

26 files changed, 588 insertions, 577 deletions

diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 16e3ae9..affcb48 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -256,20 +256,33 @@ static const chr brbacks[] = {	/* \s within brackets */
     CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
     CHR(':'), CHR(']')
 };
+
+#define PUNCT_CONN \
+	CHR('_'), \
+	0x203f /* UNDERTIE */, \
+	0x2040 /* CHARACTER TIE */,\
+	0x2054 /* INVERTED UNDERTIE */,\
+	0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \
+	0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \
+	0xfe4d /* DASHED LOW LINE */, \
+	0xfe4e /* CENTRELINE LOW LINE */, \
+	0xfe4f /* WAVY LOW LINE */, \
+	0xff3f /* FULLWIDTH LOW LINE */
+
 static const chr backw[] = {	/* \w */
     CHR('['), CHR('['), CHR(':'),
     CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-    CHR(':'), CHR(']'), CHR('_'), CHR(']')
+    CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
 };
 static const chr backW[] = {	/* \W */
     CHR('['), CHR('^'), CHR('['), CHR(':'),
     CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-    CHR(':'), CHR(']'), CHR('_'), CHR(']')
+    CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
 };
 static const chr brbackw[] = {	/* \w within brackets */
     CHR('['), CHR(':'),
     CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-    CHR(':'), CHR(']'), CHR('_')
+    CHR(':'), CHR(']'), PUNCT_CONN
 };
 
 /*
diff --git a/generic/tcl.h b/generic/tcl.h
index 58ba7e5..3cd90a9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1165,18 +1165,6 @@ typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
 typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
 
 /*
- * This flag controls whether the hash table stores the hash of a key, or
- * recalculates it. There should be no reason for turning this flag off as it
- * is completely binary and source compatible unless you directly access the
- * bucketPtr member of the Tcl_HashTableEntry structure. This member has been
- * removed and the space used to store the hash value.
- */
-
-#ifndef TCL_HASH_KEY_STORE_HASH
-#   define TCL_HASH_KEY_STORE_HASH 1
-#endif
-
-/*
  * Structure definition for an entry in a hash table. No-one outside Tcl
  * should access any of these fields directly; use the macros defined below.
  */
@@ -1185,15 +1173,9 @@ struct Tcl_HashEntry {
     Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
 				 * or NULL for end of chain. */
     Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
-#if TCL_HASH_KEY_STORE_HASH
     void *hash;			/* Hash value, stored as pointer to ensure
 				 * that the offsets of the fields in this
 				 * structure are not changed. */
-#else
-    Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to first
-				 * entry in this entry's chain: used for
-				 * deleting the entry. */
-#endif
     ClientData clientData;	/* Application stores something here with
 				 * Tcl_SetHashValue. */
     union {			/* Key has one of these forms: */
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 6d5676b..8dd23a0 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -866,7 +866,7 @@ CompileAssembleObj(
 	 * Not valid, so free it and regenerate.
 	 */
 
-	FreeAssembleCodeInternalRep(objPtr);
+	TclFreeIntRep(objPtr);
     }
 
     /*
@@ -891,15 +891,13 @@ CompileAssembleObj(
      */
 
     TclEmitOpcode(INST_DONE, &compEnv);
-    TclInitByteCodeObj(objPtr, &compEnv);
-    objPtr->typePtr = &assembleCodeType;
+    codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);
     TclFreeCompileEnv(&compEnv);
 
     /*
      * Record the local variable context to which the bytecode pertains
      */
 
-    codePtr = objPtr->internalRep.twoPtrValue.ptr1;
     if (iPtr->varFramePtr->localCachePtr) {
 	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
 	codePtr->localCachePtr->refCount++;
@@ -3984,10 +3982,12 @@ UnstackExpiredCatches(
 
     while (catchDepth > bbPtr->catchDepth) {
 	--catchDepth;
-	range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
-	range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
-	catches[catchDepth] = NULL;
-	catchIndices[catchDepth] = -1;
+	if (catches[catchDepth] != NULL) {
+	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+	    range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+	    catches[catchDepth] = NULL;
+	    catchIndices[catchDepth] = -1;
+	}
     }
 
     /*
@@ -4313,11 +4313,7 @@ FreeAssembleCodeInternalRep(
 {
     ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
-	TclCleanupByteCode(codePtr);
-    }
-    objPtr->typePtr = NULL;
+    TclReleaseByteCode(codePtr);
 }
 
 /*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e5d7406..505f6c2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -580,11 +580,12 @@ Tcl_CreateInterp(void)
     iPtr->packageUnknown = NULL;
 
     /* TIP #268 */
+#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
     if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
 	iPtr->packagePrefer = PKG_PREFER_STABLE;
-    } else {
+    } else
+#endif
 	iPtr->packagePrefer = PKG_PREFER_LATEST;
-    }
 
     iPtr->cmdCount = 0;
     TclInitLiteralTable(&iPtr->literalTable);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 739dca9..0d35397 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2755,7 +2755,7 @@ Tcl_LreplaceObjCmd(
      * (to allow for replacing the last elem).
      */
 
-    if ((first >= listLen) && (listLen > 0)) {
+    if ((first > listLen) && (listLen > 0)) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"list doesn't contain element %s", TclGetString(objv[2])));
 	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index e674fb0..ffe39ba 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1488,8 +1488,27 @@ TclCompileLreplaceCmd(
 	return TCL_ERROR;
     }
 
-    if(idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
-	idx2 = idx1-1;
+    /*
+     * idx1, idx2 are now in canonical form:
+     *
+     *  - integer:	[0,len+1]
+     *  - end index:    INDEX_END
+     *  - -ive offset:  INDEX_END-[len-1,0]
+     *  - +ive offset:  INDEX_END+1
+     */
+
+    /*
+     * Compilation fails when one index is end-based but the other isn't.
+     * Fixing this will require more bytecodes, but this is a workaround for
+     * now. [Bug 47ac84309b]
+     */
+
+    if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
+	return TCL_ERROR;
+    }
+
+    if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
+	idx2 = idx1 - 1;
     }
 
     /*
@@ -1511,6 +1530,9 @@ TclCompileLreplaceCmd(
 	    idx1 = 0;
 	    goto dropEnd;
 	} else {
+	    if (idx2 < idx1) {
+		idx2 = idx1 - 1;
+	    }
 	    if (idx1 > 0) {
 		tmpObj = Tcl_NewIntObj(idx1);
 		Tcl_IncrRefCount(tmpObj);
@@ -1538,9 +1560,7 @@ TclCompileLreplaceCmd(
 	idx1 = 0;
 	goto replaceTail;
     } else {
-	if (idx1 > 0 && idx2 > 0 && idx2 < idx1) {
-	    idx2 = idx1 - 1;
-	} else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) {
+	if (idx2 < idx1) {
 	    idx2 = idx1 - 1;
 	}
 	if (idx1 > 0) {
@@ -1556,7 +1576,7 @@ TclCompileLreplaceCmd(
      * operate on.
      */
 
-  dropAll:
+  dropAll:			/* This just ensures the arg is a list. */
     TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
     TclEmitOpcode(		INST_POP,			envPtr);
     PushStringLiteral(envPtr,	"");
@@ -1569,12 +1589,21 @@ TclCompileLreplaceCmd(
 
   dropRange:
     if (tmpObj != NULL) {
+	/*
+	 * Emit bytecode to check the list length.
+	 */
+
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
-	TclEmitOpcode(		INST_GT,			envPtr);
+	TclEmitOpcode(		INST_GE,			envPtr);
 	offset = CurrentOffset(envPtr);
 	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+
+	/*
+	 * Emit an error if we've been given an empty list.
+	 */
+
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	offset2 = CurrentOffset(envPtr);
@@ -1625,16 +1654,30 @@ TclCompileLreplaceCmd(
 
   replaceRange:
     if (tmpObj != NULL) {
+	/*
+	 * Emit bytecode to check the list length.
+	 */
+
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+
+	/*
+	 * Check the list length vs idx1.
+	 */
+
 	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
-	TclEmitOpcode(		INST_GT,			envPtr);
+	TclEmitOpcode(		INST_GE,			envPtr);
 	offset = CurrentOffset(envPtr);
 	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+
+	/*
+	 * Emit an error if we've been given an empty list.
+	 */
+
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
 		"list doesn't contain element %d", idx1), NULL), envPtr);
 	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
@@ -2966,10 +3009,12 @@ IndexTailVarIfKnown(
     } else {
 	full = 0;
 	lastTokenPtr = varTokenPtr + n;
-	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+
+	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
 	    Tcl_DecrRefCount(tailPtr);
 	    return -1;
 	}
+	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
     }
 
     tailName = TclGetStringFromObj(tailPtr, &len);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ef9340e..101edbd 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2028,7 +2028,7 @@ IssueSwitchChainedTests(
     int foundDefault;		/* Flag to indicate whether a "default" clause
 				 * is present. */
     JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
-    int *fixupTargetArray;	/* Array of places for fixups to point at. */
+    unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
     int fixupCount;		/* Number of places to fix up. */
     int contFixIndex;		/* Where the first of the jumps due to a group
 				 * of continuation bodies starts, or -1 if
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 50edbec..654666a 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -564,13 +564,13 @@ ParseExpr(
 {
     OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
 				 * we build the parse tree. */
-    int nodesAvailable = 64;	/* Initial size of the storage array. This
+    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
 				 * value establishes a minimum tree memory
 				 * cost of only about 1 kibyte, and is large
 				 * enough for most expressions to parse with
 				 * no need for array growth and
 				 * reallocation. */
-    int nodesUsed = 0;		/* Number of OpNodes filled. */
+    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
     int scanned = 0;		/* Capture number of byte scanned by parsing
 				 * routines. */
     int lastParsed;		/* Stores info about what the lexeme parsed
@@ -662,7 +662,7 @@ ParseExpr(
 	 */
 
 	if (nodesUsed >= nodesAvailable) {
-	    int size = nodesUsed * 2;
+	    unsigned int size = nodesUsed * 2;
 	    OpNode *newPtr = NULL;
 
 	    do {
@@ -2181,7 +2181,6 @@ ExecConstantExprTree(
     CompileEnv *envPtr;
     ByteCode *byteCodePtr;
     int code;
-    Tcl_Obj *byteCodeObj = Tcl_NewObj();
     NRE_callback *rootPtr = TOP_CB(interp);
 
     /*
@@ -2195,14 +2194,12 @@ ExecConstantExprTree(
     CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
 	    0 /* optimize */);
     TclEmitOpcode(INST_DONE, envPtr);
-    Tcl_IncrRefCount(byteCodeObj);
-    TclInitByteCodeObj(byteCodeObj, envPtr);
+    byteCodePtr = TclInitByteCode(envPtr);
     TclFreeCompileEnv(envPtr);
     TclStackFree(interp, envPtr);
-    byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
     TclNRExecuteByteCode(interp, byteCodePtr);
     code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
-    Tcl_DecrRefCount(byteCodeObj);
+    TclReleaseByteCode(byteCodePtr);
     return code;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 4c259ab..2042bcc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -661,6 +661,7 @@ InstructionDesc const tclInstructionTable[] = {
  * Prototypes for procedures defined later in this file:
  */
 
+static void		CleanupByteCode(ByteCode *codePtr);
 static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    int flags);
 static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
@@ -676,6 +677,7 @@ static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
 static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
 			    CompileEnv *envPtr);
+static void		PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
 #ifdef TCL_COMPILE_STATS
 static void		RecordByteCodeStats(ByteCode *codePtr);
 #endif /* TCL_COMPILE_STATS */
@@ -866,7 +868,7 @@ TclSetByteCodeFromAny(
 #endif /*TCL_COMPILE_DEBUG*/
 
     if (result == TCL_OK) {
-	TclInitByteCodeObj(objPtr, &compEnv);
+	(void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv);
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 2) {
 	    TclPrintByteCodeObj(interp, objPtr);
@@ -967,16 +969,13 @@ FreeByteCodeInternalRep(
 {
     register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    objPtr->typePtr = NULL;
-    if (codePtr->refCount-- <= 1) {
-	TclCleanupByteCode(codePtr);
-    }
+    TclReleaseByteCode(codePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCleanupByteCode --
+ * TclReleaseByteCode --
  *
  *	This procedure does all the real work of freeing up a bytecode
  *	object's ByteCode structure. It's called only when the structure's
@@ -993,7 +992,26 @@ FreeByteCodeInternalRep(
  */
 
 void
-TclCleanupByteCode(
+TclPreserveByteCode(
+    register ByteCode *codePtr)
+{
+    codePtr->refCount++;
+}
+
+void
+TclReleaseByteCode(
+    register ByteCode *codePtr)
+{
+    if (--codePtr->refCount) {
+	return;
+    }
+
+    /* Just dropped to refcount==0.  Clean up. */
+    CleanupByteCode(codePtr);
+}
+
+static void
+CleanupByteCode(
     register ByteCode *codePtr)	/* Points to the ByteCode to free. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
@@ -1260,8 +1278,6 @@ Tcl_NRSubstObj(
  *
  * Results:
  *	A (ByteCode *) is returned pointing to the resulting ByteCode.
- *	The caller must manage its refCount and arrange for a call to
- *	TclCleanupByteCode() when the last reference disappears.
  *
  * Side effects:
  *	The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
@@ -1292,7 +1308,7 @@ CompileSubstObj(
 		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
 		|| (codePtr->localCachePtr !=
 		iPtr->varFramePtr->localCachePtr)) {
-	    FreeSubstCodeInternalRep(objPtr);
+	    TclFreeIntRep(objPtr);
 	}
     }
     if (objPtr->typePtr != &substCodeType) {
@@ -1306,11 +1322,9 @@ CompileSubstObj(
 	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
 
 	TclEmitOpcode(INST_DONE, &compEnv);
-	TclInitByteCodeObj(objPtr, &compEnv);
-	objPtr->typePtr = &substCodeType;
+	codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
 	TclFreeCompileEnv(&compEnv);
 
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
 	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
 	if (iPtr->varFramePtr->localCachePtr) {
@@ -1353,10 +1367,7 @@ FreeSubstCodeInternalRep(
 {
     register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    objPtr->typePtr = NULL;
-    if (codePtr->refCount-- <= 1) {
-	TclCleanupByteCode(codePtr);
-    }
+    TclReleaseByteCode(codePtr);
 }
 
 static void
@@ -2697,11 +2708,40 @@ TclCompileNoOp(
  *----------------------------------------------------------------------
  */
 
-void
-TclInitByteCodeObj(
-    Tcl_Obj *objPtr,		/* Points object that should be initialized,
-				 * and whose string rep contains the source
-				 * code. */
+static void
+PreventCycle(
+    Tcl_Obj *objPtr,
+    CompileEnv *envPtr)
+{
+    int i;
+
+    for (i = 0;  i < envPtr->literalArrayNext; i++) {
+	if (objPtr == TclFetchLiteral(envPtr, i)) {
+	    /*
+	     * Prevent circular reference where the bytecode intrep of
+	     * a value contains a literal which is that same value.
+	     * If this is allowed to happen, refcount decrements may not
+	     * reach zero, and memory may leak.  Bugs 467523, 3357771
+	     *
+	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
+	     * on the string value, and do not call Tcl_DuplicateObj() so we
+             * can be sure we do not have any lingering cycles hiding in
+	     * the intrep.
+	     */
+	    int numBytes;
+	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
+	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);
+
+	    Tcl_IncrRefCount(copyPtr);
+	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);
+
+	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
+	}
+    }
+}
+
+ByteCode *
+TclInitByteCode(
     register CompileEnv *envPtr)/* Points to the CompileEnv structure from
 				 * which to create a ByteCode structure. */
 {
@@ -2752,7 +2792,8 @@ TclInitByteCodeObj(
     codePtr->compileEpoch = iPtr->compileEpoch;
     codePtr->nsPtr = namespacePtr;
     codePtr->nsEpoch = namespacePtr->resolverEpoch;
-    codePtr->refCount = 1;
+    codePtr->refCount = 0;
+    TclPreserveByteCode(codePtr);
     if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
 	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
     } else {
@@ -2778,29 +2819,7 @@ TclInitByteCodeObj(
     p += TCL_ALIGN(codeBytes);		/* align object array */
     codePtr->objArrayPtr = (Tcl_Obj **) p;
     for (i = 0;  i < numLitObjects;  i++) {
-	Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
-
-	if (objPtr == fetched) {
-	    /*
-	     * Prevent circular reference where the bytecode intrep of
-	     * a value contains a literal which is that same value.
-	     * If this is allowed to happen, refcount decrements may not
-	     * reach zero, and memory may leak.  Bugs 467523, 3357771
-	     *
-	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
-	     * on the string value, and do not call Tcl_DuplicateObj() so we
-             * can be sure we do not have any lingering cycles hiding in
-	     * the intrep.
-	     */
-	    int numBytes;
-	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
-
-	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
-	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
-	    TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
-	} else {
-	    codePtr->objArrayPtr[i] = fetched;
-	}
+	codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
     }
 
     p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
@@ -2843,15 +2862,6 @@ TclInitByteCodeObj(
 #endif /* TCL_COMPILE_STATS */
 
     /*
-     * Free the old internal rep then convert the object to a bytecode object
-     * by making its internal rep point to the just compiled ByteCode.
-     */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
-    objPtr->typePtr = &tclByteCodeType;
-
-    /*
      * TIP #280. Associate the extended per-word line information with the
      * byte code object (internal rep), for use with the bc compiler.
      */
@@ -2864,6 +2874,33 @@ TclInitByteCodeObj(
     envPtr->iPtr = NULL;
 
     codePtr->localCachePtr = NULL;
+    return codePtr;
+}
+
+ByteCode *
+TclInitByteCodeObj(
+    Tcl_Obj *objPtr,		/* Points object that should be initialized,
+				 * and whose string rep contains the source
+				 * code. */
+    const Tcl_ObjType *typePtr,
+    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+				 * which to create a ByteCode structure. */
+{
+    ByteCode *codePtr;
+
+    PreventCycle(objPtr, envPtr);
+
+    codePtr = TclInitByteCode(envPtr);
+
+    /*
+     * Free the old internal rep then convert the object to a bytecode object
+     * by making its internal rep point to the just compiled ByteCode.
+     */
+
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
+    objPtr->typePtr = typePtr;
+    return codePtr;
 }
 
 /*
@@ -3360,26 +3397,25 @@ TclGetInnermostExceptionRange(
     int returnCode,
     ExceptionAux **auxPtrPtr)
 {
-    int exnIdx = -1, i;
+    int i = envPtr->exceptArrayNext;
+    ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;
 
-    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
-	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+    while (i > 0) {
+	rangePtr--; i--;
 
 	if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
 		(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
 			rangePtr->codeOffset+rangePtr->numCodeBytes) &&
 		(returnCode != TCL_CONTINUE ||
 			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
-	    exnIdx = i;
+
+	    if (auxPtrPtr) {
+		*auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
+	    }
+	    return rangePtr;
 	}
     }
-    if (exnIdx == -1) {
-	return NULL;
-    }
-    if (auxPtrPtr) {
-	*auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
-    }
-    return &envPtr->exceptArrayPtr[exnIdx];
+    return NULL;
 }
 
 /*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b5bfab1..f99c07c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -135,7 +135,7 @@ typedef struct ExceptionAux {
     int numBreakTargets;	/* The number of [break]s that want to be
 				 * targeted to the place where this loop
 				 * exception will be bound to. */
-    int *breakTargets;		/* The offsets of the INST_JUMP4 instructions
+    unsigned int *breakTargets;	/* The offsets of the INST_JUMP4 instructions
 				 * issued by the [break]s that we must
 				 * update. Note that resizing a jump (via
 				 * TclFixupForwardJump) can cause the contents
@@ -145,7 +145,7 @@ typedef struct ExceptionAux {
     int numContinueTargets;	/* The number of [continue]s that want to be
 				 * targeted to the place where this loop
 				 * exception will be bound to. */
-    int *continueTargets;	/* The offsets of the INST_JUMP4 instructions
+    unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
 				 * issued by the [continue]s that we must
 				 * update. Note that resizing a jump (via
 				 * TclFixupForwardJump) can cause the contents
@@ -928,7 +928,7 @@ typedef enum {
 
 typedef struct JumpFixup {
     TclJumpType jumpType;	/* Indicates the kind of jump. */
-    int codeOffset;		/* Offset of the first byte of the one-byte
+    unsigned int codeOffset;	/* Offset of the first byte of the one-byte
 				 * forward jump's code. */
     int cmdIndex;		/* Index of the first command after the one
 				 * for which the jump was emitted. Used to
@@ -1067,7 +1067,6 @@ MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
 			    CompileEnv *envPtr);
-MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
 MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
 			    ExceptionAux *auxPtr);
 MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
@@ -1119,8 +1118,9 @@ MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
 			    int distThreshold);
 MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
 MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
-			    CompileEnv *envPtr);
+MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
+MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
+			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
 MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
 			    CompileEnv *envPtr, const char *string,
 			    int numBytes, const CmdFrame *invoker, int word);
@@ -1157,6 +1157,8 @@ MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
 			    int *isScalarPtr);
+MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
+MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
 			    const char *name, Namespace *nsPtr);
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 4edebcf..32055a3 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -355,6 +355,7 @@ DupEncodingIntRep(
     Tcl_Obj *dupPtr)
 {
     dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
+    dupPtr->typePtr = &encodingType;
 }
 
 /*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 8f7d1a2..986a553 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3082,6 +3082,11 @@ TclAttemptCompileProc(
     Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
     int savedStackDepth = envPtr->currStackDepth;
     unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+    int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
+    int savedExceptArrayNext = envPtr->exceptArrayNext;
+#ifdef TCL_COMPILE_DEBUG
+    int savedExceptDepth = envPtr->exceptDepth;
+#endif
     DefineLineInformation;
 
     if (cmdPtr->compileProc == NULL) {
@@ -3130,7 +3135,45 @@ TclAttemptCompileProc(
      * we avoid compiling subcommands that recursively call TclCompileScript().
      */
 
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->exceptDepth != savedExceptDepth) {
+	Tcl_Panic("ExceptionRange Starts and Ends do not balance");
+    }
+#endif
+
     if (result != TCL_OK) {
+	ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
+
+	for (i = 0; i < savedExceptArrayNext; i++) {
+	    while (auxPtr->numBreakTargets > 0
+		    && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
+		    >= savedCodeNext) {
+		auxPtr->numBreakTargets--;
+	    }
+	    while (auxPtr->numContinueTargets > 0
+		    && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
+		    >= savedCodeNext) {
+		auxPtr->numContinueTargets--;
+	    }
+	    auxPtr++;
+	}
+	envPtr->exceptArrayNext = savedExceptArrayNext;
+
+	if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
+	    AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+	    AuxData *auxDataEnd = auxDataPtr;
+
+	    auxDataPtr += savedAuxDataArrayNext;
+	    auxDataEnd += envPtr->auxDataArrayNext;
+
+	    while (auxDataPtr < auxDataEnd) {
+		if (auxDataPtr->type->freeProc != NULL) {
+		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
+		}
+		auxDataPtr++;
+	    }
+	    envPtr->auxDataArrayNext = savedAuxDataArrayNext;
+	}
 	envPtr->currStackDepth = savedStackDepth;
 	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
 #ifdef TCL_COMPILE_DEBUG
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 8305410..a16a3b1 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1043,6 +1043,9 @@ TclInitSubsystems(void)
 #if USE_TCLALLOC
 	    TclInitAlloc();		/* Process wide mutex init */
 #endif
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+	    TclpInitAllocCache();
+#endif
 #ifdef TCL_MEM_DEBUG
 	    TclInitDbCkalloc();		/* Process wide mutex init */
 #endif
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index dacc9e2..cd28a92 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,6 +19,7 @@
 #include "tclCompile.h"
 #include "tclOOInt.h"
 #include "tommath.h"
+#include "tclStringRep.h"
 #include <math.h>
 #include <assert.h>
 
@@ -34,14 +35,14 @@
 #endif
 
 /*
- * A mask (should be 2**n-1) that is used to work out when the bytecode engine
- * should call Tcl_AsyncReady() to see whether there is a signal that needs
- * handling.
+ * A counter that is used to work out when the bytecode engine should call
+ * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
+ * other expensive periodic operations.
  */
 
-#ifndef ASYNC_CHECK_COUNT_MASK
-#   define ASYNC_CHECK_COUNT_MASK	63
-#endif /* !ASYNC_CHECK_COUNT_MASK */
+#ifndef ASYNC_CHECK_COUNT
+#   define ASYNC_CHECK_COUNT	64
+#endif /* !ASYNC_CHECK_COUNT */
 
 /*
  * Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -1498,11 +1499,9 @@ ExprObjCallback(
  *
  * Results:
  *	A (ByteCode *) is returned pointing to the resulting ByteCode.
- *	The caller must manage its refCount and arrange for a call to
- *	TclCleanupByteCode() when the last reference disappears.
  *
  * Side effects:
- *	The Tcl_ObjType of objPtr is changed to the "bytecode" type,
+ *	The Tcl_ObjType of objPtr is changed to the "exprcode" type,
  *	and the ByteCode is kept in the internal rep (along with context
  *	data for checking validity) for faster operations the next time
  *	CompileExprObj is called on the same value.
@@ -1535,7 +1534,7 @@ CompileExprObj(
 		|| (codePtr->nsPtr != namespacePtr)
 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
 		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
-	    FreeExprCodeInternalRep(objPtr);
+	    TclFreeIntRep(objPtr);
 	}
     }
     if (objPtr->typePtr != &exprCodeType) {
@@ -1566,10 +1565,8 @@ CompileExprObj(
 	 */
 
 	TclEmitOpcode(INST_DONE, &compEnv);
-	TclInitByteCodeObj(objPtr, &compEnv);
-	objPtr->typePtr = &exprCodeType;
+	codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
 	TclFreeCompileEnv(&compEnv);
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (iPtr->varFramePtr->localCachePtr) {
 	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
 	    codePtr->localCachePtr->refCount++;
@@ -1643,10 +1640,7 @@ FreeExprCodeInternalRep(
 {
     ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    objPtr->typePtr = NULL;
-    if (codePtr->refCount-- <= 1) {
-	TclCleanupByteCode(codePtr);
-    }
+    TclReleaseByteCode(codePtr);
 }
 
 /*
@@ -2032,7 +2026,7 @@ TclNRExecuteByteCode(
 		* sizeof(void *);
     int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
 
-    codePtr->refCount++;
+    TclPreserveByteCode(codePtr);
 
     /*
      * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
@@ -2114,8 +2108,14 @@ TEBCresume(
      * sporadically: no special need for speed.
      */
 
-    int instructionCount = 0;	/* Counter that is used to work out when to
-				 * call Tcl_AsyncReady() */
+    unsigned interruptCounter = 1;
+				/* Counter that is used to work out when to
+				 * call Tcl_AsyncReady(). This must be 1
+				 * initially so that we call the async-check
+				 * stanza early, otherwise there are command
+				 * sequences that can make the interpreter
+				 * busy-loop without an opportunity to
+				 * recognise an interrupt. */
     const char *curInstName;
 #ifdef TCL_COMPILE_DEBUG
     int traceInstructions;	/* Whether we are doing instruction-level
@@ -2313,10 +2313,11 @@ TEBCresume(
 
     /*
      * Check for asynchronous handlers [Bug 746722]; we do the check every
-     * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+     * ASYNC_CHECK_COUNT instructions.
      */
 
-    if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+    if ((--interruptCounter) == 0) {
+	interruptCounter = ASYNC_CHECK_COUNT;
 	DECACHE_STACK_INFO();
 	if (TclAsyncReady(iPtr)) {
 	    result = Tcl_AsyncInvoke(interp, result);
@@ -5737,6 +5738,16 @@ TEBCresume(
 	if (length3 - 1 == toIdx - fromIdx) {
 	    unsigned char *bytes1, *bytes2;
 
+	    /*
+	     * Flush the info in the string internal rep that refers to the
+	     * about-to-be-invalidated UTF-8 rep. This indicates that a new
+	     * buffer needs to be allocated, and assumes that the value is
+	     * already of tclStringTypePtr type, which should be true provided
+	     * we call it after Tcl_GetUnicodeFromObj.
+	     */
+#define MarkStringInternalRepForFlush(objPtr) \
+	    (GET_STRING(objPtr)->allocated = 0)
+
 	    if (Tcl_IsShared(valuePtr)) {
 		objResultPtr = Tcl_DuplicateObj(valuePtr);
 		if (TclIsPureByteArray(objResultPtr)
@@ -5749,17 +5760,7 @@ TEBCresume(
 		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
 		    memcpy(ustring1 + fromIdx, ustring2,
 			    length3 * sizeof(Tcl_UniChar));
-
-		    /*
-		     * Magic! Flush the info in the string internal rep that
-		     * refers to the about-to-be-invalidated UTF-8 rep. This
-		     * sets the 'allocated' field of the String structure to 0
-		     * to indicate that a new buffer needs to be allocated.
-		     * This is safe; we know we've got a tclStringTypePtr set
-		     * at this point (post Tcl_GetUnicodeFromObj).
-		     */
-
-		    ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0;
+		    MarkStringInternalRepForFlush(objResultPtr);
 		}
 		Tcl_InvalidateStringRep(objResultPtr);
 		TclDecrRefCount(value3Ptr);
@@ -5776,17 +5777,7 @@ TEBCresume(
 		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
 		    memcpy(ustring1 + fromIdx, ustring2,
 			    length3 * sizeof(Tcl_UniChar));
-
-		    /*
-		     * Magic! Flush the info in the string internal rep that
-		     * refers to the about-to-be-invalidated UTF-8 rep. This
-		     * sets the 'allocated' field of the String structure to 0
-		     * to indicate that a new buffer needs to be allocated.
-		     * This is safe; we know we've got a tclStringTypePtr set
-		     * at this point (post Tcl_GetUnicodeFromObj).
-		     */
-
-		    ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0;
+		    MarkStringInternalRepForFlush(valuePtr);
 		}
 		Tcl_InvalidateStringRep(valuePtr);
 		TclDecrRefCount(value3Ptr);
@@ -8191,9 +8182,7 @@ TEBCresume(
     }
 
     iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-    if (codePtr->refCount-- <= 1) {
-	TclCleanupByteCode(codePtr);
-    }
+    TclReleaseByteCode(codePtr);
     TclStackFree(interp, TD);	/* free my stack */
 
     return result;
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 1991aea..3ea9dd9 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -321,11 +321,9 @@ CreateHashEntry(
 
 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
 		hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
 	    if (hash != PTR2UINT(hPtr->hash)) {
 		continue;
 	    }
-#endif
 	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
 		if (newPtr) {
 		    *newPtr = 0;
@@ -336,11 +334,9 @@ CreateHashEntry(
     } else {
 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
 		hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
 	    if (hash != PTR2UINT(hPtr->hash)) {
 		continue;
 	    }
-#endif
 	    if (key == hPtr->key.oneWordValue) {
 		if (newPtr) {
 		    *newPtr = 0;
@@ -368,15 +364,9 @@ CreateHashEntry(
     }
 
     hPtr->tablePtr = tablePtr;
-#if TCL_HASH_KEY_STORE_HASH
     hPtr->hash = UINT2PTR(hash);
     hPtr->nextPtr = tablePtr->buckets[index];
     tablePtr->buckets[index] = hPtr;
-#else
-    hPtr->bucketPtr = &tablePtr->buckets[index];
-    hPtr->nextPtr = *hPtr->bucketPtr;
-    *hPtr->bucketPtr = hPtr;
-#endif
     tablePtr->numEntries++;
 
     /*
@@ -416,9 +406,7 @@ Tcl_DeleteHashEntry(
     const Tcl_HashKeyType *typePtr;
     Tcl_HashTable *tablePtr;
     Tcl_HashEntry **bucketPtr;
-#if TCL_HASH_KEY_STORE_HASH
     int index;
-#endif
 
     tablePtr = entryPtr->tablePtr;
 
@@ -433,7 +421,6 @@ Tcl_DeleteHashEntry(
 	typePtr = &tclArrayHashKeyType;
     }
 
-#if TCL_HASH_KEY_STORE_HASH
     if (typePtr->hashKeyProc == NULL
 	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
@@ -442,9 +429,6 @@ Tcl_DeleteHashEntry(
     }
 
     bucketPtr = &tablePtr->buckets[index];
-#else
-    bucketPtr = entryPtr->bucketPtr;
-#endif
 
     if (*bucketPtr == entryPtr) {
 	*bucketPtr = entryPtr->nextPtr;
@@ -1062,7 +1046,6 @@ RebuildTable(
     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
 	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
 	    *oldChainPtr = hPtr->nextPtr;
-#if TCL_HASH_KEY_STORE_HASH
 	    if (typePtr->hashKeyProc == NULL
 		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
@@ -1071,26 +1054,6 @@ RebuildTable(
 	    }
 	    hPtr->nextPtr = tablePtr->buckets[index];
 	    tablePtr->buckets[index] = hPtr;
-#else
-	    void *key = Tcl_GetHashKey(tablePtr, hPtr);
-
-	    if (typePtr->hashKeyProc) {
-		unsigned int hash;
-
-		hash = typePtr->hashKeyProc(tablePtr, key);
-		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-		    index = RANDOM_INDEX(tablePtr, hash);
-		} else {
-		    index = hash & tablePtr->mask;
-		}
-	    } else {
-		index = RANDOM_INDEX(tablePtr, key);
-	    }
-
-	    hPtr->bucketPtr = &tablePtr->buckets[index];
-	    hPtr->nextPtr = *hPtr->bucketPtr;
-	    *hPtr->bucketPtr = hPtr;
-#endif
 	}
     }
 
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 834f225..de65da5 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,7 +16,7 @@
  */
 
 typedef struct AcceptCallback {
-    char *script;		/* Script to invoke. */
+    Tcl_Obj *script;		/* Script to invoke. */
     Tcl_Interp *interp;		/* Interpreter in which to run it. */
 } AcceptCallback;
 
@@ -37,8 +37,7 @@ static Tcl_ThreadDataKey dataKey;
  */
 
 static void		FinalizeIOCmdTSD(ClientData clientData);
-static void		AcceptCallbackProc(ClientData callbackData,
-			    Tcl_Channel chan, char *address, int port);
+static Tcl_TcpAcceptProc AcceptCallbackProc;
 static int		ChanPendingObjCmd(ClientData unused,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -1373,15 +1372,22 @@ AcceptCallbackProc(
      */
 
     if (acceptCallbackPtr->interp != NULL) {
-	char portBuf[TCL_INTEGER_SPACE];
-	char *script = acceptCallbackPtr->script;
 	Tcl_Interp *interp = acceptCallbackPtr->interp;
-	int result;
+	Tcl_Obj *script, *objv[2];
+	int result = TCL_OK;
 
-	Tcl_Preserve(script);
-	Tcl_Preserve(interp);
+	objv[0] = acceptCallbackPtr->script;
+	objv[1] = Tcl_NewListObj(3, NULL);
+	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(
+		Tcl_GetChannelName(chan), -1));
+	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1));
+	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewIntObj(port));
+
+	script = Tcl_ConcatObj(2, objv);
+	Tcl_IncrRefCount(script);
+	Tcl_DecrRefCount(objv[1]);
 
-	TclFormatInt(portBuf, port);
+	Tcl_Preserve(interp);
 	Tcl_RegisterChannel(interp, chan);
 
 	/*
@@ -1391,8 +1397,9 @@ AcceptCallbackProc(
 
 	Tcl_RegisterChannel(NULL, chan);
 
-	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
-		" ", address, " ", portBuf, NULL);
+	result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(script);
+
 	if (result != TCL_OK) {
 	    Tcl_BackgroundException(interp, result);
 	    Tcl_UnregisterChannel(interp, chan);
@@ -1406,7 +1413,6 @@ AcceptCallbackProc(
 	Tcl_UnregisterChannel(NULL, chan);
 
 	Tcl_Release(interp);
-	Tcl_Release(script);
     } else {
 	/*
 	 * The interpreter has been deleted, so there is no useful way to use
@@ -1450,7 +1456,7 @@ TcpServerCloseProc(
 	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
 		acceptCallbackPtr);
     }
-    Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
+    Tcl_DecrRefCount(acceptCallbackPtr->script);
     ckfree(acceptCallbackPtr);
 }
 
@@ -1485,7 +1491,8 @@ Tcl_SocketObjCmd(
 	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
     };
     int optionIndex, a, server = 0, port, myport = 0, async = 0;
-    const char *host, *script = NULL, *myaddr = NULL;
+    const char *host, *myaddr = NULL;
+    Tcl_Obj *script = NULL;
     Tcl_Channel chan;
 
     if (TclpHasSockets(interp) != TCL_OK) {
@@ -1548,7 +1555,7 @@ Tcl_SocketObjCmd(
 			"no argument given for -server option", -1));
 		return TCL_ERROR;
 	    }
-	    script = TclGetString(objv[a]);
+	    script = objv[a];
 	    break;
 	default:
 	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1589,16 +1596,14 @@ Tcl_SocketObjCmd(
     if (server) {
 	AcceptCallback *acceptCallbackPtr =
 		ckalloc(sizeof(AcceptCallback));
-	unsigned len = strlen(script) + 1;
-	char *copyScript = ckalloc(len);
 
-	memcpy(copyScript, script, len);
-	acceptCallbackPtr->script = copyScript;
+	Tcl_IncrRefCount(script);
+	acceptCallbackPtr->script = script;
 	acceptCallbackPtr->interp = interp;
 	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
 		acceptCallbackPtr);
 	if (chan == NULL) {
-	    ckfree(copyScript);
+	    Tcl_DecrRefCount(script);
 	    ckfree(acceptCallbackPtr);
 	    return TCL_ERROR;
 	}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42c13dd..1dab0cb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3133,6 +3133,7 @@ MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
 MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
 MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
+MODULE_SCOPE int	TclUtfCount(int ch);
 MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
 MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
 MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -4084,6 +4085,7 @@ MODULE_SCOPE void	TclFreeAllocCache(void *);
 MODULE_SCOPE void *	TclpGetAllocCache(void);
 MODULE_SCOPE void	TclpSetAllocCache(void *);
 MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
+MODULE_SCOPE void	TclpInitAllocCache(void);
 MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
 /*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index dfab185..58a86d9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1105,8 +1105,6 @@ TclTeardownNamespace(
     Interp *iPtr = (Interp *) nsPtr->interp;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
-    Tcl_Namespace *childNsPtr;
-    Tcl_Command cmd;
     int i;
 
     /*
@@ -1121,16 +1119,31 @@ TclTeardownNamespace(
     /*
      * Delete all commands in this namespace. Be careful when traversing the
      * hash table: when each command is deleted, it removes itself from the
-     * command table.
-     *
-     * Don't optimize to Tcl_NextHashEntry() because of traces.
+     * command table. Because of traces (and the desire to avoid the quadratic
+     * problems of just using Tcl_FirstHashEntry over and over, [Bug
+     * f97d4ee020]) we copy to a temporary array and then delete all those
+     * commands.
      */
 
-    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
-	cmd = Tcl_GetHashValue(entryPtr);
-	Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+    while (nsPtr->cmdTable.numEntries > 0) {
+	int length = nsPtr->cmdTable.numEntries;
+	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Command *) * length);
+
+	i = 0;
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    cmds[i] = Tcl_GetHashValue(entryPtr);
+	    cmds[i]->refCount++;
+	    i++;
+	}
+	for (i = 0 ; i < length ; i++) {
+	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+		    (Tcl_Command) cmds[i]);
+	    TclCleanupCommandMacro(cmds[i]);
+	}
+	TclStackFree((Tcl_Interp *) iPtr, cmds);
     }
     Tcl_DeleteHashTable(&nsPtr->cmdTable);
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -1175,25 +1188,54 @@ TclTeardownNamespace(
      *
      * BE CAREFUL: When each child is deleted, it will divorce itself from its
      * parent. You can't traverse a hash table properly if its elements are
-     * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
+     * being deleted.  Because of traces (and the desire to avoid the
+     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+     * f97d4ee020]) we copy to a temporary array and then delete all those
+     * namespaces.
      *
-     * Don't optimize to Tcl_NextHashEntry() because of traces.
+     * Important: leave the hash table itself still live.
      */
 
 #ifndef BREAK_NAMESPACE_COMPAT
-    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
-	childNsPtr = Tcl_GetHashValue(entryPtr);
-	Tcl_DeleteNamespace(childNsPtr);
+    while (nsPtr->childTable.numEntries > 0) {
+	int length = nsPtr->childTable.numEntries;
+	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Namespace *) * length);
+
+	i = 0;
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    children[i] = Tcl_GetHashValue(entryPtr);
+	    children[i]->refCount++;
+	    i++;
+	}
+	for (i = 0 ; i < length ; i++) {
+	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+	    TclNsDecrRefCount(children[i]);
+	}
+	TclStackFree((Tcl_Interp *) iPtr, children);
     }
 #else
     if (nsPtr->childTablePtr != NULL) {
-	for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
-	    childNsPtr = Tcl_GetHashValue(entryPtr);
-	    Tcl_DeleteNamespace(childNsPtr);
+	while (nsPtr->childTablePtr->numEntries > 0) {
+	    int length = nsPtr->childTablePtr->numEntries;
+	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Namespace *) * length);
+
+	    i = 0;
+	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		children[i] = Tcl_GetHashValue(entryPtr);
+		children[i]->refCount++;
+		i++;
+	    }
+	    for (i = 0 ; i < length ; i++) {
+		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		TclNsDecrRefCount(children[i]);
+	    }
+	    TclStackFree((Tcl_Interp *) iPtr, children);
 	}
     }
 #endif
diff --git a/generic/tclObj.c b/generic/tclObj.c
index c641152..a45a392 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -320,7 +320,7 @@ const Tcl_HashKeyType tclObjHashKeyType = {
  * does allow them to delete a command when references to it are gone, which
  * is fragile but useful given their somewhat-OO style. Because of this, this
  * structure MUST NOT be const so that the C compiler puts the data in
- * writable memory. [Bug 2558422]
+ * writable memory. [Bug 2558422] [Bug 07d13d99b0a9]
  * TODO: Provide a better API for those extensions so that they can coexist...
  */
 
@@ -4176,7 +4176,8 @@ Tcl_GetCommandFromObj(
      * had is invalid one way or another.
      */
 
-    if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
+    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
+    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
         return NULL;
     }
     resPtr = objPtr->internalRep.twoPtrValue.ptr1;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index ac65bde..172b860 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -69,9 +69,8 @@ const Tcl_ObjType tclProcBodyType = {
 };
 
 /*
- * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
- * encoding the type of level reference in ptr and the actual parsed out
- * offset in ptr2.
+ * The [upvar]/[uplevel] level reference type. Uses the longValue field
+ * to remember the integer value of a parsed #<integer> format.
  *
  * Uses the default behaviour throughout, and never disposes of the string
  * rep; it's just a cache type.
@@ -785,7 +784,7 @@ TclGetFrame(
  * Results:
  *	The return value is -1 if an error occurred in finding the frame (in
  *	this case an error message is left in the interp's result). 1 is
- *	returned if objPtr was either a number or a number preceded by "#" and
+ *	returned if objPtr was either an int or an int preceded by "#" and
  *	it specified a valid frame. 0 is returned if objPtr isn't one of the
  *	two things above (in this case, the lookup acts as if objPtr were
  *	"1"). The variable pointed to by framePtrPtr is filled in with the
@@ -807,95 +806,69 @@ TclObjGetFrame(
 {
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
-    CallFrame *framePtr;
-    const char *name;
+    const char *name = NULL;
 
     /*
      * Parse object to figure out which level number to go to.
      */
 
-    result = 1;
+    result = 0;
     curLevel = iPtr->varFramePtr->level;
-    if (objPtr == NULL) {
-	name = "1";
-	goto haveLevel1;
-    }
-
-    name = TclGetString(objPtr);
-    if (objPtr->typePtr == &levelReferenceType) {
-	if (objPtr->internalRep.twoPtrValue.ptr1) {
-	    level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
-	} else {
-	    level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
-	}
-	if (level < 0) {
-	    goto levelError;
-	}
-	/* TODO: Consider skipping the typePtr checks */
-    } else if (objPtr->typePtr == &tclIntType
-#ifndef TCL_WIDE_INT_IS_LONG
-	    || objPtr->typePtr == &tclWideIntType
-#endif
-	    ) {
-	if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
-	    goto levelError;
-	}
-	level = curLevel - level;
-    } else if (*name == '#') {
-	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
-	    goto levelError;
-	}
 
-	/*
-	 * Cache for future reference.
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
-	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
-    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
-	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
-	    return -1;
-	}
-
-	/*
-	 * Cache for future reference.
-	 */
+    /*
+     * Check for integer first, since that has potential to spare us
+     * a generation of a stringrep.
+     */
 
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
-	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
+    if (objPtr == NULL) {
+	/* Do nothing */
+    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
+	    && (level >= 0)) {
 	level = curLevel - level;
+	result = 1;
+    } else if (objPtr->typePtr == &levelReferenceType) {
+	level = (int) objPtr->internalRep.longValue;
+	result = 1;
     } else {
-	/*
-	 * Don't cache as the object *isn't* a level reference (might even be
-	 * NULL...)
-	 */
+	name = TclGetString(objPtr);
+	if (name[0] == '#') {
+	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
+		TclFreeIntRep(objPtr);
+		objPtr->typePtr = &levelReferenceType;
+		objPtr->internalRep.longValue = level;
+		result = 1;
+	    } else {
+		result = -1;
+	    }
+	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+	    /*
+	     * If this were an integer, we'd have succeeded already.
+	     * Docs say we have to treat this as a 'bad level'  error.
+	     */
+	    result = -1;
+	}
+    }
 
-    haveLevel1:
+    if (result == 0) {
 	level = curLevel - 1;
-	result = 0;
+	name = "1";
     }
-
-    /*
-     * Figure out which frame to use, and return it to the caller.
-     */
-
-    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
-	    framePtr = framePtr->callerVarPtr) {
-	if (framePtr->level == level) {
-	    break;
+    if (result != -1) {
+	if (level >= 0) {
+	    CallFrame *framePtr;
+	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+		    framePtr = framePtr->callerVarPtr) {
+		if (framePtr->level == level) {
+		    *framePtrPtr = framePtr;
+		    return result;
+		}
+	    }
+	}
+	if (name == NULL) {
+	    name = TclGetString(objPtr);
 	}
     }
-    if (framePtr == NULL) {
-	goto levelError;
-    }
-    *framePtrPtr = framePtr;
-    return result;
 
-  levelError:
     Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
     Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
     return -1;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8d70d20..b480735 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -36,15 +36,7 @@
 
 #include "tclInt.h"
 #include "tommath.h"
-
-/*
- * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
- * This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
- * post-8.6 development begins.
- */
-
-#define COMPAT 0
+#include "tclStringRep.h"
 
 /*
  * Prototypes for functions defined later in this file:
@@ -89,60 +81,6 @@ const Tcl_ObjType tclStringType = {
     UpdateStringOfString,	/* updateStringProc */
     SetStringFromAny		/* setFromAnyProc */
 };
-
-/*
- * The following structure is the internal rep for a String object. It keeps
- * track of how much memory has been used and how much has been allocated for
- * the Unicode and UTF string to enable growing and shrinking of the UTF and
- * Unicode reps of the String object with fewer mallocs. To optimize string
- * length and indexing operations, this structure also stores the number of
- * characters (same of UTF and Unicode!) once that value has been computed.
- *
- * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
- * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
- * can be officially modified by altering the definition of Tcl_UniChar in
- * tcl.h, but do not do that unless you are sure what you're doing!
- */
-
-typedef struct String {
-    int numChars;		/* The number of chars in the string. -1 means
-				 * this value has not been calculated. >= 0
-				 * means that there is a valid Unicode rep, or
-				 * that the number of UTF bytes == the number
-				 * of chars. */
-    int allocated;		/* The amount of space actually allocated for
-				 * the UTF string (minus 1 byte for the
-				 * termination char). */
-    int maxChars;		/* Max number of chars that can fit in the
-				 * space allocated for the unicode array. */
-    int hasUnicode;		/* Boolean determining whether the string has
-				 * a Unicode representation. */
-    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
-				 * of this field depends on the 'maxChars'
-				 * field above. */
-} String;
-
-#define STRING_MAXCHARS \
-	(int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
-#define STRING_SIZE(numChars) \
-	(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
-#define stringCheckLimits(numChars) \
-    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
-	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
-		STRING_MAXCHARS); \
-    }
-#define stringAttemptAlloc(numChars) \
-	(String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
-#define stringAlloc(numChars) \
-	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
-#define stringRealloc(ptr, numChars) \
-    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
-#define stringAttemptRealloc(ptr, numChars) \
-    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
-#define GET_STRING(objPtr) \
-	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_STRING(objPtr, stringPtr) \
-	((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
 
 /*
  * TCL STRING GROWTH ALGORITHM
@@ -498,18 +436,6 @@ Tcl_GetCharLength(
     if (numChars == -1) {
 	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
 	stringPtr->numChars = numChars;
-
-#if COMPAT
-	if (numChars < objPtr->length) {
-	    /*
-	     * Since we've just computed the number of chars, and not all UTF
-	     * chars are 1-byte long, go ahead and populate the unicode
-	     * string.
-	     */
-
-	    FillUnicodeRep(objPtr);
-	}
-#endif
     }
     return numChars;
 }
@@ -1226,11 +1152,7 @@ Tcl_AppendUnicodeToObj(
      * objPtr's string rep.
      */
 
-    if (stringPtr->hasUnicode
-#if COMPAT
-		&& stringPtr->numChars > 0
-#endif
-	    ) {
+    if (stringPtr->hasUnicode) {
 	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
     } else {
 	AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1334,11 +1256,7 @@ Tcl_AppendObjToObj(
      * appendObjPtr and append it.
      */
 
-    if (stringPtr->hasUnicode
-#if COMPAT
-		&& stringPtr->numChars > 0
-#endif
-	    ) {
+    if (stringPtr->hasUnicode) {
 	/*
 	 * If appendObjPtr is not of the "String" type, don't convert it.
 	 */
@@ -1371,11 +1289,7 @@ Tcl_AppendObjToObj(
 
     AppendUtfToUtfRep(objPtr, bytes, length);
 
-    if (numChars >= 0 && appendNumChars >= 0
-#if COMPAT
-		&& appendNumChars == length
-#endif
-	    ) {
+    if (numChars >= 0 && appendNumChars >= 0) {
 	stringPtr->numChars = numChars + appendNumChars;
     }
 }
@@ -1499,14 +1413,6 @@ AppendUnicodeToUtfRep(
     if (stringPtr->numChars != -1) {
 	stringPtr->numChars += numChars;
     }
-
-#if COMPAT
-    /*
-     * Invalidate the unicode rep.
-     */
-
-    stringPtr->hasUnicode = 0;
-#endif
 }
 
 /*
@@ -2924,7 +2830,6 @@ DupStringInternalRep(
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
 
-#if COMPAT==0
     if (srcStringPtr->numChars == -1) {
 	/*
 	 * The String struct in the source value holds zero useful data. Don't
@@ -2967,41 +2872,6 @@ DupStringInternalRep(
      */
 
     copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else /* COMPAT!=0 */
-    /*
-     * If the src obj is a string of 1-byte Utf chars, then copy the string
-     * rep of the source object and create an "empty" Unicode internal rep for
-     * the new object. Otherwise, copy Unicode internal rep, and invalidate
-     * the string rep of the new object.
-     */
-
-    if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
-	/*
-	 * Copy the full allocation for the Unicode buffer.
-	 */
-
-	copyStringPtr = stringAlloc(srcStringPtr->maxChars);
-	copyStringPtr->maxChars = srcStringPtr->maxChars;
-	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
-		srcStringPtr->numChars * sizeof(Tcl_UniChar));
-	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
-	copyStringPtr->allocated = 0;
-    } else {
-	copyStringPtr = stringAlloc(0);
-	copyStringPtr->unicode[0] = 0;
-	copyStringPtr->maxChars = 0;
-
-	/*
-	 * Tricky point: the string value was copied by generic object
-	 * management code, so it doesn't contain any extra bytes that might
-	 * exist in the source object.
-	 */
-
-	copyStringPtr->allocated = copyPtr->length;
-    }
-    copyStringPtr->numChars = srcStringPtr->numChars;
-    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif /* COMPAT==0 */
 
     SET_STRING(copyPtr, copyStringPtr);
     copyPtr->typePtr = &tclStringType;
@@ -3097,7 +2967,7 @@ ExtendStringRepWithUnicode(
      */
 
     int i, origLength, size = 0;
-    char *dst, buf[TCL_UTF_MAX];
+    char *dst;
     String *stringPtr = GET_STRING(objPtr);
 
     if (numChars < 0) {
@@ -3123,7 +2993,7 @@ ExtendStringRepWithUnicode(
     }
 
     for (i = 0; i < numChars && size >= 0; i++) {
-	size += Tcl_UniCharToUtf((int) unicode[i], buf);
+	size += TclUtfCount(unicode[i]);
     }
     if (size < 0) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
new file mode 100644
index 0000000..227e6bc
--- /dev/null
+++ b/generic/tclStringRep.h
@@ -0,0 +1,97 @@
+/*
+ * tclStringRep.h --
+ *
+ *	This file contains the definition of the Unicode string internal
+ *	representation and macros to access it.
+ *
+ *	A Unicode string is an internationalized string. Conceptually, a
+ *	Unicode string is an array of 16-bit quantities organized as a
+ *	sequence of properly formed UTF-8 characters. There is a one-to-one
+ *	map between Unicode and UTF characters. Because Unicode characters
+ *	have a fixed width, operations such as indexing operate on Unicode
+ *	data. The String object is optimized for the case where each UTF char
+ *	in a string is only one byte. In this case, we store the value of
+ *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
+ *	is explicitly called).
+ *
+ *	The String object type stores one or both formats. The default
+ *	behavior is to store UTF. Once Unicode is calculated by a function, it
+ *	is stored in the internal rep for future access (without an additional
+ *	O(n) cost).
+ *
+ *	To allow many appends to be done to an object without constantly
+ *	reallocating the space for the string or Unicode representation, we
+ *	allocate double the space for the string or Unicode and use the
+ *	internal representation to keep track of how much space is used vs.
+ *	allocated.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * The following structure is the internal rep for a String object. It keeps
+ * track of how much memory has been used and how much has been allocated for
+ * the Unicode and UTF string to enable growing and shrinking of the UTF and
+ * Unicode reps of the String object with fewer mallocs. To optimize string
+ * length and indexing operations, this structure also stores the number of
+ * characters (same of UTF and Unicode!) once that value has been computed.
+ *
+ * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
+ * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
+ * can be officially modified by altering the definition of Tcl_UniChar in
+ * tcl.h, but do not do that unless you are sure what you're doing!
+ */
+
+typedef struct String {
+    int numChars;		/* The number of chars in the string. -1 means
+				 * this value has not been calculated. >= 0
+				 * means that there is a valid Unicode rep, or
+				 * that the number of UTF bytes == the number
+				 * of chars. */
+    int allocated;		/* The amount of space actually allocated for
+				 * the UTF string (minus 1 byte for the
+				 * termination char). */
+    int maxChars;		/* Max number of chars that can fit in the
+				 * space allocated for the unicode array. */
+    int hasUnicode;		/* Boolean determining whether the string has
+				 * a Unicode representation. */
+    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
+				 * of this field depends on the 'maxChars'
+				 * field above. */
+} String;
+
+#define STRING_MAXCHARS \
+    (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
+#define STRING_SIZE(numChars) \
+    (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+#define stringCheckLimits(numChars) \
+    do {								\
+	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
+	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
+		      STRING_MAXCHARS);					\
+	}								\
+    } while (0)
+#define stringAttemptAlloc(numChars) \
+    (String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
+#define stringAlloc(numChars) \
+    (String *) ckalloc((unsigned) STRING_SIZE(numChars))
+#define stringRealloc(ptr, numChars) \
+    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+#define stringAttemptRealloc(ptr, numChars) \
+    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+#define GET_STRING(objPtr) \
+    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_STRING(objPtr, stringPtr) \
+    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 4695ab5..7c30d36 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -323,6 +323,9 @@ static int		TestparsevarObjCmd(ClientData dummy,
 static int		TestparsevarnameObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		TestpreferstableObjCmd(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[]);
@@ -653,6 +656,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -3794,6 +3799,36 @@ TestparsevarnameObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestpreferstableObjCmd --
+ *
+ *	This procedure implements the "testpreferstable" command.  It is
+ *	used for being able to test the "package" command even when the
+ *  environment variable TCL_PKG_PREFER_LATEST is set in your environment.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestpreferstableObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    iPtr->packagePrefer = PKG_PREFER_STABLE;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestregexpObjCmd --
  *
  *	This procedure implements the "testregexp" command. It is used to give
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index b878149..6c4cb7f 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -84,17 +84,11 @@ static const unsigned char totalBytes[256] = {
     1,1,1,1
 #endif
 };
-
-/*
- * Functions used only in this module.
- */
-
-static int		UtfCount(int ch);
 
 /*
  *---------------------------------------------------------------------------
  *
- * UtfCount --
+ * TclUtfCount --
  *
  *	Find the number of bytes in the Utf character "ch".
  *
@@ -107,8 +101,8 @@ static int		UtfCount(int ch);
  *---------------------------------------------------------------------------
  */
 
-INLINE static int
-UtfCount(
+int
+TclUtfCount(
     int ch)			/* The Tcl_UniChar whose size is returned. */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
@@ -143,7 +137,7 @@ UtfCount(
  *---------------------------------------------------------------------------
  */
 
-INLINE int
+int
 Tcl_UniCharToUtf(
     int ch,			/* The Tcl_UniChar to be stored in the
 				 * buffer. */
@@ -829,7 +823,7 @@ Tcl_UtfToUpper(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < UtfCount(upChar)) {
+	if (bytes < TclUtfCount(upChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -882,7 +876,7 @@ Tcl_UtfToLower(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < UtfCount(lowChar)) {
+	if (bytes < TclUtfCount(lowChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -932,7 +926,7 @@ Tcl_UtfToTitle(
 	bytes = TclUtfToUniChar(src, &ch);
 	titleChar = Tcl_UniCharToTitle(ch);
 
-	if (bytes < UtfCount(titleChar)) {
+	if (bytes < TclUtfCount(titleChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -944,7 +938,7 @@ Tcl_UtfToTitle(
 	bytes = TclUtfToUniChar(src, &ch);
 	lowChar = Tcl_UniCharToLower(ch);
 
-	if (bytes < UtfCount(lowChar)) {
+	if (bytes < TclUtfCount(lowChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 5574f30..b5b5b10 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -202,14 +202,9 @@ MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
 
 static Tcl_DupInternalRepProc	DupLocalVarName;
 static Tcl_FreeInternalRepProc	FreeLocalVarName;
-static Tcl_UpdateStringProc	PanicOnUpdateVarName;
 
 static Tcl_FreeInternalRepProc	FreeParsedVarName;
 static Tcl_DupInternalRepProc	DupParsedVarName;
-static Tcl_UpdateStringProc	UpdateParsedVarName;
-
-static Tcl_UpdateStringProc	PanicOnUpdateVarName;
-static Tcl_SetFromAnyProc	PanicOnSetVarName;
 
 /*
  * Types of Tcl_Objs used to cache variable lookups.
@@ -232,12 +227,12 @@ static Tcl_SetFromAnyProc	PanicOnSetVarName;
 
 static const Tcl_ObjType localVarNameType = {
     "localVarName",
-    FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
+    FreeLocalVarName, DupLocalVarName, NULL, NULL
 };
 
 static const Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
-    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
+    FreeParsedVarName, DupParsedVarName, NULL, NULL
 };
 
 /*
@@ -536,7 +531,6 @@ TclObjLookupVarEx(
     const char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
     const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
-    char *newPart2 = NULL;
     *arrayPtrPtr = NULL;
 
     if (typePtr == &localVarNameType) {
@@ -583,9 +577,7 @@ TclObjLookupVarEx(
 		}
 		return NULL;
 	    }
-	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
-	    if (newPart2) {
-		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+	    if ((part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2)) {
 		if (createPart2) {
 		    Tcl_IncrRefCount(part2Ptr);
 		}
@@ -629,11 +621,7 @@ TclObjLookupVarEx(
 		len2 = len1 - i - 2;
 		len1 = i;
 
-		newPart2 = ckalloc(len2 + 1);
-		memcpy(newPart2, part2, (unsigned) len2);
-		*(newPart2+len2) = '\0';
-		part2 = newPart2;
-		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+		part2Ptr = Tcl_NewStringObj(part2, len2);
 		if (createPart2) {
 		    Tcl_IncrRefCount(part2Ptr);
 		}
@@ -658,7 +646,8 @@ TclObjLookupVarEx(
 		Tcl_IncrRefCount(part1Ptr);
 
 		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
-		objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
+		Tcl_IncrRefCount(part2Ptr);
+		objPtr->internalRep.twoPtrValue.ptr2 = part2Ptr;
 
 		typePtr = part1Ptr->typePtr;
 		part1 = TclGetString(part1Ptr);
@@ -683,9 +672,6 @@ TclObjLookupVarEx(
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
 		    TclGetString(part1Ptr), NULL);
 	}
-	if (newPart2) {
-	    Tcl_DecrRefCount(part2Ptr);
-	}
 	return NULL;
     }
 
@@ -734,9 +720,6 @@ TclObjLookupVarEx(
 	*arrayPtrPtr = varPtr;
 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
 		createPart1, createPart2, varPtr, -1);
-	if (newPart2) {
-	    Tcl_DecrRefCount(part2Ptr);
-	}
     }
     return varPtr;
 }
@@ -5518,28 +5501,6 @@ TclObjVarErrMsg(
  */
 
 /*
- * Panic functions that should never be called in normal operation.
- */
-
-static void
-PanicOnUpdateVarName(
-    Tcl_Obj *objPtr)
-{
-    Tcl_Panic("%s of type %s should not be called", "updateStringProc",
-	    objPtr->typePtr->name);
-}
-
-static int
-PanicOnSetVarName(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
-{
-    Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
-	    objPtr->typePtr->name);
-    return TCL_ERROR;
-}
-
-/*
  * localVarName -
  *
  * INTERNALREP DEFINITION:
@@ -5592,11 +5553,11 @@ FreeParsedVarName(
     Tcl_Obj *objPtr)
 {
     register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
+    register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2;
 
     if (arrayPtr != NULL) {
 	TclDecrRefCount(arrayPtr);
-	ckfree(elem);
+	TclDecrRefCount(elem);
     }
     objPtr->typePtr = NULL;
 }
@@ -5607,58 +5568,17 @@ DupParsedVarName(
     Tcl_Obj *dupPtr)
 {
     register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
-    char *elemCopy;
-    unsigned elemLen;
+    register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2;
 
     if (arrayPtr != NULL) {
 	Tcl_IncrRefCount(arrayPtr);
-	elemLen = strlen(elem);
-	elemCopy = ckalloc(elemLen + 1);
-	memcpy(elemCopy, elem, elemLen);
-	*(elemCopy + elemLen) = '\0';
-	elem = elemCopy;
+	Tcl_IncrRefCount(elem);
     }
 
     dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
     dupPtr->internalRep.twoPtrValue.ptr2 = elem;
     dupPtr->typePtr = &tclParsedVarNameType;
 }
-
-static void
-UpdateParsedVarName(
-    Tcl_Obj *objPtr)
-{
-    Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
-    const char *part1;
-    char *p;
-    int len1, len2, totalLen;
-
-    if (arrayPtr == NULL) {
-	/*
-	 * This is a parsed scalar name: what is it doing here?
-	 */
-
-	Tcl_Panic("scalar parsedVarName without a string rep");
-    }
-
-    part1 = TclGetStringFromObj(arrayPtr, &len1);
-    len2 = strlen(part2);
-
-    totalLen = len1 + len2 + 2;
-    p = ckalloc(totalLen + 1);
-    objPtr->bytes = p;
-    objPtr->length = totalLen;
-
-    memcpy(p, part1, (unsigned) len1);
-    p += len1;
-    *p++ = '(';
-    memcpy(p, part2, (unsigned) len2);
-    p += len2;
-    *p++ = ')';
-    *p = '\0';
-}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 50d9a30..691d57a 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1194,11 +1194,12 @@ Tcl_ZlibStreamPut(
 	zshPtr->stream.next_out = (Bytef *) dataTmp;
 
 	e = deflate(&zshPtr->stream, flush);
-	while (e == Z_BUF_ERROR) {
+	while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
 	    /*
-	     * Output buffer too small to hold the data being generated; so
-	     * put a new buffer into place after saving the old generated
-	     * data to the outData list.
+	     * Output buffer too small to hold the data being generated or we
+	     * are doing the end-of-stream flush (which can spit out masses of
+	     * data). This means we need to put a new buffer into place after
+	     * saving the old generated data to the outData list.
 	     */
 
 	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);