Merge core-8-5-branch.

Optimize tclCmdNameType the same way.

14 files changed, 139 insertions, 140 deletions

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 328faaf..ccdab6e 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -126,8 +126,8 @@ typedef struct ByteArray {
 #define GET_BYTEARRAY(objPtr) \
 		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_BYTEARRAY(objPtr, baPtr) do { \
-		(objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
 		(objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr); \
+		(objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
 	} while(0)
 
 
@@ -268,11 +268,17 @@ Tcl_SetByteArrayObj(
 				 * >= 0. */
 {
     ByteArray *byteArrayPtr;
+    void *stringIntRep = NULL;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
     }
-    TclFreeIntRep(objPtr);
+    /* If previous objType was string, keep the internal representation */
+    if (objPtr->typePtr == &tclStringType) {
+	stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+    } else {
+	TclFreeIntRep(objPtr);
+    }
     Tcl_InvalidateStringRep(objPtr);
 
     if (length < 0) {
@@ -287,6 +293,7 @@ Tcl_SetByteArrayObj(
     }
     objPtr->typePtr = &tclByteArrayType;
     SET_BYTEARRAY(objPtr, byteArrayPtr);
+    objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
 }
 
 /*
@@ -418,10 +425,10 @@ SetByteArrayFromAny(
 
 	/* If previous objType was string, keep the internal representation */
 	if(objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+		stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
 	}
-	TclFreeIntRep(objPtr);
 	objPtr->typePtr = &tclByteArrayType;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
 	objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 32dfe8c..b4ff590 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -488,7 +488,6 @@ TclSetByteCodeFromAny(
     int length, result = TCL_OK;
     const char *stringPtr;
     ContLineLoc* clLocPtr;
-    void *stringIntRep = NULL;
 
 #ifdef TCL_COMPILE_DEBUG
     if (!traceInitialized) {
@@ -554,13 +553,7 @@ TclSetByteCodeFromAny(
     TclVerifyLocalLiteralTable(&compEnv);
 #endif /*TCL_COMPILE_DEBUG*/
 
-	/* If previous objType was string, keep the internal representation */
-	if(objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	}
     TclInitByteCodeObj(objPtr, &compEnv);
-    objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
 #ifdef TCL_COMPILE_DEBUG
     if (tclTraceCompile >= 2) {
 	TclPrintByteCodeObj(interp, objPtr);
@@ -708,9 +701,8 @@ FreeByteCodeInternalRep(
  *	None.
  *
  * Side effects:
- *	Frees objPtr's bytecode internal representation and sets its type and
- *	objPtr->internalRep.twoPtrValue.ptr1 NULL. Also releases its literals and
- *	frees its auxiliary data items.
+ *	Frees objPtr's bytecode internal representation and sets its type NULL
+ *	Also releases its literals and frees its auxiliary data items.
  *
  *----------------------------------------------------------------------
  */
@@ -2227,17 +2219,12 @@ TclInitByteCodeObj(
     RecordByteCodeStats(codePtr);
 #endif /* TCL_COMPILE_STATS */
 
-	/* If previous objType was string, keep the internal representation */
-	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	}
-    /*
-     * 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);
+    /* If previous objType was string, keep the internal representation */
+    if (objPtr->typePtr == &tclStringType) {
+	stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+    } else {
+	TclFreeIntRep(objPtr);
+    }
     objPtr->internalRep.twoPtrValue.ptr1 = (void *) codePtr;
     objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
     objPtr->typePtr = &tclByteCodeType;
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 5886484..6e7488c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -679,19 +679,12 @@ SetDictFromAny(
 	}
     }
 
-	/* If previous objType was string, keep the internal representation */
-	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	}
-
-	/*
-     * Free the old internalRep before setting the new one. We do this as late
-     * as possible to allow the conversion code, in particular
-     * Tcl_GetStringFromObj, to use that old internalRep.
-     */
-
-    TclFreeIntRep(objPtr);
+    /* If previous objType was string, keep the internal representation */
+    if (objPtr->typePtr == &tclStringType) {
+        stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+    } else {
+	    TclFreeIntRep(objPtr);
+    }
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 137fe11..42d9d31 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -315,10 +315,10 @@ Tcl_GetEncodingFromObj(
 	}
 	/* If previous objType was string, keep the internal representation */
 	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	    stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
 	}
-	TclFreeIntRep(objPtr);
 	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) encoding;
 	objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
 	objPtr->typePtr = &tclEncodingType;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 310b31c..76ae9bf 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -245,14 +245,14 @@ Tcl_GetIndexFromObjStruct(
 	void *stringIntRep = NULL;
 	/* If previous objType was string, keep the internal representation */
 	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+		stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
 	}
-	TclFreeIntRep(objPtr);
- 	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- 	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- 	objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
- 	objPtr->typePtr = &tclIndexType;
+	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
+	objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
+	objPtr->typePtr = &tclIndexType;
     }
     indexRep->tablePtr = (void *) tablePtr;
     indexRep->offset = offset;
@@ -388,6 +388,7 @@ DupIndex(
 
     memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
     dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
+    dupPtr->internalRep.twoPtrValue.ptr2 = NULL;
     dupPtr->typePtr = &tclIndexType;
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2e533c9..d25c590 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2463,6 +2463,7 @@ MODULE_SCOPE Tcl_ObjType tclBignumType;
 MODULE_SCOPE Tcl_ObjType tclBooleanType;
 MODULE_SCOPE Tcl_ObjType tclByteArrayType;
 MODULE_SCOPE Tcl_ObjType tclByteCodeType;
+MODULE_SCOPE Tcl_ObjType tclCmdNameType;
 MODULE_SCOPE Tcl_ObjType tclDictType;
 MODULE_SCOPE Tcl_ObjType tclDoubleType;
 MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 7dc38b3..ca9286d 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1636,7 +1636,6 @@ FreeListInternalRep(
 	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
 	}
 
-    listPtr->internalRep.twoPtrValue.ptr1 = NULL;
     listPtr->typePtr = NULL;
 }
 
@@ -1693,6 +1692,7 @@ SetListFromAny(
 {
     List *listRepPtr;
     Tcl_Obj **elemPtrs;
+    void *stringIntRep = NULL;
 
     /*
      * Dictionaries are a special case; they have a string representation such
@@ -1786,14 +1786,14 @@ SetListFromAny(
  	listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
     }
 
-    /*
-     * Free the old internalRep before setting the new one. We do this as late
-     * as possible to allow the conversion code, in particular
-     * Tcl_GetStringFromObj, to use that old internalRep.
-     */
-
-    TclFreeIntRep(objPtr);
+	/* If previous objType was string, keep the internal representation */
+	if (objPtr->typePtr == &tclStringType) {
+		stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
+	}
     ListSetIntRep(objPtr, listRepPtr);
+    objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
     return TCL_OK;
 }
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 5d14433..ba21500 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -4725,12 +4725,12 @@ SetNsNameFromAny(
 	resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     }
     resNamePtr->refCount = 1;
-	/* If previous objType was string, keep the internal representation */
-	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	}
-    TclFreeIntRep(objPtr);
+    /* If previous objType was string, keep the internal representation */
+    if (objPtr->typePtr == &tclStringType) {
+	stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+    } else {
+	TclFreeIntRep(objPtr);
+    }
     objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
     objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
     objPtr->typePtr = &tclNsNameType;
@@ -6433,19 +6433,15 @@ MakeCachedEnsembleCommand(
 	ckfree(ensembleCmd->fullSubcmdName);
     } else {
 	/* If previous objType was string, keep the internal representation */
+	void *stringIntRep = NULL;
 	if (objPtr->typePtr == &tclStringType) {
-		stringIntRep = objPtr->internalRep.twoPtrValue.ptr2;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	    stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
 	}
-	/*
-	 * Kill the old internal rep, and replace it with a brand new one of
-	 * our own.
-	 */
-
-	TclFreeIntRep(objPtr);
 	ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
 	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
 	objPtr->typePtr = &tclEnsembleCmdType;
     }
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f27f69a..7246a2a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -319,7 +319,7 @@ Tcl_HashKeyType tclObjHashKeyType = {
  * own purposes.
  */
 
-static Tcl_ObjType tclCmdNameType = {
+Tcl_ObjType tclCmdNameType = {
     "cmdName",				/* name */
     FreeCmdNameInternalRep,		/* freeIntRepProc */
     DupCmdNameInternalRep,		/* dupIntRepProc */
@@ -1243,7 +1243,7 @@ Tcl_DbNewObj(
  * Side effects:
  *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
  *	first of a number of free Tcl_Obj's linked together by their
- *	internalRep.otherValuePtrs.
+ *	internalRep.twoPtrValue.ptr1's.
  *
  *----------------------------------------------------------------------
  */
@@ -4110,6 +4110,7 @@ TclSetCmdNameObj(
     register ResolvedCmdName *resPtr;
     register Namespace *currNsPtr;
     char *name;
+    void *stringIntRep = NULL;
 
     if (objPtr->typePtr == &tclCmdNameType) {
 	return;
@@ -4141,9 +4142,14 @@ TclSetCmdNameObj(
 	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
     }
 
-    TclFreeIntRep(objPtr);
+	/* If previous objType was string, keep the internal representation */
+	if(objPtr->typePtr == &tclStringType) {
+		stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    TclFreeIntRep(objPtr);
+	}
     objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
     objPtr->typePtr = &tclCmdNameType;
 }
 
@@ -4195,6 +4201,9 @@ FreeCmdNameInternalRep(
 	    ckfree((char *) resPtr);
 	}
     }
+    if (objPtr->internalRep.twoPtrValue.ptr2) {
+	    ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+    }
     objPtr->typePtr = NULL;
 }
 
@@ -4301,11 +4310,17 @@ SetCmdNameFromAny(
 		TclCleanupCommandMacro(oldCmdPtr);
 	    }
 	} else {
-	    TclFreeIntRep(objPtr);
+	    void *stringIntRep = NULL;
+	    /* If previous objType was string, keep the internal representation */
+	    if(objPtr->typePtr == &tclStringType) {
+		stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+	    } else {
+		TclFreeIntRep(objPtr);
+	    }
 	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
 	    resPtr->refCount = 1;
 	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
-	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	    objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
 	    objPtr->typePtr = &tclCmdNameType;
 	}
 	resPtr->cmdPtr = cmdPtr;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 22e89d9..3c43cf5 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -111,8 +111,8 @@ typedef struct FsPath {
 
 #define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
 #define SETPATHOBJ(pathPtr,fsPathPtr) do { \
-	(pathPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
 	(pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
+	(pathPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
     } while(0)
 #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index bbbc9e7..b66f5e8 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2391,8 +2391,7 @@ ProcBodyFree(
 {
     Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    procPtr->refCount--;
-    if (procPtr->refCount <= 0) {
+    if (procPtr->refCount-- < 2) {
 	TclProcCleanupProc(procPtr);
     }
 }
@@ -2672,7 +2671,6 @@ Tcl_ApplyObjCmd(
     else {
 	/*
 	 * Joe English's suggestion to allow cmdNames to function as lambdas.
-	 * Also requires making tclCmdNameType non-static in tclObj.c
 	 */
 
 	Tcl_Obj *elemPtr;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 87d1aec..099bb27 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -130,8 +130,8 @@ typedef struct String {
 #define GET_STRING(objPtr) \
 	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_STRING(objPtr, stringPtr) do { \
-	(objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
 	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr); \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
     } while(0)
 
 /*
@@ -402,6 +402,7 @@ Tcl_GetCharLength(
 
     if ((objPtr->typePtr == &tclByteArrayType) ||
 	    (objPtr->typePtr == &tclByteCodeType) ||
+	    (objPtr->typePtr == &tclCmdNameType) ||
 	    (objPtr->typePtr == &tclDictType) ||
 	    (objPtr->typePtr == &tclEncodingType) ||
 	    (objPtr->typePtr == &tclEndOffsetType) ||
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 29c2675..2e74fa7 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -557,7 +557,6 @@ TclThreadAllocObj(void)
 	    while (--numMove >= 0) {
 		objPtr = &newObjsPtr[numMove];
 		objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 		cachePtr->firstObjPtr = objPtr;
 	    }
 	}
@@ -604,7 +603,6 @@ TclThreadFreeObj(
      */
 
     objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     cachePtr->firstObjPtr = objPtr;
     ++cachePtr->numObjects;
 
@@ -715,7 +713,6 @@ MoveObjs(
      */
 
     objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     toPtr->firstObjPtr = fromFirstObjPtr;
 }
 
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7622675..aaf1cb9 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,13 +47,6 @@ static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);
 #define VarHashGetValue(hPtr) \
     ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
 
-/*
- * NOTE: VarHashCreateVar increments the recount of its key argument.
- * All callers that will call Tcl_DecrRefCount on that argument must
- * call Tcl_IncrRefCount on it before passing it in.  This requirement
- * can bubble up to callers of callers .... etc.
- */
-
 static inline Var *
 VarHashCreateVar(
     TclVarHashTable *tablePtr,
@@ -388,12 +381,11 @@ TclLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
+    Tcl_Obj *part1Ptr;
     Var *varPtr;
-    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    if (createPart1) {
-	Tcl_IncrRefCount(part1Ptr);
-    }
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
 
     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
 	    createPart1, createPart2, arrayPtrPtr);
@@ -438,8 +430,6 @@ TclLookupVar(
  *	are 1. The object part1Ptr is converted to one of localVarNameType,
  *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
  *	lookup as it can.
- *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
- *	plan to DecrRefCount it.
  *
  *----------------------------------------------------------------------
  */
@@ -468,11 +458,14 @@ TclObjLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
-    Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *part2Ptr;
     Var *resPtr;
 
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -847,7 +840,6 @@ TclObjLookupVarEx(
  *
  * Side effects:
  *	A new hashtable entry may be created if create is 1.
- *	Callers must Incr varNamePtr if they plan to Decr it if create is 1.
  *
  *----------------------------------------------------------------------
  */
@@ -1285,10 +1277,15 @@ Tcl_GetVar2Ex(
     int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
-    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1569,8 +1566,18 @@ Tcl_SetVar2(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
-	    Tcl_NewStringObj(newValue, -1), flags);
+    register Tcl_Obj *valuePtr;
+    Tcl_Obj *varValuePtr;
+
+    /*
+     * Create an object holding the variable's new value and use Tcl_SetVar2Ex
+     * to actually set the variable.
+     */
+
+    valuePtr = Tcl_NewStringObj(newValue, -1);
+    Tcl_IncrRefCount(valuePtr);
+    varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
+    Tcl_DecrRefCount(valuePtr);
 
     if (varValuePtr == NULL) {
 	return NULL;
@@ -1630,12 +1637,15 @@ Tcl_SetVar2Ex(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
 	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1668,7 +1678,6 @@ Tcl_SetVar2Ex(
  * Side effects:
  *	The value of the given variable is set. If either the array or the
  *	entry didn't exist then a new variable is created.
- *	Callers must Incr part1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -1956,7 +1965,6 @@ TclPtrSetVar(
  *	variable is created. The ref count for the returned object is _not_
  *	incremented to reflect the returned reference; if you want to keep a
  *	reference to the object you must increment its ref count yourself.
- *	Callers must Incr part1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -2039,7 +2047,8 @@ TclPtrIncrObjVar(
 				 * variable, or -1. Only used when part1Ptr is
 				 * NULL. */
 {
-    register Tcl_Obj *varValuePtr;
+    register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
+    int duplicated, code;
 
     if (TclIsVarInHash(varPtr)) {
 	VarHashRefCount(varPtr)++;
@@ -2053,33 +2062,19 @@ TclPtrIncrObjVar(
 	varValuePtr = Tcl_NewIntObj(0);
     }
     if (Tcl_IsShared(varValuePtr)) {
-	/* Copy on write */
+	duplicated = 1;
 	varValuePtr = Tcl_DuplicateObj(varValuePtr);
-	
-	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-		    varValuePtr, flags, index);
-	} else {
-	    Tcl_DecrRefCount(varValuePtr);
-	    return NULL;
-	}
     } else {
-	/* Unshared - can Incr in place */
-	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-
-	    /*
-	     * This seems dumb to write the incremeted value into the var
-	     * after we just adjusted the value in place, but the spec for
-	     * [incr] requires that write traces fire, and making this call
-	     * is the way to make that happen.
-	     */
-
-	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-		    varValuePtr, flags, index);
-	} else {
-	    return NULL;
-	}
+	duplicated = 0;
+    }
+    code = TclIncrObj(interp, varValuePtr, incrPtr);
+    if (code == TCL_OK) {
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+		part2Ptr, varValuePtr, flags, index);
+    } else if (duplicated) {
+	Tcl_DecrRefCount(varValuePtr);
     }
+    return newValuePtr;
 }
 
 /*
@@ -2148,10 +2143,13 @@ Tcl_UnsetVar2(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr = NULL;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
     }
 
     /*
@@ -3320,7 +3318,6 @@ Tcl_ArrayObjCmd(
  *
  * Side effects:
  *	A variable will be created if one does not already exist.
- *	Callers must Incr arrayNameObj if they pland to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -3488,8 +3485,6 @@ TclArraySet(
  *	The variable given by myName is linked to the variable in framePtr
  *	given by otherP1 and otherP2, so that references to myName are
  *	redirected to the other variable like a symbolic link.
- *	Callers must Incr myNamePtr if they plan to Decr it.
- *	Callers must Incr otherP1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -3597,12 +3592,14 @@ TclPtrMakeUpvar(
     int index)			/* If the variable to be linked is an indexed
 				 * scalar, this is its index. Otherwise, -1 */
 {
-    Tcl_Obj *myNamePtr = NULL;
+    Tcl_Obj *myNamePtr;
     int result;
 
     if (myName) {
 	myNamePtr = Tcl_NewStringObj(myName, -1);
 	Tcl_IncrRefCount(myNamePtr);
+    } else {
+	myNamePtr = NULL;
     }
     result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
     if (myNamePtr) {
@@ -3611,8 +3608,6 @@ TclPtrMakeUpvar(
     return result;
 }
 
-/* Callers must Incr myNamePtr if they plan to Decr it. */
- 
 int
 TclPtrObjMakeUpvar(
     Tcl_Interp *interp,		/* Interpreter containing variables. Used for
@@ -4430,6 +4425,7 @@ TclDeleteNamespaceVars(
     for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
 	    varPtr = VarHashFirstVar(tablePtr, &search)) {
 	Tcl_Obj *objPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(objPtr);
 
 	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
 					 * hash. */
@@ -4693,10 +4689,15 @@ TclVarErrMsg(
 				 * e.g. "read", "set", or "unset". */
     const char *reason)		/* String describing why operation failed. */
 {
-    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2 = NULL;
     }
 
     TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -4964,6 +4965,7 @@ Tcl_FindNamespaceVar(
     Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
     Tcl_Var var;
 
+    Tcl_IncrRefCount(namePtr);
     var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
     Tcl_DecrRefCount(namePtr);
     return var;
@@ -5058,6 +5060,7 @@ ObjFindNamespaceVar(
     varPtr = NULL;
     if (simpleName != name) {
 	simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
+	Tcl_IncrRefCount(simpleNamePtr);
     } else {
 	simpleNamePtr = namePtr;
     }