merge trunkdgp_literal_reform

23 files changed, 428 insertions, 152 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7a5ffcc..06f277f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1300,7 +1300,7 @@ AssembleOneLine(
 	    goto cleanup;
 	}
 	operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
-	litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
 	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
 	break;
 
@@ -1449,7 +1449,7 @@ AssembleOneLine(
 	    goto cleanup;
 	} else {
 	    operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
-	    litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
 
 	    /*
 	     * Assumes that PUSH is the first slot!
@@ -3541,7 +3541,7 @@ StackCheckExit(
 	     * Emit a 'push' of the empty literal.
 	     */
 
-	    litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+	    litIndex = TclRegisterLiteral(envPtr, "", 0, 0);
 
 	    /*
 	     * Assumes that 'push' is at slot 0 in TalInstructionTable.
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 593a8af..ff5495c 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2761,7 +2761,7 @@ TclCompileSyntaxError(
     const char *bytes = TclGetStringFromObj(msg, &numBytes);
 
     TclErrorStackResetIf(interp, bytes, numBytes);
-    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
+    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
     CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
 	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
     Tcl_ResetResult(interp);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 2503089..10b3cc8 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1456,8 +1456,8 @@ TclSubstCompile(
 
 	switch (tokenPtr->type) {
 	case TCL_TOKEN_TEXT:
-	    literal = TclRegisterNewLiteral(envPtr,
-		    tokenPtr->start, tokenPtr->size);
+	    literal = TclRegisterLiteral(envPtr,
+		    tokenPtr->start, tokenPtr->size, 0);
 	    TclEmitPush(literal, envPtr);
 	    TclAdvanceLines(&bline, tokenPtr->start,
 		    tokenPtr->start + tokenPtr->size);
@@ -1466,7 +1466,7 @@ TclSubstCompile(
 	case TCL_TOKEN_BS:
 	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
 		    NULL, buf);
-	    literal = TclRegisterNewLiteral(envPtr, buf, length);
+	    literal = TclRegisterLiteral(envPtr, buf, length, 0);
 	    TclEmitPush(literal, envPtr);
 	    count++;
 	    continue;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 654666a..83bb883 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2267,9 +2267,9 @@ CompileExprTree(
 		p = TclGetStringFromObj(*funcObjv, &length);
 		funcObjv++;
 		Tcl_DStringAppend(&cmdName, p, length);
-		TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
+		TclEmitPush(TclRegisterLiteral(envPtr,
 			Tcl_DStringValue(&cmdName),
-			Tcl_DStringLength(&cmdName)), envPtr);
+			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
 		Tcl_DStringFree(&cmdName);
 
 		/*
@@ -2376,8 +2376,8 @@ CompileExprTree(
 		pc1 = CurrentOffset(envPtr);
 		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
 			: INST_JUMP_TRUE1, 0, envPtr);
-		TclEmitPush(TclRegisterNewLiteral(envPtr,
-			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
+		TclEmitPush(TclRegisterLiteral(envPtr,
+			(nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
 		pc2 = CurrentOffset(envPtr);
 		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
 		TclAdjustStackDepth(-1, envPtr);
@@ -2386,8 +2386,8 @@ CompileExprTree(
 		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
 		    pc2 += 3;
 		}
-		TclEmitPush(TclRegisterNewLiteral(envPtr,
-			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
+		TclEmitPush(TclRegisterLiteral(envPtr,
+			(nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
 		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
 			envPtr->codeStart + pc2 + 1);
 		convert = 0;
@@ -2421,7 +2421,7 @@ CompileExprTree(
 	    if (optimize) {
 		int length;
 		const char *bytes = TclGetStringFromObj(literal, &length);
-		int index = TclRegisterNewLiteral(envPtr, bytes, length);
+		int index = TclRegisterLiteral(envPtr, bytes, length, 0);
 		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
 
 		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
@@ -2479,8 +2479,8 @@ CompileExprTree(
 		    if (objPtr->bytes) {
 			Tcl_Obj *tableValue;
 
-			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
-				objPtr->length);
+			index = TclRegisterLiteral(envPtr, objPtr->bytes,
+				objPtr->length, 0);
 			tableValue = TclFetchLiteral(envPtr, index);
 			if ((tableValue->typePtr == NULL) &&
 				(objPtr->typePtr != NULL)) {
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index fd24cfd..1ae333f 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1791,9 +1791,17 @@ CompileCmdLiteral(
     CompileEnv *envPtr)
 {
     int numBytes;
-    const char *bytes = TclGetStringFromObj(cmdObj, &numBytes);
-    int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
-    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+    const char *bytes;
+    Command *cmdPtr;
+    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
+
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
+	extraLiteralFlags |= LITERAL_UNSHARED;
+    }
+
+    bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
 
     if (cmdPtr) {
 	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
@@ -1828,8 +1836,8 @@ TclCompileInvocation(
 	    continue;
 	}
 
-	objIdx = TclRegisterNewLiteral(envPtr,
-		tokenPtr[1].start, tokenPtr[1].size);
+	objIdx = TclRegisterLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size, 0);
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
@@ -1878,8 +1886,8 @@ CompileExpanded(
 	    continue;
 	}
 
-	objIdx = TclRegisterNewLiteral(envPtr,
-		tokenPtr[1].start, tokenPtr[1].size);
+	objIdx = TclRegisterLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size, 0);
 	if (envPtr->clNext) {
 	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
 		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index e271d9e..1b82b3d 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1095,7 +1095,8 @@ MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
 MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
 			    CompileEnv *envPtr);
 MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
-MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, char *bytes, int length);
+MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
+			    int length);
 MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
 MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
 			    LiteralTable *tablePtr);
@@ -1207,29 +1208,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 
 #define LITERAL_ON_HEAP		0x01
 #define LITERAL_CMD_NAME	0x02
-
-/*
- * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
- * cast away constness, and it is cleanest to do that here, all in one place.
- *
- * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
- *			     int length);
- */
-
-#define TclRegisterNewLiteral(envPtr, bytes, length) \
-    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
-
-/*
- * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
- * is safe to cast away constness, and it is cleanest to do that here, all in
- * one place.
- *
- * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
- *			       int length);
- */
-
-#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
-    TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
+#define LITERAL_UNSHARED	0x04
 
 /*
  * Macro used to manually adjust the stack requirements; used in cases where
@@ -1546,9 +1525,9 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
  */
 
 #define PushLiteral(envPtr, string, length) \
-    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+    TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
 #define PushStringLiteral(envPtr, string) \
-    PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
+    PushLiteral(envPtr, string, (int) (sizeof(string "") - 1))
 
 /*
  * Macro to advance to the next token; it is more mnemonic than the address
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 2766769..43813f1 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3306,7 +3306,7 @@ CompileToInvokedCommand(
     Tcl_Token *tokPtr;
     Tcl_Obj *objPtr, **words;
     char *bytes;
-    int length, i, numWords, cmdLit;
+    int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
     DefineLineInformation;
 
     /*
@@ -3326,8 +3326,8 @@ CompileToInvokedCommand(
 
 	SetLineInformation(i);
 	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    int literal = TclRegisterNewLiteral(envPtr,
-		    tokPtr[1].start, tokPtr[1].size);
+	    int literal = TclRegisterLiteral(envPtr,
+		    tokPtr[1].start, tokPtr[1].size, 0);
 
 	    if (envPtr->clNext) {
 		TclContinuationsEnterDerived(
@@ -3348,8 +3348,11 @@ CompileToInvokedCommand(
 
     objPtr = Tcl_NewObj();
     Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
-    bytes = TclGetStringFromObj(objPtr, &length);
-    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
+	extraLiteralFlags |= LITERAL_UNSHARED;
+    }
+    cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
     TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
     TclEmitPush(cmdLit, envPtr);
     TclDecrRefCount(objPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 704e494..df36958 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1554,7 +1554,7 @@ CompileExprObj(
 	 */
 
 	if (compEnv.codeNext == compEnv.codeStart) {
-	    TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
+	    TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, 0),
 		    &compEnv);
 	}
 
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 4e7e422..c00dff1 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1009,7 +1009,7 @@ declare 250 {
 # Allow extensions for optimization
 declare 251 {
     int TclRegisterLiteral(void *envPtr,
-	    char *bytes, int length, int flags)
+	    const char *bytes, int length, int flags)
 }
 
 ##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b39c8ea..da1b5c5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1690,11 +1690,13 @@ typedef struct Command {
  * (these last two flags are defined in tcl.h)
  */
 
-#define CMD_IS_DELETED		    0x1
-#define CMD_TRACE_ACTIVE	    0x2
-#define CMD_HAS_EXEC_TRACES	    0x4
-#define CMD_COMPILES_EXPANDED	    0x8
+#define CMD_IS_DELETED		    0x01
+#define CMD_TRACE_ACTIVE	    0x02
+#define CMD_HAS_EXEC_TRACES	    0x04
+#define CMD_COMPILES_EXPANDED	    0x08
 #define CMD_REDEF_IN_PROGRESS	    0x10
+#define CMD_VIA_RESOLVER	    0x20
+
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index f95f999..dfa5727 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -615,7 +615,7 @@ EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
 EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
 				int force);
 /* 251 */
-EXTERN int		TclRegisterLiteral(void *envPtr, char *bytes,
+EXTERN int		TclRegisterLiteral(void *envPtr, const char *bytes,
 				int length, int flags);
 
 typedef struct TclIntStubs {
@@ -873,7 +873,7 @@ typedef struct TclIntStubs {
     int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
     char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
     void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
-    int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
+    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
 } TclIntStubs;
 
 extern const TclIntStubs *tclIntStubsPtr;
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 5dd413a..9db0735 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -28,9 +28,9 @@
  * Function prototypes for static functions in this file:
  */
 
-static Tcl_Obj *	CreateLiteral(Interp *iPtr, char *bytes, int length,
-			    int *newPtr, Namespace *nsPtr, int flags,
-			    LiteralEntry **globalPtrPtr);
+static Tcl_Obj *	CreateLiteral(Interp *iPtr, const char *bytes,
+			    int length, int *newPtr, Namespace *nsPtr,
+			    int flags, LiteralEntry **globalPtrPtr);
 static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
 static unsigned		HashString(const char *string, int length);
 #ifdef TCL_COMPILE_DEBUG
@@ -174,7 +174,7 @@ TclDeleteLiteralTable(
 Tcl_Obj *
 TclCreateLiteral(
     Interp *iPtr,
-    char *bytes,		/* The start of the string. Note that this is
+    const char *bytes,	/* The start of the string. Note that this is
 				 * not a NUL-terminated string. */
     int length)			/* Number of bytes in the string. */
 {
@@ -185,7 +185,7 @@ TclCreateLiteral(
 static Tcl_Obj *
 CreateLiteral(
     Interp *iPtr,
-    char *bytes,		/* The start of the string. Note that this is
+    const char *bytes,		/* The start of the string. Note that this is
 				 * not a NUL-terminated string. */
     int length,			/* Number of bytes in the string. */
     int *newPtr,
@@ -220,7 +220,7 @@ CreateLiteral(
 	    if (newPtr) {
 		*newPtr = 0;
 	    }
-	    if (flags & LITERAL_ON_HEAP) {
+	    if ((flags & LITERAL_ON_HEAP)) {
 		ckfree(bytes);
 	    }
 	    if (globalPtrPtr) {
@@ -239,7 +239,7 @@ CreateLiteral(
 	}
     }
     if (newPtr == NULL) {
-	if (flags & LITERAL_ON_HEAP) {
+	if ((flags & LITERAL_ON_HEAP)) {
 	    ckfree(bytes);
 	}
 	return NULL;
@@ -252,13 +252,23 @@ CreateLiteral(
 
     TclNewObj(objPtr);
     Tcl_IncrRefCount(objPtr);
-    if (flags & LITERAL_ON_HEAP) {
-	objPtr->bytes = bytes;
+    if ((flags & LITERAL_ON_HEAP)) {
+	objPtr->bytes = (char *) bytes;
 	objPtr->length = length;
     } else {
 	TclInitStringRep(objPtr, bytes, length);
     }
 
+    if ((flags & LITERAL_UNSHARED)) {
+	/*
+	 * Make clear, that no global value is returned
+	 */
+	if (globalPtrPtr != NULL) {
+	    *globalPtrPtr = NULL;
+	}
+	return objPtr;
+    }
+
 #ifdef TCL_COMPILE_DEBUG
     if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
 	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
@@ -377,7 +387,7 @@ int
 TclRegisterLiteral(
     void *ePtr,		/* Points to the CompileEnv in whose object
 				 * array an object is found or created. */
-    register char *bytes,	/* Points to string for which to find or
+    register const char *bytes,	/* Points to string for which to find or
 				 * create an object in CompileEnv's object
 				 * array. */
     int length,			/* Number of bytes in the string. If < 0, the
@@ -404,7 +414,7 @@ TclRegisterLiteral(
      * interp's global NS.
      */
 
-    if (flags & LITERAL_CMD_NAME) {
+    if ((flags & LITERAL_CMD_NAME)) {
 	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
 	    nsPtr = iPtr->globalNsPtr;
 	} else {
@@ -419,7 +429,7 @@ TclRegisterLiteral(
     if (new) {
 	objIndex = TclAddLiteralObj(envPtr, objPtr, NULL);
 	Tcl_SetHashValue(hePtr, INT2PTR(objIndex));
-	if (!globalNew) {
+	if (!globalNew && globalPtr) {
 	    globalPtr->refCount++;
 	}
     } else {
@@ -891,9 +901,8 @@ TclInvalidateCmdLiteral(
 				 * invalidate a cmd literal. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralEntry *globalPtr;
-    Tcl_Obj *literalObjPtr = CreateLiteral(iPtr, (char *) name, -1,
-	    NULL, nsPtr, 0, &globalPtr);
+    Tcl_Obj *literalObjPtr = CreateLiteral(iPtr, name, strlen(name),
+	    NULL, nsPtr, 0, NULL);
 
     if (literalObjPtr != NULL) {
 	if (literalObjPtr->typePtr == &tclCmdNameType) {
@@ -1013,13 +1022,6 @@ TclVerifyLocalLiteralTable(
 	    Tcl_Panic("%s: literal has NULL string rep",
 		    "TclVerifyLocalLiteralTable");
 	}
-	if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, objPtr) == NULL) {
-	    int length;
-	    const char *bytes = TclGetStringFromObj(objPtr, &length);
-	    Tcl_Panic("%s: local literal \"%.*s\" is not global",
-			"TclVerifyLocalLiteralTable",
-			(length>60? 60 : length), bytes);
-	}
 	hePtr = Tcl_NextHashEntry(&search);
     }
 }
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 1fef919..74dfaf8 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -382,19 +382,6 @@ Tcl_PopCallFrame(
     register CallFrame *framePtr = iPtr->framePtr;
     Namespace *nsPtr;
 
-    /*
-     * It's important to remove the call frame from the interpreter's stack of
-     * call frames before deleting local variables, so that traces invoked by
-     * the variable deletion don't see the partially-deleted frame.
-     */
-
-    if (framePtr->callerPtr) {
-	iPtr->framePtr = framePtr->callerPtr;
-	iPtr->varFramePtr = framePtr->callerVarPtr;
-    } else {
-	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
-    }
-
     if (framePtr->varTablePtr != NULL) {
 	TclDeleteVars(iPtr, framePtr->varTablePtr);
 	ckfree(framePtr->varTablePtr);
@@ -422,6 +409,13 @@ Tcl_PopCallFrame(
     }
     framePtr->nsPtr = NULL;
 
+    if (framePtr->callerPtr) {
+	iPtr->framePtr = framePtr->callerPtr;
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+    } else {
+	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
+    }
+
     if (framePtr->tailcallPtr) {
 	TclSetTailcall(interp, framePtr->tailcallPtr);
     }
@@ -2566,7 +2560,9 @@ Tcl_FindCommand(
 	}
 
 	if (result == TCL_OK) {
+	    ((Command *)cmd)->flags |= CMD_VIA_RESOLVER;
 	    return cmd;
+
 	} else if (result != TCL_CONTINUE) {
 	    return NULL;
 	}
@@ -2658,6 +2654,7 @@ Tcl_FindCommand(
     }
 
     if (cmdPtr != NULL) {
+	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
 	return (Tcl_Command) cmdPtr;
     }
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index df17f13..d3f59ec 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4264,8 +4264,13 @@ TclSetCmdNameObj(
     Command *cmdPtr)		/* Points to Command structure that the
 				 * CmdName object should refer to. */
 {
+    register ResolvedCmdName *resPtr;
+
     if (objPtr->typePtr == &tclCmdNameType) {
-	return;
+	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+	if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
+	    return;
+	}
     }
 
     SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e0ed374..47d85e1 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7326,24 +7326,83 @@ InterpCmdResolver(
     CallFrame *varFramePtr = iPtr->varFramePtr;
     Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
             varFramePtr->procPtr : NULL;
-    Namespace *ns2NsPtr = (Namespace *)
-            Tcl_FindNamespace(interp, "::ns2", NULL, 0);
+    Namespace *callerNsPtr = varFramePtr->nsPtr;
+    Tcl_Command resolvedCmdPtr = NULL;
 
-    if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr
-            || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) {
-        const char *callingCmdName =
+    /*
+     * Just do something special on a cmd literal "z" in two cases:
+     *  A)  when the caller is a proc "x", and the proc is either in "::" or in "::ns2".
+     *  B) the caller's namespace is "ctx1" or "ctx2"
+     */
+    if ( (name[0] == 'z') && (name[1] == '\0') ) {
+        Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0);
+
+        if (procPtr != NULL
+            && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr)
+                || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr)
+                )
+            ) {
+            /*
+             * Case A)
+             *
+             *    - The context, in which this resolver becomes active, is
+             *      determined by the name of the caller proc, which has to be
+             *      named "x".
+             *
+             *    - To determine the name of the caller proc, the proc is taken
+             *      from the topmost stack frame.
+             *
+             *    - Note that the context is NOT provided during byte-code
+             *      compilation (e.g. in TclProcCompileProc)
+             *
+             *   When these conditions hold, this function resolves the
+             *   passed-in cmd literal into a cmd "y", which is taken from the
+             *   the global namespace (for simplicity).
+             */
+
+            const char *callingCmdName =
                 Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);
 
-        if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0')
-                && (name[0] == 'z') && (name[1] == '\0')) {
-            Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL,
-                    TCL_GLOBAL_ONLY);
+            if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
+            }
+        } else if (callerNsPtr != NULL) {
+            /*
+             * Case B)
+             *
+             *    - The context, in which this resolver becomes active, is
+             *      determined by the name of the parent namespace, which has
+             *      to be named "ctx1" or "ctx2".
+             *
+             *    - To determine the name of the parent namesace, it is taken
+             *      from the 2nd highest stack frame.
+             *
+             *    - Note that the context can be provided during byte-code
+             *      compilation (e.g. in TclProcCompileProc)
+             *
+             *   When these conditions hold, this function resolves the
+             *   passed-in cmd literal into a cmd "y" or "Y" depending on the
+             *   context. The resolved procs are taken from the the global
+             *   namespace (for simplicity).
+             */
+
+            CallFrame *parentFramePtr = varFramePtr->callerPtr;
+            char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";
 
-            if (sourceCmdPtr != NULL) {
-                *rPtr = sourceCmdPtr;
-                return TCL_OK;
+            if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
+                /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/
+
+            } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
+                /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/
             }
         }
+
+        if (resolvedCmdPtr != NULL) {
+            *rPtr = resolvedCmdPtr;
+            return TCL_OK;
+        }
     }
     return TCL_CONTINUE;
 }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 20bc208..0b371ee 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4956,13 +4956,16 @@ TclDeleteNamespaceVars(
 	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
 					 * hash. */
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
-	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags,
-		-1);
-	Tcl_DecrRefCount(objPtr);	/* Free no longer needed obj */
+	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
+		NULL, flags, -1);
 
 	/*
-	 * Remove the variable from the table and force it undefined in case
-	 * an unset trace brought it back from the dead.
+	 * We just unset the variable. However, an unset trace might
+	 * have re-set it, or might have re-established traces on it.
+	 * This namespace and its vartable are going away unconditionally,
+	 * so we cannot let such things linger. That would be a leak.
+	 *
+	 * First we destroy all traces. ...
 	 */
 
 	if (TclIsVarTraced(varPtr)) {
@@ -4986,6 +4989,17 @@ TclDeleteNamespaceVars(
 		}
 	    }
 	}
+
+	/*
+	 * ...and then, if the variable still holds a value, we unset it
+	 * again. This time with no traces left, we're sure it goes away.
+	 */
+
+	if (!TclIsVarUndefined(varPtr)) {
+	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
+		    NULL, flags, -1);
+	}
+	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
 	VarHashRefCount(varPtr)--;
 	VarHashDeleteEntry(varPtr);
     }
@@ -5018,27 +5032,44 @@ TclDeleteVars(
     TclVarHashTable *tablePtr)	/* Hash table containing variables to
 				 * delete. */
 {
-    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
     Tcl_HashSearch search;
     register Var *varPtr;
-    int flags;
-    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-
-    /*
-     * Determine what flags to pass to the trace callback functions.
-     */
-
-    flags = TCL_TRACE_UNSETS;
-    if (tablePtr == &iPtr->globalNsPtr->varTable) {
-	flags |= TCL_GLOBAL_ONLY;
-    } else if (tablePtr == &currNsPtr->varTable) {
-	flags |= TCL_NAMESPACE_ONLY;
-    }
 
     for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
 	 varPtr = VarHashFirstVar(tablePtr, &search)) {
-	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
-		-1);
+	VarHashRefCount(varPtr)++;
+
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
+		NULL, TCL_TRACE_UNSETS, -1);
+
+        if (TclIsVarTraced(varPtr)) {
+            Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
+            VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
+            ActiveVarTrace *activePtr;
+
+            while (tracePtr) {
+                VarTrace *prevPtr = tracePtr;
+
+                tracePtr = tracePtr->nextPtr;
+                prevPtr->nextPtr = NULL;
+                Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
+            }
+            Tcl_DeleteHashEntry(tPtr);
+            varPtr->flags &= ~VAR_ALL_TRACES;
+            for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
+                    activePtr = activePtr->nextPtr) {
+                if (activePtr->varPtr == varPtr) {
+                    activePtr->nextTracePtr = NULL;
+                }
+            }
+        }
+
+	if (!TclIsVarUndefined(varPtr)) {
+	    UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
+		    NULL, TCL_TRACE_UNSETS, -1);
+	}
+
+	VarHashRefCount(varPtr)--;
 	VarHashDeleteEntry(varPtr);
     }
     VarHashDeleteTable(tablePtr);
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 10fa4f7..a7e8a8a 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2864,7 +2864,7 @@ ZlibTransformClose(
     Tcl_Interp *interp)
 {
     ZlibChannelData *cd = instanceData;
-    int e, result = TCL_OK;
+    int e, written, result = TCL_OK;
 
     /*
      * Delete the support timer.
@@ -2882,6 +2882,17 @@ ZlibTransformClose(
 	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
 	    cd->outStream.avail_out = (unsigned) cd->outAllocated;
 	    e = deflate(&cd->outStream, Z_FINISH);
+	    written = cd->outAllocated - cd->outStream.avail_out;
+
+	    /*
+	     * Can't be sure that deflate() won't declare the buffer to be
+	     * full (with Z_BUF_ERROR) so handle that case.
+	     */
+
+	    if (e == Z_BUF_ERROR) {
+		e = Z_OK;
+		written = cd->outAllocated;
+	    }
 	    if (e != Z_OK && e != Z_STREAM_END) {
 		/* TODO: is this the right way to do errors on close? */
 		if (!TclInThreadExit()) {
@@ -2890,20 +2901,17 @@ ZlibTransformClose(
 		result = TCL_ERROR;
 		break;
 	    }
-	    if (cd->outStream.avail_out != (unsigned) cd->outAllocated) {
-		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
-			cd->outAllocated - cd->outStream.avail_out) < 0) {
-		    /* TODO: is this the right way to do errors on close?
-		     * Note: when close is called from FinalizeIOSubsystem
-		     * then interp may be NULL */
-		    if (!TclInThreadExit() && interp) {
-			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-				"error while finalizing file: %s",
-				Tcl_PosixError(interp)));
-		    }
-		    result = TCL_ERROR;
-		    break;
+	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {
+		/* TODO: is this the right way to do errors on close?
+		 * Note: when close is called from FinalizeIOSubsystem then
+		 * interp may be NULL */
+		if (!TclInThreadExit() && interp) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "error while finalizing file: %s",
+			    Tcl_PosixError(interp)));
 		}
+		result = TCL_ERROR;
+		break;
 	    }
 	} while (e != Z_STREAM_END);
 	(void) deflateEnd(&cd->outStream);
@@ -3084,7 +3092,17 @@ ZlibTransformOutput(
 	e = deflate(&cd->outStream, Z_NO_FLUSH);
 	produced = cd->outAllocated - cd->outStream.avail_out;
 
-	if (e == Z_OK && produced > 0) {
+	if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) {
+	    /*
+	     * deflate() indicates that it is out of space by returning
+	     * Z_BUF_ERROR; in that case, we must write the whole buffer out
+	     * and retry to compress what is left.
+	     */
+
+	    if (e == Z_BUF_ERROR) {
+		produced = cd->outAllocated;
+		e = Z_OK;
+	    }
 	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
 		*errorCodePtr = Tcl_GetErrno();
 		return -1;
diff --git a/tests/exec.test b/tests/exec.test
index 38927d3..2a4b31e 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -695,9 +695,6 @@ test exec-20.1 {exec .CMD file} -constraints {win} -body {
     exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
     viewFile $log
 } -result "\"Testing exec-20.1\""
-    
-
-
 
 # ----------------------------------------------------------------------
 # cleanup
diff --git a/tests/io.test b/tests/io.test
index 2084991..6e7420d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -8646,11 +8646,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
     interp create slave
 } -constraints testobj -body {
     teststringobj set 1 [string range $rfd 0 end]
-    read [teststringobj get 1]		
+    read [teststringobj get 1]
     testobj duplicate 1 2
     interp transfer {} $rfd slave
     catch {read [teststringobj get 1]}
-    read [teststringobj get 2]		
+    read [teststringobj get 2]
 } -cleanup {
     interp delete slave
     testobj freeallvars
diff --git a/tests/resolver.test b/tests/resolver.test
index aaad02c..9bb4c08 100644
--- a/tests/resolver.test
+++ b/tests/resolver.test
@@ -196,6 +196,121 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
 } -cleanup {
     testinterpresolver down
 } -result {}
+
+
+#
+# The test resolver-3.1* test bad interactions of resolvers on the "global"
+# (per interp) literal pools. A resolver might resolve a cmd literal depending
+# on a context differently, whereas the cmd literal sharing assumed that the
+# namespace containing the literal solely determines the resolved cmd (and is
+# resolver-agnostic).
+#
+# In order to make the test cases for the per-interpreter cmd literal pool
+# reproducable and to minimize interactions between test cases, we use a slave
+# interpreter per test-case.
+#
+#
+# Testing resolver in namespace-based context "ctx1"
+#
+test resolver-3.1a {
+    interp command resolver,
+    resolve literal "z" in proc "x1" in context "ctx1"
+} -setup {
+
+    interp create i0
+    testinterpresolver up i0
+    i0 eval {
+	proc y {} { return yy }
+	namespace eval ::ns {
+	    proc x1 {} { z }
+	}
+    }
+} -constraints testinterpresolver -body {
+
+    set r [i0 eval {namespace eval ::ctx1 {
+	::ns::x1
+    }}]
+
+    return $r
+} -cleanup {
+    testinterpresolver down i0
+    interp delete i0
+} -result {yy}
+
+#
+# Testing resolver in namespace-based context "ctx2"
+#
+test resolver-3.1b {
+    interp command resolver,
+    resolve literal "z" in proc "x2" in context "ctx2"
+} -setup {
+
+    interp create i0
+    testinterpresolver up i0
+    i0 eval {
+	proc Y {} { return YY }
+	namespace eval ::ns {
+	    proc x2 {} { z }
+	}
+    }
+} -constraints testinterpresolver -body {
+
+    set r [i0 eval {namespace eval ::ctx2 {
+	::ns::x2
+    }}]
+
+    return $r
+} -cleanup {
+    testinterpresolver down i0
+    interp delete i0
+} -result {YY}
+
+#
+# Testing resolver in namespace-based context "ctx1" and "ctx2" in the same
+# interpreter.
+#
+
+test resolver-3.1c {
+    interp command resolver,
+    resolve literal "z" in proc "x1" in context "ctx1",
+    resolve literal "z" in proc "x2" in context "ctx2"
+
+    Test, whether the shared cmd literal created by the first byte-code
+    compilation interacts with the second one.
+} -setup {
+
+    interp create i0
+    testinterpresolver up i0
+
+    i0 eval {
+	proc y {} { return yy }
+	proc Y {} { return YY }
+	namespace eval ::ns {
+	    proc x1 {} { z }
+	    proc x2 {} { z }
+	}
+    }
+
+} -constraints testinterpresolver -body {
+
+    set r1 [i0 eval {namespace eval ::ctx1 {
+	::ns::x1
+    }}]
+
+    set r2 [i0 eval {namespace eval ::ctx2 {
+	::ns::x2
+    }}]
+
+    set r3 [i0 eval {namespace eval ::ctx1 {
+	::ns::x1
+    }}]
+
+    return [list $r1 $r2 $r3]
+} -cleanup {
+    testinterpresolver down i0
+    interp delete i0
+} -result {yy YY yy}
+
 
 cleanupTests
 return
diff --git a/tests/trace.test b/tests/trace.test
index 1099f48..3b69d38 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -1227,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} {
 
 test trace-18.1 {unset traces on procedure returns} {
     proc p1 {x y} {set a 44; p2 14}
-    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
+    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}}
     set info {}
     p1 foo bar
     set info
@@ -1263,6 +1263,27 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
     rename doTrace {}
     set info
 } 1110
+test trace-18.5 {Bug 7f02ff1efa} -setup {
+    proc constant {name value} {
+        upvar 1 $name c  
+        set c $value
+        trace variable c wu [list reset $value]
+    }
+    proc reset {v a i o} {
+        uplevel 1 [list constant $a $v]
+    }
+    proc demo {} {
+	constant pi 3.14
+    }
+} -body {
+    unset -nocomplain pi
+    demo
+    info exists pi
+} -cleanup {
+    rename demo {}
+    rename reset {}
+    rename constant {}
+} -result 0
 
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
diff --git a/tests/var.test b/tests/var.test
index 44e671a..9816d98 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -594,6 +594,22 @@ test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called wit
     list [namespace delete test_ns_var] $::info
 } -result {{} {::test_ns_var::v {} u}}
 
+test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
+    proc ::t {a i o} {
+	set $a 321
+    }
+} -body {
+    leaktest {
+	namespace eval n {
+	    variable v 123
+	    trace variable v u ::t
+	}
+	namespace delete n
+    }
+} -cleanup {
+    rename ::t {}
+} -result 0
+
 test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
     catch {unset u}
     catch {unset v}
diff --git a/tests/zlib.test b/tests/zlib.test
index 8a040d8..15dbb34 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -917,6 +917,29 @@ test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup {
 } -cleanup {
     $stream close
 } -result {12026 18000}
+test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup {
+    set filesrc [makeFile {} test.input]
+    set filedst [makeFile {} test.output]
+    set f [open $filesrc "wb"]
+    for {set i 0} {$i < 10000} {incr i} {
+	puts -nonewline $f "x"
+    }
+    close $f
+} -body {
+    set fin [open $filesrc "rb"]
+    set fout [open $filedst "wb"]
+    set header [dict create filename "test.input" time 0]
+    try {
+	fcopy $fin [zlib push gzip $fout -header $header]
+    } finally {
+	close $fin
+	close $fout
+    }
+    file size $filedst
+} -cleanup {
+    removeFile $filesrc
+    removeFile $filedst
+} -result 4152
 
 ::tcltest::cleanupTests
 return