Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.97
diff -u -r1.97 tclInt.decls
--- generic/tclInt.decls	21 Jun 2006 03:10:39 -0000	1.97
+++ generic/tclInt.decls	30 Sep 2006 18:55:26 -0000
@@ -890,6 +890,10 @@
 	    int keyc, Tcl_Obj *CONST keyv[], int flags)
 }
 
+declare 226 generic {
+    int TclObjBeingDeleted(Tcl_Obj *objPtr)
+}
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.278
diff -u -r1.278 tclInt.h
--- generic/tclInt.h	30 Sep 2006 17:56:47 -0000	1.278
+++ generic/tclInt.h	30 Sep 2006 18:55:28 -0000
@@ -2646,15 +2646,20 @@
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL
 
+/* Invalidate the string rep first so we can use the bytes value \
+ * for our pointer chain, and signal an obj deletion (as opposed \
+ * to shimmering) with 'length == -1' */ \
+
 # define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
 	if ((objPtr)->typePtr && (objPtr)->typePtr->freeIntRepProc) { \
 	    TclFreeObj(objPtr); \
 	} else { \
-	    if ((objPtr)->bytes \
-		    && ((objPtr)->bytes != tclEmptyStringRep)) { \
-		ckfree((char *) (objPtr)->bytes); \
+  	    if ((objPtr)->bytes \
+	            && ((objPtr)->bytes != tclEmptyStringRep)) { \
+	        ckfree((char *) (objPtr)->bytes); \
 	    } \
+            (objPtr)->length = -1; \
 	    TclFreeObjStorage(objPtr); \
 	    TclIncrObjsFreed(); \
 	} \
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.87
diff -u -r1.87 tclIntDecls.h
--- generic/tclIntDecls.h	21 Jun 2006 03:10:39 -0000	1.87
+++ generic/tclIntDecls.h	30 Sep 2006 18:55:28 -0000
@@ -1020,6 +1020,11 @@
 				Tcl_Obj * rootPtr, int keyc, 
 				Tcl_Obj *CONST keyv[], int flags));
 #endif
+#ifndef TclObjBeingDeleted_TCL_DECLARED
+#define TclObjBeingDeleted_TCL_DECLARED
+/* 226 */
+EXTERN int		TclObjBeingDeleted _ANSI_ARGS_((Tcl_Obj * objPtr));
+#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1266,6 +1271,7 @@
     void *reserved223;
     TclPlatformType * (*tclGetPlatform) _ANSI_ARGS_((void)); /* 224 */
     Tcl_Obj * (*tclTraceDictPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags)); /* 225 */
+    int (*tclObjBeingDeleted) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 226 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -1955,6 +1961,10 @@
 #define TclTraceDictPath \
 	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
 #endif
+#ifndef TclObjBeingDeleted
+#define TclObjBeingDeleted \
+	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.112
diff -u -r1.112 tclObj.c
--- generic/tclObj.c	10 Aug 2006 12:15:31 -0000	1.112
+++ generic/tclObj.c	30 Sep 2006 18:55:30 -0000
@@ -111,13 +111,8 @@
 #define ObjDeletePending(contextPtr)	((contextPtr)->deletionCount > 0)
 #define ObjOnStack(contextPtr)		((contextPtr)->deletionStack != NULL)
 #define PushObjToDelete(contextPtr,objPtr) \
-    /* Invalidate the string rep first so we can use the bytes value \
-     * for our pointer chain. */ \
-    if (((objPtr)->bytes != NULL) \
-	    && ((objPtr)->bytes != tclEmptyStringRep)) { \
-	ckfree((char *) (objPtr)->bytes); \
-    } \
-    /* Now push onto the head of the stack. */ \
+    /* The string rep is already invalidated so we can use the bytes value \
+     * for our pointer chain: push onto the head of the stack. */ \
     (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
     (contextPtr)->deletionStack = (objPtr)
 #define PopObjToDelete(contextPtr,objPtrVar) \
@@ -849,6 +844,13 @@
 	Tcl_Panic("Reference count for %lx was negative", objPtr);
     }
 
+    /* Invalidate the string rep first so we can use the bytes value 
+     * for our pointer chain, and signal an obj deletion (as opposed
+     * to shimmering) with 'length == -1' */ 
+    
+    TclInvalidateStringRep(objPtr);
+    objPtr->length = -1;
+
     if (ObjDeletePending(context)) {
 	PushObjToDelete(context, objPtr);
     } else {
@@ -857,7 +859,6 @@
 	    typePtr->freeIntRepProc(objPtr);
 	    ObjDeletionUnlock(context);
 	}
-	TclInvalidateStringRep(objPtr);
 
 	Tcl_MutexLock(&tclObjMutex);
 	ckfree((char *) objPtr);
@@ -888,15 +889,19 @@
 TclFreeObj(
     register Tcl_Obj *objPtr)	/* The object to be freed. */
 {
+    /* Invalidate the string rep first so we can use the bytes value 
+     * for our pointer chain, and signal an obj deletion (as opposed
+     * to shimmering) with 'length == -1' */ 
+
+    TclInvalidateStringRep(objPtr);
+    objPtr->length = -1;
+    
     if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
 	/*
 	 * objPtr can be freed safely, as it will not attempt to free any
 	 * other objects: it will not cause recursive calls to this function.
 	 */
 
-	if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) {
-	    ckfree((char *) objPtr->bytes);
-	}
 	TclFreeObjStorage(objPtr);
 	TclIncrObjsFreed();
     } else {
@@ -923,9 +928,6 @@
 	    objPtr->typePtr->freeIntRepProc(objPtr);
 	    ObjDeletionUnlock(context);
 
-	    if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) {
-		ckfree((char *) objPtr->bytes);
-	    }
 	    TclFreeObjStorage(objPtr);
 	    TclIncrObjsFreed();
 	    ObjDeletionLock(context);
@@ -948,6 +950,31 @@
 /*
  *----------------------------------------------------------------------
  *
+ * TclObjBeingDeleted --
+ *
+ *	This function returns 1 when the Tcl_Obj is being deleted. It is
+ *	provided for the rare cases where the reason for the loss of an
+ *	internal rep might be relevant [FR 1512138]
+ *
+ * Results:
+ *	1 if being deleted, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjBeingDeleted(Tcl_Obj *objPtr)
+{
+    return (objPtr->length == -1);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DuplicateObj --
  *
  *	Create and return a new object that is a duplicate of the argument
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.132
diff -u -r1.132 tclStubInit.c
--- generic/tclStubInit.c	22 Sep 2006 18:13:29 -0000	1.132
+++ generic/tclStubInit.c	30 Sep 2006 18:55:32 -0000
@@ -317,6 +317,7 @@
     NULL, /* 223 */
     TclGetPlatform, /* 224 */
     TclTraceDictPath, /* 225 */
+    TclObjBeingDeleted, /* 226 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
