diff -aburN tcl8.5.0-orig/generic/tclBasic.c tcl8.5.0/generic/tclBasic.c
--- tcl8.5.0-orig/generic/tclBasic.c	Thu Dec 13 15:23:14 2007
+++ tcl8.5.0/generic/tclBasic.c	Tue Jan 29 23:49:58 2008
@@ -697,6 +697,28 @@
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
 	    Tcl_DisassembleObjCmd, NULL, NULL);
 
+    /*
+     * Create an unsupported command for debugging objects.
+     */
+
+    Tcl_CreateObjCommand(interp, "debugobj",
+	    Tcl_DebugObjObjCmd, NULL, NULL);
+
+    /*
+     * Create a few unsupported commands for 1st-class mutables
+     */
+
+    Tcl_CreateObjCommand(interp, "mutable",
+	    Tcl_MutableObjCmd, NULL, NULL);
+
+    Tcl_CreateObjCommand(interp, "mutant",
+	    Tcl_MutantObjCmd, NULL, NULL);
+
+    if (Tcl_LinkVar(interp, "tcl_traceMutable", (char *) &tclTraceMutable,
+	    TCL_LINK_INT) != TCL_OK) {
+	Tcl_Panic("Can't create link for tcl_traceMutable variable");
+    }
+
 #ifdef USE_DTRACE
     /*
      * Register the tcl::dtrace command.
diff -aburN tcl8.5.0-orig/generic/tclCmdAH.c tcl8.5.0/generic/tclCmdAH.c
--- tcl8.5.0-orig/generic/tclCmdAH.c	Thu Dec 13 15:23:16 2007
+++ tcl8.5.0/generic/tclCmdAH.c	Tue Jan 29 23:27:26 2008
@@ -368,7 +368,12 @@
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     if (objc >= 2) {
+	int wasMut;
+
+	wasMut=Tcl_IsListAndMutable(objv[1]);
+	if (wasMut) ListRepPtr(objv[1])->mutableFlag |= MUTABLE_MUTANT;
 	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
+	if (wasMut) ListRepPtr(objv[1])->mutableFlag &= ~MUTABLE_MUTANT;
     }
     return TCL_OK;
 }
diff -aburN tcl8.5.0-orig/generic/tclCmdIL.c tcl8.5.0/generic/tclCmdIL.c
--- tcl8.5.0-orig/generic/tclCmdIL.c	Thu Dec 13 15:23:16 2007
+++ tcl8.5.0/generic/tclCmdIL.c	Thu Jan 24 21:37:40 2008
@@ -2191,7 +2191,7 @@
      */
 
     listPtr = objv[1];
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	listPtr = TclListObjCopy(NULL, listPtr);
     }
 
@@ -2547,7 +2547,7 @@
      */
 
     listPtr = objv[1];
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	listPtr = TclListObjCopy(NULL, listPtr);
     }
 
@@ -2609,6 +2609,8 @@
 	List *listPtr;
 
     makeNewReversedList:
+	if (Tcl_IsListAndMutable(objv[1]))
+	    goto inPlace;
 	resultObj = Tcl_NewListObj(elemc, NULL);
 	listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1;
 	listPtr->elemCount = elemc;
@@ -2631,6 +2633,7 @@
 	    goto makeNewReversedList;
 	}
 
+    inPlace:
 	/*
 	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
 	 * returning a pointer to the live array of Tcl_Obj values.
diff -aburN tcl8.5.0-orig/generic/tclInt.h tcl8.5.0/generic/tclInt.h
--- tcl8.5.0-orig/generic/tclInt.h	Mon Dec 17 15:28:28 2007
+++ tcl8.5.0/generic/tclInt.h	Tue Jan 29 23:50:42 2008
@@ -1,5 +1,5 @@
 /*
- * tclInt.h --
+ * Tclint.h --
  *
  *	Declarations of things used internally by the Tcl interpreter.
  *
@@ -1877,6 +1877,9 @@
 				 * TclpCheckStackSpace in the platform's
 				 * directory. */
 
+    int mutant;                 /* Counter for [mutant] command prefix.
+				 * Allows nesting. */
+
 
 #ifdef TCL_COMPILE_STATS
     /*
@@ -1887,8 +1890,27 @@
     ByteCodeStats stats;	/* Holds compilation and execution statistics
 				 * for this interpreter. */
 #endif /* TCL_COMPILE_STATS */
+
+
 } Interp;
 
+
+extern int tclTraceMutable;
+#define Mutant(interp) ((interp) && ((Interp *)(interp))->mutant)
+/*
+ * Flag to remember the fact that we are on the purge list
+ */
+#define MUTABLE_TOINVAL 0x80000000
+#define MUTABLE_MUTANT 0x40000000
+/*
+ * Mass Invalidator for mutable values
+ */
+extern void TclMutableMassInvalidator();
+/*
+ * Debug routine returning 1 to advertise successful mutability tests
+ */
+extern int MutSpy(Tcl_Obj *obj);
+ 
 /*
  * Macros that use the TSD-ekeko.
  */
@@ -2121,8 +2143,13 @@
 				 * derived from the list representation. May
 				 * be ignored if there is no string rep at
 				 * all.*/
+    int mutableFlag;		/* a List may be a mutable container */
+
+    /* This one must be the last field !!! */
     Tcl_Obj *elements;		/* First list element; the struct is grown to
 				 * accomodate all elements. */
+
+
 } List;
 
 /*
@@ -2149,6 +2176,23 @@
 	    ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
 	    : Tcl_ListObjLength((interp), (listPtr), (lenPtr)))
 
+#define Tcl_ListIsMutable(objPtr) \
+    (Mutant(interp) && ListRepPtr(objPtr)->mutableFlag && MutSpy(objPtr))
+
+#define Tcl_ListIsMutableNoInterp(objPtr) \
+    ((ListRepPtr(objPtr)->mutableFlag&MUTABLE_MUTANT) && MutSpy(objPtr))
+
+#define Tcl_IsListAndMutable(objPtr) \
+    (((objPtr)->typePtr==&tclListType)&&Tcl_ListIsMutable(objPtr))
+
+#define Tcl_IsListAndMutableNoInterp(objPtr) \
+    (((objPtr)->typePtr==&tclListType)&&Tcl_ListIsMutableNoInterp(objPtr))
+
+#define Tcl_IsSharedAndNotMutableList(objPtr) \
+    (Tcl_IsShared(objPtr)&&(!Tcl_IsListAndMutable(objPtr)))
+
+MODULE_SCOPE Tcl_Obj *Tcl_MakeListMutable(Tcl_Interp *interp,Tcl_Obj *listPtr);
+
 /*
  * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
  * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
@@ -2684,6 +2728,9 @@
 #endif
 MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
 
+MODULE_SCOPE void	TclAddToMutableInvalList(Tcl_Obj *objPtr);
+MODULE_SCOPE void	TclRemoveFromMutableInvalList(Tcl_Obj *objPtr);
+
 /*
  *----------------------------------------------------------------
  * Command procedures in the generic core:
@@ -2747,6 +2794,22 @@
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+
+MODULE_SCOPE int	Tcl_DebugObjObjCmd(ClientData dummy,
+					   Tcl_Interp *interp,
+					   int objc,
+					   Tcl_Obj *CONST objv[]);
+
+MODULE_SCOPE int	Tcl_MutableObjCmd(ClientData dummy,
+					  Tcl_Interp *interp,
+					  int objc,
+					  Tcl_Obj *CONST objv[]);
+
+MODULE_SCOPE int	Tcl_MutantObjCmd(ClientData dummy,
+					  Tcl_Interp *interp,
+					  int objc,
+					  Tcl_Obj *CONST objv[]);
+
 MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
diff -aburN tcl8.5.0-orig/generic/tclListObj.c tcl8.5.0/generic/tclListObj.c
--- tcl8.5.0-orig/generic/tclListObj.c	Thu Dec 13 15:23:18 2007
+++ tcl8.5.0/generic/tclListObj.c	Tue Jan 29 23:13:03 2008
@@ -100,6 +100,7 @@
     listRepPtr->canonicalFlag = 0;
     listRepPtr->refCount = 0;
     listRepPtr->maxElemCount = objc;
+    listRepPtr->mutableFlag = 0;
 
     if (objv) {
 	Tcl_Obj **elemPtrs;
@@ -291,12 +292,12 @@
  *	None.
  *
  * Side effects:
- *	The object is made a list object and is initialized from the object
- *	pointers in objv. If objc is less than or equal to zero, an empty
- *	object is returned. The new object's string representation is left
- *	NULL. The ref counts of the elements in objv are incremented since the
- *	list now refers to them. The object's old string and internal
- *	representations are freed and its type is set NULL.
+ *	The object is made a(n immutable) list object and is initialized from
+ *	the object pointers in objv. If objc is less than or equal to zero, an
+ *	empty object is returned. The new object's string representation is
+ *	left NULL. The ref counts of the elements in objv are incremented
+ *	since the list now refers to them. The object's old string and
+ *	internal representations are freed and its type is set NULL.
  *
  *----------------------------------------------------------------------
  */
@@ -325,10 +326,13 @@
      * Set the object's type to "list" and initialize the internal rep.
      * However, if there are no elements to put in the list, just give the
      * object an empty string rep and a NULL type.
+     *
+     * In case of mutable, always create a list to be able to store
+     * the mutableFlag
      */
 
     if (objc > 0) {
-	listRepPtr = NewListIntRep(objc, objv);
+	listRepPtr = NewListIntRep((objc==0)?1:objc,(objc==0)?NULL:objv);
 	if (!listRepPtr) {
 	    Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
 	}
@@ -336,6 +340,7 @@
 	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 	objPtr->typePtr = &tclListType;
 	listRepPtr->refCount++;
+	listRepPtr->mutableFlag=0;
     } else {
 	objPtr->bytes = tclEmptyStringRep;
 	objPtr->length = 0;
@@ -481,7 +486,7 @@
     int listLen, objc, result;
     Tcl_Obj **objv;
 
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
     }
 
@@ -540,7 +545,7 @@
     register Tcl_Obj **elemPtrs;
     int numElems, numRequired, newMax, newSize, i;
 
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
     }
     if (listPtr->typePtr != &tclListType) {
@@ -615,7 +620,11 @@
      * representation has changed.
      */
 
+    if (Tcl_ListIsMutable(listPtr))
+	TclMutableMassInvalidator();
+    else
     Tcl_InvalidateStringRep(listPtr);
+
     return TCL_OK;
 }
 
@@ -781,7 +790,7 @@
     register Tcl_Obj **elemPtrs;
     int numElems, numRequired, numAfterLast, start, i, j, isShared;
 
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
     }
     if (listPtr->typePtr != &tclListType) {
@@ -906,6 +915,8 @@
 	     * The old struct will be removed; use its inherited refCounts.
 	     */
 
+	    listRepPtr->mutableFlag=oldListRepPtr->mutableFlag;
+
 	    if (first > 0) {
 		memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
 	    }
@@ -958,6 +969,9 @@
      * reflects the list's internal representation.
      */
 
+    if (Tcl_ListIsMutable(listPtr))
+	TclMutableMassInvalidator();
+    else
     Tcl_InvalidateStringRep(listPtr);
     return TCL_OK;
 }
@@ -1286,7 +1300,7 @@
      * leave the string rep of listPtr and all elements to be unchanged.
      */
 
-    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
+    subListPtr = Tcl_IsSharedAndNotMutableList(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
 
     /*
      * Anchor the linked list of Tcl_Obj's whose string reps must be
@@ -1344,7 +1358,7 @@
 	if (--indexCount) {
 	    parentList = subListPtr;
 	    subListPtr = elemPtrs[index];
-	    if (Tcl_IsShared(subListPtr)) {
+	    if (Tcl_IsSharedAndNotMutableList(subListPtr)) {
 		subListPtr = Tcl_DuplicateObj(subListPtr);
 	    }
 
@@ -1358,7 +1372,7 @@
 	     */
 
 	    TclListObjSetElement(NULL, parentList, index, subListPtr);
-	    if (Tcl_IsShared(subListPtr)) {
+	    if (Tcl_IsSharedAndNotMutableList(subListPtr)) {
 		subListPtr = Tcl_DuplicateObj(subListPtr);
 		TclListObjSetElement(NULL, parentList, index, subListPtr);
 	    }
@@ -1420,6 +1434,9 @@
 
     /* Store valuePtr in proper sublist and return */
     TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+    if (Tcl_ListIsMutable(subListPtr))
+	TclMutableMassInvalidator();
+    else
     Tcl_InvalidateStringRep(subListPtr);
     Tcl_IncrRefCount(retValuePtr);
     return retValuePtr;
@@ -1473,7 +1490,7 @@
      * Ensure that the listPtr parameter designates an unshared list.
      */
 
-    if (Tcl_IsShared(listPtr)) {
+    if (Tcl_IsSharedAndNotMutableList(listPtr)) {
 	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
     }
     if (listPtr->typePtr != &tclListType) {
@@ -1582,6 +1599,9 @@
     int numElems = listRepPtr->elemCount;
     int i;
 
+    if (listRepPtr->mutableFlag&&(listRepPtr->mutableFlag&MUTABLE_TOINVAL))
+	TclRemoveFromMutableInvalList(listPtr);
+
     if (--listRepPtr->refCount <= 0) {
 	for (i = 0;  i < numElems;  i++) {
 	    objPtr = elemPtrs[i];
@@ -1740,8 +1760,9 @@
      * 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.
+     * It also allows us to inherit the mutableFlag.
      */
-
+    listRepPtr->mutableFlag=Tcl_IsListAndMutable(objPtr);
     listRepPtr->refCount++;
     TclFreeIntRep(objPtr);
     objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
@@ -1844,6 +1865,59 @@
      */
 
     listRepPtr->canonicalFlag = 1;
+
+    if (listRepPtr->mutableFlag)
+	{
+	    listRepPtr->mutableFlag |= MUTABLE_TOINVAL;
+	    TclAddToMutableInvalList(listPtr);
+	}
+}
+
+Tcl_Obj *Tcl_MakeListMutable(Tcl_Interp *interp,Tcl_Obj *listPtr)
+{
+    List *listRepPtr;
+
+    if (listPtr->typePtr!=&tclListType)
+	{
+	    if (SetListFromAny(interp,listPtr)!=TCL_OK)
+		return NULL;
+	}
+    if (Tcl_ListIsMutable(listPtr)) return listPtr;
+    if (Tcl_IsShared(listPtr))
+	{
+	    Tcl_Obj *copyPtr;
+
+	    TclNewObj(copyPtr);
+	    TclInvalidateStringRep(copyPtr);
+	    DupListInternalRep(listPtr, copyPtr);
+	    listPtr=copyPtr;
+	}
+    listRepPtr=ListRepPtr(listPtr);
+    if (listRepPtr->refCount>1)
+	{
+	    Tcl_Obj **elemPtrs;
+	    int elemCount=listRepPtr->elemCount;
+	    List *oldListRepPtr = listRepPtr;
+	    Tcl_Obj **oldElemPtrs = &listRepPtr->elements;
+	    int i;
+
+	    listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
+	    if (listRepPtr == NULL) {
+		Tcl_Panic("Not enough memory to allocate list");
+	    }
+	    listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
+	    elemPtrs = &listRepPtr->elements;
+	    for (i=0; i < elemCount; i++) {
+		elemPtrs[i] = oldElemPtrs[i];
+		Tcl_IncrRefCount(elemPtrs[i]);
+	    }
+	    listRepPtr->refCount++;
+	    listRepPtr->elemCount = elemCount;
+	    listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+	    oldListRepPtr->refCount--;   
+	}
+    listRepPtr->mutableFlag=1;
+    return listPtr;
 }
 
 /*
diff -aburN tcl8.5.0-orig/generic/tclMutable.c tcl8.5.0/generic/tclMutable.c
--- tcl8.5.0-orig/generic/tclMutable.c	Thu Jan  1 00:00:00 1970
+++ tcl8.5.0/generic/tclMutable.c	Tue Jan 29 23:59:06 2008
@@ -0,0 +1,189 @@
+#include "tclInt.h"
+
+int tclTraceMutable;
+
+#ifdef TCL_THREADS
+static Tcl_Mutex mutableInvalMutex;
+#define MutLock() Tcl_MutexLock(&mutableInvalMutex)
+#define MutUnlock() Tcl_MutexUnlock(&mutableInvalMutex)
+#else
+#define MutLock()
+#define MutUnlock()
+#endif
+
+/*
+ * List of mutable containers having a string rep at any given time.
+ * Uses Tcl_Obj's as chained cells (twoPtrValue == car,cdr)
+ * Process-global !
+ */
+static Tcl_Obj *mutableInvalList=NULL;
+
+static void DebugObj(Tcl_Obj *ob)
+{
+  printf("Obj:0x%X(%d) ",
+	 (int)ob,
+	 ob->refCount);
+  if (!ob->typePtr)
+    printf("(null) ");
+  else if (ob->typePtr==&tclListType)
+    printf("(List):0x%X(%d) (%d elts%s%s) ",
+	   (int)ListRepPtr(ob),
+	   (int)ListRepPtr(ob)->refCount,
+	   (int)ListRepPtr(ob)->elemCount,
+	   ListRepPtr(ob)->mutableFlag?", Mutable":"",
+	   (ListRepPtr(ob)->mutableFlag&MUTABLE_TOINVAL)?", ToInval":"");  
+  else
+    printf("(%s):0x%X-0x%X ",
+	   ob->typePtr->name,
+	   (int)ob->internalRep.twoPtrValue.ptr1,
+	   (int)ob->internalRep.twoPtrValue.ptr2);
+  printf("<<<%s>>>\n",(ob->bytes?ob->bytes:"?"));
+  fflush(stdout);
+}
+
+int
+Tcl_DebugObjObjCmd(
+		   ClientData dummy,		/* Not used. */
+		   Tcl_Interp *interp,		/* Current interpreter. */
+		   int objc,			/* Number of arguments. */
+		   Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+  Tcl_Obj *ob;
+  
+  if (objc != 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "object");
+    return TCL_ERROR;
+  }
+  ob=objv[1];
+  DebugObj(ob);
+  Tcl_SetObjResult(interp, ob);
+  return TCL_OK;
+}
+
+int MutSpy(Tcl_Obj *ob)
+{
+  if (tclTraceMutable)
+    {
+      printf("*** Mutating: ");
+      DebugObj(ob);
+    }
+  return 1;
+}
+
+int
+Tcl_MutableObjCmd(
+		  ClientData dummy,		/* Not used. */
+		  Tcl_Interp *interp,		/* Current interpreter. */
+		  int objc,			/* Number of arguments. */
+		  Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+  Tcl_Obj *obj;
+  
+  if (objc != 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "<list>");
+    return TCL_ERROR;
+  }
+  obj=objv[1];
+  obj=Tcl_MakeListMutable(interp,obj);
+  if (!obj) return TCL_ERROR;
+  Tcl_SetObjResult(interp,obj);
+  return TCL_OK;
+}
+
+int
+Tcl_MutantObjCmd(
+		 ClientData dummy,		/* Not used. */
+		 Tcl_Interp *interp,		/* Current interpreter. */
+		 int objc,			/* Number of arguments. */
+		 Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+  int ret;
+
+  if (objc < 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "<command> [<args>...]");
+    return TCL_ERROR;
+  }
+  ((Interp *)interp)->mutant++;
+  ret=Tcl_EvalObjv(interp, objc-1, objv+1, 0);
+  ((Interp *)interp)->mutant--;
+
+  return ret;
+}
+
+#define TclCar(obj) ((Tcl_Obj *)(obj)->internalRep.twoPtrValue.ptr1)
+#define TclCdr(obj) ((Tcl_Obj *)(obj)->internalRep.twoPtrValue.ptr2)
+#define TclSetCar(cons,obj)  
+
+void TclAddToMutableInvalList(Tcl_Obj *obj)
+{
+  Tcl_Obj *cons;
+
+  cons=Tcl_NewObj();
+  Tcl_IncrRefCount(cons);
+  cons->internalRep.twoPtrValue.ptr1=obj;
+  MutLock();
+  cons->internalRep.twoPtrValue.ptr2=mutableInvalList;
+  mutableInvalList=cons;
+  MutUnlock();
+  if (tclTraceMutable) printf(" + 0x%X <<<%s>>>\n",(int)obj,obj->bytes);
+}
+
+void TclRemoveFromMutableInvalList(Tcl_Obj *obj)
+{
+  Tcl_Obj **x,*y;
+
+  MutLock();
+  for(x=&mutableInvalList;(y=*x);x=(Tcl_Obj **)&y->internalRep.twoPtrValue.ptr2)
+    {
+      if (TclCar(y)==obj)
+	{
+	  *x=TclCdr(y);
+	  MutUnlock();
+	  Tcl_DecrRefCount(y);
+	  if (tclTraceMutable)
+	    printf(" -- 0x%X\n",(int)obj);
+	  return;
+	}
+    }
+  MutUnlock();
+  if (tclTraceMutable)
+    fprintf(stderr,"*** Internal error: object not found in MutableInvalList: 0x%X <<<%s>>>\n",(int)obj,obj->bytes);
+}
+
+static void TclMaskMutableFlag(Tcl_Obj *obj)
+{
+  if (obj->typePtr==&tclListType)
+    {
+      ListRepPtr(obj)->mutableFlag &= (~MUTABLE_TOINVAL);
+    }
+  else
+    {
+      printf("*** Internal error: masking object of immutable type:\n");
+      DebugObj(obj);
+    }
+}
+
+void TclMutableMassInvalidator(void)
+{
+  Tcl_Obj *cons,*nxt;
+
+  if (tclTraceMutable)
+    printf("\n*** Mass Invalidator ***\n");
+  MutLock();
+  for(cons=mutableInvalList;cons;cons=nxt)
+    {
+      Tcl_Obj *obj;
+
+      nxt=TclCdr(cons);
+      obj=TclCar(cons);
+      if (tclTraceMutable)
+	printf(" - 0x%X <<<%s>>>\n",(int)obj,obj->bytes);
+      Tcl_InvalidateStringRep(obj);
+      TclMaskMutableFlag(obj);
+      Tcl_DecrRefCount(cons);
+    }
+  mutableInvalList=NULL;
+  MutUnlock();
+  if (tclTraceMutable)
+    printf("*** Done ***\n\n");
+}
diff -aburN tcl8.5.0-orig/generic/tclUtil.c tcl8.5.0/generic/tclUtil.c
--- tcl8.5.0-orig/generic/tclUtil.c	Thu Dec 13 15:23:20 2007
+++ tcl8.5.0/generic/tclUtil.c	Tue Jan 29 23:26:13 2008
@@ -1197,7 +1197,7 @@
 		if (resPtr) {
 		    Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
 		} else {
-		    if (Tcl_IsShared(objPtr)) {
+		    if (Tcl_IsShared(objPtr) && !Tcl_IsListAndMutableNoInterp(objPtr)) {
 			resPtr = TclListObjCopy(NULL, objPtr);
 		    } else {
 			resPtr = objPtr;
diff -aburN tcl8.5.0-orig/generic/tclVar.c tcl8.5.0/generic/tclVar.c
--- tcl8.5.0-orig/generic/tclVar.c	Thu Dec 13 15:23:22 2007
+++ tcl8.5.0/generic/tclVar.c	Thu Jan 24 00:14:20 2008
@@ -1844,7 +1844,7 @@
 		TclNewObj(oldValuePtr);
 		varPtr->value.objPtr = oldValuePtr;
 		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
-	    } else if (Tcl_IsShared(oldValuePtr)) {
+	    } else if (Tcl_IsShared(oldValuePtr) && !Tcl_IsListAndMutable(oldValuePtr)) {
 		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
 		TclDecrRefCount(oldValuePtr);
 		oldValuePtr = varPtr->value.objPtr;
@@ -1864,7 +1864,7 @@
 		varPtr->value.objPtr = newValuePtr;
 		Tcl_IncrRefCount(newValuePtr);
 	    } else {
-		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
+		if (Tcl_IsShared(oldValuePtr) /* Mutability lost if any */ ) {	/* Append to copy. */
 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
 		    TclDecrRefCount(oldValuePtr);
 		    oldValuePtr = varPtr->value.objPtr;
@@ -2650,7 +2650,7 @@
 
 	    TclNewObj(varValuePtr);
 	    createdNewObj = 1;
-	} else if (Tcl_IsShared(varValuePtr)) {
+	} else if (Tcl_IsShared(varValuePtr) && !Tcl_IsListAndMutable(varValuePtr)) {
 	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
 	    createdNewObj = 1;
 	}
diff -aburN tcl8.5.0-orig/tests/mutability.test tcl8.5.0/tests/mutability.test
--- tcl8.5.0-orig/tests/mutability.test	Thu Jan  1 00:00:00 1970
+++ tcl8.5.0/tests/mutability.test	Mon Jan 28 23:35:36 2008
@@ -0,0 +1,62 @@
+# Commands covered:  mutable mutant
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-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.
+#
+# RCS: @(#) $Id: llength.test,v 1.6 2004/05/19 12:23:58 dkf Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+test mutability-1.1 {mutable list} {
+    mutable [list a b c d]
+} {a b c d}
+test mutability-1.2 {effective mutability} {
+    set m [mutable [list 1 2 3]]
+    set n $m
+    mutant lappend m 4
+    list $m $n
+} {{1 2 3 4} {1 2 3 4}}
+test mutability-1.3 {ineffective mutability} {
+    set m [mutable [list 1 2 3]]
+    set n $m
+    lappend m 4
+    list $m $n
+} {{1 2 3 4} {1 2 3}}
+test mutability-1.4 {loss of mutability} {
+    set m [mutable [list 1 2 3]]
+    lappend m 4
+    set n $m
+    lappend m 5
+    list $m $n
+} {{1 2 3 4 5} {1 2 3 4}}
+test mutability-1.5 {immutable snapshot} {
+    set m [mutable [list 1 2 3]]
+    set n [lrange $m 0 end]
+    mutant lappend m 4
+    list $m $n    
+} {{1 2 3 4} {1 2 3}}
+
+test mutability-2.1 {error conditions} {
+    list [catch {mutable} msg] $msg
+} {1 {wrong # args: should be "mutable <list>"}}
+test mutability-2.2 {error conditions} {
+    list [catch {mutable a b} msg] $msg
+} {1 {wrong # args: should be "mutable <list>"}}
+test mutability-2.3 {error conditions} {
+    list [catch {mutable "a b c \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff -aburN tcl8.5.0-orig/tests/safe.test tcl8.5.0/tests/safe.test
--- tcl8.5.0-orig/tests/safe.test	Tue Dec  5 18:45:52 2006
+++ tcl8.5.0/tests/safe.test	Wed Jan 30 00:01:18 2008
@@ -169,7 +169,7 @@
 
 test safe-6.1 {test safe interpreters knowledge of the world} {
     lsort [SafeEval {info globals}]
-} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
+} {tcl_interactive tcl_patchLevel tcl_platform tcl_traceMutable tcl_version}
 test safe-6.2 {test safe interpreters knowledge of the world} {
     SafeEval {info script}
 } {}
diff -aburN tcl8.5.0-orig/win/Makefile.in tcl8.5.0/win/Makefile.in
--- tcl8.5.0-orig/win/Makefile.in	Wed Dec 19 21:50:14 2007
+++ tcl8.5.0/win/Makefile.in	Tue Jan 15 22:13:56 2008
@@ -248,6 +248,7 @@
 	tclListObj.$(OBJEXT) \
 	tclLoad.$(OBJEXT) \
 	tclMain.$(OBJEXT) \
+	tclMutable.$(OBJEXT) \
 	tclNamesp.$(OBJEXT) \
 	tclNotify.$(OBJEXT) \
 	tclObj.$(OBJEXT) \
