merge trunk

18 files changed, 581 insertions, 597 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ad81bb8..912f382 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2590,10 +2590,6 @@ TclRenameCommand(
         Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
 	return TCL_ERROR;
     }
-    cmdNsPtr = cmdPtr->nsPtr;
-    oldFullName = Tcl_NewObj();
-    Tcl_IncrRefCount(oldFullName);
-    Tcl_GetCommandFullName(interp, cmd, oldFullName);
 
     /*
      * If the new command name is NULL or empty, delete the command. Do this
@@ -2602,10 +2598,14 @@ TclRenameCommand(
 
     if ((newName == NULL) || (*newName == '\0')) {
 	Tcl_DeleteCommandFromToken(interp, cmd);
-	result = TCL_OK;
-	goto done;
+	return TCL_OK;
     }
 
+    cmdNsPtr = cmdPtr->nsPtr;
+    oldFullName = Tcl_NewObj();
+    Tcl_IncrRefCount(oldFullName);
+    Tcl_GetCommandFullName(interp, cmd, oldFullName);
+
     /*
      * Make sure that the destination command does not already exist. The
      * rename operation is like creating a command, so we should automatically
@@ -3118,6 +3118,7 @@ Tcl_DeleteCommandFromToken(
      */
 
     cmdPtr->nsPtr->refCount++;
+
     if (cmdPtr->tracePtr != NULL) {
 	CommandTrace *tracePtr;
 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 49fd2ae..93cf983 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1057,7 +1057,6 @@ TclInitSubsystems(void)
 					 * mutexes. */
 	    TclInitIOSubsystem();	/* Inits a tsd key (noop). */
 	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
-	    TclpSetInterfaces();
 	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
 	    subsystemsInitialized = 1;
 	}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 8fb3aa8..144bab0 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -830,15 +830,6 @@ TclResetFilesystem(void)
     if (++theFilesystemEpoch == 0) {
 	++theFilesystemEpoch;
     }
-
-#ifdef _WIN32
-    /*
-     * Cleans up the win32 API filesystem proc lookup table. This must happen
-     * very late in finalization so that deleting of copied dlls can occur.
-     */
-
-    TclWinResetInterfaces();
-#endif
 }
 
 /*
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 4375eaf..3ec1b79 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1199,9 +1199,10 @@ declare 27 win {
 
 # Added in 8.4.2
 
-declare 28 win {
-    void TclWinResetInterfaces(void)
-}
+# Removed in 9.0:
+#declare 28 win {
+#    void TclWinResetInterfaces(void)
+#}
 
 ################################
 # Unix specific functions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f980980..ea6a775 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3112,7 +3112,6 @@ MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    Tcl_PathPart portion);
 MODULE_SCOPE char *	TclpReadlink(const char *fileName,
 			    Tcl_DString *linkPtr);
-MODULE_SCOPE void	TclpSetInterfaces(void);
 MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
 MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
 MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index ff336e6..54c35de 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -154,8 +154,7 @@ EXTERN char *		TclWinNoBackslash(char *path);
 /* Slot 26 is reserved */
 /* 27 */
 EXTERN void		TclWinFlushDirtyChannels(void);
-/* 28 */
-EXTERN void		TclWinResetInterfaces(void);
+/* Slot 28 is reserved */
 /* 29 */
 EXTERN int		TclWinCPUID(int index, int *regs);
 /* 30 */
@@ -300,7 +299,7 @@ typedef struct TclIntPlatStubs {
     void (*reserved25)(void);
     void (*reserved26)(void);
     void (*tclWinFlushDirtyChannels) (void); /* 27 */
-    void (*tclWinResetInterfaces) (void); /* 28 */
+    void (*reserved28)(void);
     int (*tclWinCPUID) (int index, int *regs); /* 29 */
     int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* WIN */
@@ -442,8 +441,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 /* Slot 26 is reserved */
 #define TclWinFlushDirtyChannels \
 	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
-#define TclWinResetInterfaces \
-	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
+/* Slot 28 is reserved */
 #define TclWinCPUID \
 	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
 #define TclUnixOpenTemporaryFile \
@@ -508,6 +506,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TCL_STORAGE_CLASS DLLIMPORT
 #define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
 #define TclWinConvertWSAError TclWinConvertError
+#undef TclWinResetInterfaces
+#define TclWinResetInterfaces() /* nop */
+#undef TclWinSetInterfaces
+#define TclWinSetInterfaces(dummy) /* nop */
 
 #if !defined(_WIN32)
 #   undef TclpGetPid
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 1d7ecb6..39e3fb2 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -60,8 +60,6 @@ static const struct {
 static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
 			    Namespace *nsPtr, const char *nsNameStr);
-static void		ClearMixins(Class *clsPtr);
-static void		ClearSuperclasses(Class *clsPtr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
 			    Method *mPtr, Tcl_Obj *namePtr,
 			    Method **newMPtrPtr);
@@ -73,6 +71,9 @@ static void		DeletedHelpersNamespace(ClientData clientData);
 static Tcl_NRPostProc	FinalizeAlloc;
 static Tcl_NRPostProc	FinalizeNext;
 static Tcl_NRPostProc	FinalizeObjectCall;
+static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
+static void		InitClassSystemRoots(Tcl_Interp *interp,
+			    Foundation *fPtr);
 static int		InitFoundation(Tcl_Interp *interp);
 static void		KillFoundation(ClientData clientData,
 			    Tcl_Interp *interp);
@@ -82,6 +83,9 @@ static void		ObjectRenamedTrace(ClientData clientData,
 			    Tcl_Interp *interp, const char *oldName,
 			    const char *newName, int flags);
 static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
+static void		DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
+static inline void	RemoveClass(Class **list, int num, int idx);
+static inline void	RemoveObject(Object **list, int num, int idx);
 static inline void	SquelchCachedName(Object *oPtr);
 
 static int		PublicObjectCmd(ClientData clientData,
@@ -228,10 +232,52 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
  * ROOT_CLASS respectively.
  */
 
-#define Deleted(oPtr)		(((Object *)(oPtr))->command == NULL)
+#define Deleted(oPtr)		((oPtr)->flags & OBJECT_DELETED)
 #define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
 #define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
 #define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
+
+#define RemoveItem(type, lst, i) \
+    do {						\
+	Remove ## type ((lst).list, (lst).num, i);	\
+	(lst).num--;					\
+    } while (0)
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RemoveClass, RemoveObject --
+ *
+ *	Helpers for the RemoveItem macro for deleting a class or object from a
+ *	list. Setting the "empty" location to NULL makes debugging a little
+ *	easier.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+RemoveClass(
+    Class **list,
+    int num,
+    int idx)
+{
+    for (; idx < num - 1; idx++) {
+	list[idx] = list[idx + 1];
+    }
+    list[idx] = NULL;
+}
+
+static inline void
+RemoveObject(
+    Object **list,
+    int num,
+    int idx)
+{
+    for (; idx < num - 1; idx++) {
+	list[idx] = list[idx + 1];
+    }
+    list[idx] = NULL;
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -375,28 +421,10 @@ InitFoundation(
     Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
 
     /*
-     * Create the objects at the core of the object system. These need to be
-     * spliced manually.
+     * Create the special objects at the core of the object system.
      */
 
-    fPtr->objectCls = AllocClass(interp,
-	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
-    fPtr->classCls = AllocClass(interp,
-	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
-    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
-    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
-    fPtr->objectCls->flags |= ROOT_OBJECT;
-    fPtr->objectCls->superclasses.num = 0;
-    ckfree(fPtr->objectCls->superclasses.list);
-    fPtr->objectCls->superclasses.list = NULL;
-    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
-    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
-    fPtr->classCls->flags |= ROOT_CLASS;
-    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
-    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
-    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
-    AddRef(fPtr->objectCls->thisPtr);
-    AddRef(fPtr->objectCls);
+    InitClassSystemRoots(interp, fPtr);
 
     /*
      * Basic method declarations for the core classes.
@@ -463,6 +491,88 @@ InitFoundation(
     }
     return Tcl_EvalEx(interp, slotScript, -1, 0);
 }
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitClassSystemRoots --
+ *
+ *	Creates the objects at the core of the object system. These need to be
+ *	spliced manually.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InitClassSystemRoots(
+    Tcl_Interp *interp,
+    Foundation *fPtr)
+{
+    Class fakeCls;
+    Object fakeObject;
+
+    /*
+     * Stand up a phony class for bootstrapping.
+     */
+
+    fPtr->objectCls = &fakeCls;
+
+    /*
+     * Referenced in AllocClass to increment the refCount.
+     */
+
+    fakeCls.thisPtr = &fakeObject;
+
+    fPtr->objectCls = AllocClass(interp,
+	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
+    fPtr->classCls = AllocClass(interp,
+	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
+
+    /*
+     * Rewire bootstrapped objects.
+     */
+
+    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
+    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
+
+    AddRef(fPtr->objectCls->thisPtr);
+    AddRef(fPtr->classCls->thisPtr);
+    AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr);
+    AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);
+
+    /*
+     * Special initialization for the primordial objects.
+     */
+
+    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
+    fPtr->objectCls->flags |= ROOT_OBJECT;
+
+    /*
+     * This is why it is unnecessary in this routine to make up for the
+     * incremented reference count of fPtr->objectCls that was sallwed by
+     * fakeObject.
+     */
+
+    fPtr->objectCls->superclasses.num = 0;
+    ckfree(fPtr->objectCls->superclasses.list);
+    fPtr->objectCls->superclasses.list = NULL;
+
+    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
+    fPtr->classCls->flags |= ROOT_CLASS;
+
+    /*
+     * Standard initialization for new Objects.
+     */
+
+    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
+    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
+
+    /*
+     * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
+     * Everything else is careful to prohibit looping.
+     */
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -522,8 +632,6 @@ KillFoundation(
 {
     Foundation *fPtr = GetFoundation(interp);
 
-    DelRef(fPtr->objectCls->thisPtr);
-    DelRef(fPtr->objectCls);
     TclDecrRefCount(fPtr->unknownMethodNameObj);
     TclDecrRefCount(fPtr->constructorName);
     TclDecrRefCount(fPtr->destructorName);
@@ -538,8 +646,11 @@ KillFoundation(
  * AllocObject --
  *
  *	Allocate an object of basic type. Does not splice the object into its
- *	class's instance list.  The caller must set the classPtr on the object,
- *	either to a class or to NULL.
+ *	class's instance list.  The caller must set the classPtr on the object
+ *	to either a class or NULL, call TclOOAddToInstances to add the object
+ *	to the class's instance list, and if the object itself is a class, use
+ *	call TclOOAddToSubclasses() to add it to the right class's list of
+ *	subclasses.
  *
  * ----------------------------------------------------------------------
  */
@@ -552,8 +663,8 @@ AllocObject(
 				 * if the OO system should pick the object
 				 * name itself (equal to the namespace
 				 * name). */
-    Namespace *nsPtr,		/* The namespace to create the object in,
-				   or NULL if *nameStr is NULL */
+    Namespace *nsPtr,		/* The namespace to create the object in, or
+				 * NULL if *nameStr is NULL */
     const char *nsNameStr)	/* The name of the namespace to create, or
 				 * NULL if the OO system should pick a unique
 				 * name itself. If this is non-NULL but names
@@ -564,7 +675,7 @@ AllocObject(
     Object *oPtr;
     Command *cmdPtr;
     CommandTrace *tracePtr;
-    int creationEpoch, ignored;
+    int creationEpoch;
 
     oPtr = ckalloc(sizeof(Object));
     memset(oPtr, 0, sizeof(Object));
@@ -641,9 +752,15 @@ AllocObject(
      */
 
     oPtr->fPtr = fPtr;
-    oPtr->selfCls = fPtr->objectCls;
     oPtr->creationEpoch = creationEpoch;
-    oPtr->refCount = 1;
+
+    /*
+     * An object starts life with a refCount of 2 to mark the two stages of
+     * destruction it occur:  A call to ObjectRenamedTrace(), and a call to
+     * ObjectNamespaceDeleted().
+     */
+
+    oPtr->refCount = 2;
     oPtr->flags = USE_CLASS_CACHE;
 
     /*
@@ -658,6 +775,7 @@ AllocObject(
 	if (nsPtr->parentPtr != NULL) {
 	    nsPtr = nsPtr->parentPtr;
 	}
+
     }
     oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
 	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
@@ -676,26 +794,8 @@ AllocObject(
     tracePtr->nextPtr = NULL;
     tracePtr->refCount = 1;
 
-    /*
-     * Access the namespace command table directly when creating "my" to avoid
-     * a bottleneck in string manipulation. Another abstraction-buster.
-     */
-
-    cmdPtr = ckalloc(sizeof(Command));
-    memset(cmdPtr, 0, sizeof(Command));
-    cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
-    cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
-	    &ignored);
-    cmdPtr->refCount = 1;
-    cmdPtr->objProc = PrivateObjectCmd;
-    cmdPtr->deleteProc = MyDeleted;
-    cmdPtr->objClientData = cmdPtr->deleteData = oPtr;
-    cmdPtr->proc = TclInvokeObjectCommand;
-    cmdPtr->clientData = cmdPtr;
-    cmdPtr->nreProc = PrivateNRObjectCmd;
-    Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr);
-    oPtr->myCommand = (Tcl_Command) cmdPtr;
-
+    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
+	    PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
     return oPtr;
 }
 
@@ -765,6 +865,7 @@ ObjectRenamedTrace(
     int flags)			/* Why was the object deleted? */
 {
     Object *oPtr = clientData;
+
     /*
      * If this is a rename and not a delete of the object, we just flush the
      * cache of the object name.
@@ -777,95 +878,84 @@ ObjectRenamedTrace(
 
     /*
      * The namespace is only deleted if it hasn't already been deleted. [Bug
-     * 2950259]. If the namespace has already been deleted, then
-     * ObjectNamespaceDeleted() has already cleaned up this command.
+     * 2950259].
      */
 
-    if (oPtr->namespacePtr == NULL) {
-	/*
-	 * ObjectNamespaceDeleted() has already done all the cleanup, but
-	 * detected that the command was in the process of being deleted, and
-	 * left the pointer allocated for us.
-	 */
-	DelRef(oPtr);
-    } else {
-	if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc == NULL) {
-	    /*
-	     * ObjectNamespaceDeleted() called us, and still has some work to
-	     * do, so we leave the pointer allocated for it to finish, and then
-	     * it will deallocate the pointer.
-	     */
-	} else {
-	    Tcl_DeleteNamespace(oPtr->namespacePtr);
-	    /*
-	     * ObjectNamespaceDeleted() doesn't know it was us that just
-	     * called, so it left the pointer allocated.
-	     */
-	    DelRef(oPtr);
-	}
+    if (!Deleted(oPtr)) {
+	Tcl_DeleteNamespace(oPtr->namespacePtr);
     }
+    oPtr->command = NULL;
+    TclOODecrRefCount(oPtr);
     return;
 }
 
 /*
  * ----------------------------------------------------------------------
  *
- * ClearMixins, ClearSuperclasses --
+ * DeleteDescendants, ReleaseClassContents --
  *
- *	Utility functions for correctly clearing the list of mixins or
- *	superclasses of a class. Will ckfree() the list storage.
+ *	Tear down the special class data structure, including deleting all
+ *	dependent classes and objects.
  *
  * ----------------------------------------------------------------------
  */
 
 static void
-ClearMixins(
-    Class *clsPtr)
+DeleteDescendants(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Object *oPtr)		/* The object representing the class. */
 {
+    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
+    Object *instancePtr;
     int i;
-    Class *mixinPtr;
 
-    if (clsPtr->mixins.num == 0) {
-	return;
-    }
+    /*
+     * Squelch classes that this class has been mixed into.
+     */
+
+    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+	/*
+	 * This condition also covers the case where mixinSubclassPtr ==
+	 * clsPtr
+	 */
 
-    FOREACH(mixinPtr, clsPtr->mixins) {
-	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+	if (!Deleted(mixinSubclassPtr->thisPtr)) {
+	    Tcl_DeleteCommandFromToken(interp,
+		    mixinSubclassPtr->thisPtr->command);
+	}
+	i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
+	TclOODecrRefCount(mixinSubclassPtr->thisPtr);
     }
-    ckfree(clsPtr->mixins.list);
-    clsPtr->mixins.list = NULL;
-    clsPtr->mixins.num = 0;
-}
 
-static void
-ClearSuperclasses(
-    Class *clsPtr)
-{
-    int i;
-    Class *superPtr;
+    /*
+     * Squelch subclasses of this class.
+     */
 
-    if (clsPtr->superclasses.num == 0) {
-	return;
+    FOREACH(subclassPtr, clsPtr->subclasses) {
+	if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
+	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
+	}
+	i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr);
+	TclOODecrRefCount(subclassPtr->thisPtr);
     }
 
-    FOREACH(superPtr, clsPtr->superclasses) {
-	TclOORemoveFromSubclasses(clsPtr, superPtr);
+    /*
+     * Squelch instances of this class (includes objects we're mixed into).
+     */
+
+    if (!IsRootClass(oPtr)) {
+	FOREACH(instancePtr, clsPtr->instances) {
+	    /*
+	     * This condition also covers the case where instancePtr == oPtr
+	     */
+
+	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
+		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
+	    }
+	    i -= TclOORemoveFromInstances(instancePtr, clsPtr);
+	}
     }
-    ckfree(clsPtr->superclasses.list);
-    clsPtr->superclasses.list = NULL;
-    clsPtr->superclasses.num = 0;
 }
-
-/*
- * ----------------------------------------------------------------------
- *
- * ReleaseClassContents --
- *
- *	Tear down the special class data structure, including deleting all
- *	dependent classes and objects.
- *
- * ----------------------------------------------------------------------
- */
 
 static void
 ReleaseClassContents(
@@ -874,8 +964,7 @@ ReleaseClassContents(
 {
     FOREACH_HASH_DECLS;
     int i;
-    Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
-    Object *instancePtr;
+    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
     Method *mPtr;
     Foundation *fPtr = oPtr->fPtr;
     Tcl_Obj *variableObj;
@@ -898,132 +987,6 @@ ReleaseClassContents(
     }
 
     /*
-     * Lock a number of dependent objects until we've stopped putting our
-     * fingers in them.
-     */
-
-    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (mixinSubclassPtr != NULL) {
-	    AddRef(mixinSubclassPtr);
-	    AddRef(mixinSubclassPtr->thisPtr);
-	}
-    }
-    FOREACH(subclassPtr, clsPtr->subclasses) {
-	if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
-	    AddRef(subclassPtr);
-	    AddRef(subclassPtr->thisPtr);
-	}
-    }
-    if (!IsRootClass(oPtr)) {
-	FOREACH(instancePtr, clsPtr->instances) {
-	    if (instancePtr != oPtr) {
-		int j;
-		if (instancePtr->selfCls == clsPtr) {
-		    instancePtr->flags |= CLASS_GONE;
-		}
-		for(j=0 ; j<instancePtr->mixins.num ; j++) {
-		    Class *mixin = instancePtr->mixins.list[j];
-		    Class *nextMixin = NULL;
-		    if (mixin == clsPtr) {
-			if (j < instancePtr->mixins.num - 1) {
-			    nextMixin = instancePtr->mixins.list[j+1];
-			}
-			if (j == 0) {
-			    instancePtr->mixins.num = 0;
-			    instancePtr->mixins.list = NULL;
-			} else {
-			    instancePtr->mixins.list[j-1] = nextMixin;
-			}
-			instancePtr->mixins.num -= 1;
-		    }
-		}
-		if (instancePtr != NULL && !IsRoot(instancePtr)) {
-		    AddRef(instancePtr);
-		}
-	    }
-	}
-    }
-
-    /*
-     * Squelch classes that this class has been mixed into.
-     */
-
-    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (mixinSubclassPtr != clsPtr) {
-	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
-		Tcl_DeleteCommandFromToken(interp,
-			mixinSubclassPtr->thisPtr->command);
-	    }
-	    ClearMixins(mixinSubclassPtr);
-	    DelRef(mixinSubclassPtr->thisPtr);
-	    DelRef(mixinSubclassPtr);
-	}
-    }
-    if (clsPtr->mixinSubs.list != NULL) {
-	ckfree(clsPtr->mixinSubs.list);
-	clsPtr->mixinSubs.list = NULL;
-	clsPtr->mixinSubs.num = 0;
-    }
-
-    /*
-     * Squelch subclasses of this class.
-     */
-
-    FOREACH(subclassPtr, clsPtr->subclasses) {
-	if (IsRoot(subclassPtr)) {
-	    continue;
-	}
-	if (!Deleted(subclassPtr->thisPtr)) {
-	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
-	}
-	ClearSuperclasses(subclassPtr);
-	DelRef(subclassPtr->thisPtr);
-	DelRef(subclassPtr);
-    }
-    if (clsPtr->subclasses.list != NULL) {
-	ckfree(clsPtr->subclasses.list);
-	clsPtr->subclasses.list = NULL;
-	clsPtr->subclasses.num = 0;
-    }
-
-    /*
-     * Squelch instances of this class (includes objects we're mixed into).
-     */
-
-    if (!IsRootClass(oPtr)) {
-	FOREACH(instancePtr, clsPtr->instances) {
-	    if (instancePtr != oPtr) {
-		if (instancePtr == NULL || IsRoot(instancePtr)) {
-		    continue;
-		}
-		if (!Deleted(instancePtr)) {
-		    Tcl_DeleteCommandFromToken(interp, instancePtr->command);
-		    /*
-		     * Tcl_DeleteCommandFromToken() may have done to whole
-		     * job for us.  Roll back and check again.
-		     */
-		    i--;
-		    continue;
-		}
-		DelRef(instancePtr);
-	    }
-	}
-    }
-    if (clsPtr->instances.list != NULL) {
-	ckfree(clsPtr->instances.list);
-	clsPtr->instances.list = NULL;
-	clsPtr->instances.num = 0;
-    }
-
-    /*
-     * Special: We delete these after everything else.
-     */
-
-    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
-	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
-    }
-
-    /*
      * Squelch method implementation chain caches.
      */
 
@@ -1076,8 +1039,12 @@ ReleaseClassContents(
 	clsPtr->metadataPtr = NULL;
     }
 
-    ClearMixins(clsPtr);
-    ClearSuperclasses(clsPtr);
+    FOREACH(tmpClsPtr, clsPtr->mixins) {
+	TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
+    }
+    FOREACH(tmpClsPtr, clsPtr->superclasses) {
+	TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
+    }
 
     FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
 	TclOODelMethodRef(mPtr);
@@ -1093,12 +1060,9 @@ ReleaseClassContents(
 	ckfree(clsPtr->variables.list);
     }
 
-    /* Tell oPtr that it's class is gone so that it doesn't try to remove
-     * itself from it's classe's list of instances
-     */
-    oPtr->flags |= CLASS_GONE;
-    DelRef(clsPtr);
-
+    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
+	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
+    }
 }
 
 /*
@@ -1126,13 +1090,29 @@ ObjectNamespaceDeleted(
     Method *mPtr;
     Tcl_Obj *filterObj, *variableObj;
     Tcl_Interp *interp = oPtr->fPtr->interp;
-    int finished = 0, i;
+    int i;
+
+    if (Deleted(oPtr)) {
+	/*
+	 * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
+	 * guard could be removed.
+	 */
 
+	return;
+    }
 
-    AddRef(fPtr->classCls);
-    AddRef(fPtr->objectCls);
-    AddRef(fPtr->classCls->thisPtr);
-    AddRef(fPtr->objectCls->thisPtr);
+    /*
+     * One rule for the teardown routines is that if an object is in the
+     * process of being deleted, nothing else may modify its bookeeping
+     * records.  This is the flag that
+     */
+
+    oPtr->flags |= OBJECT_DELETED;
+
+    /* Let the dominoes fall */
+    if (oPtr->classPtr) {
+	DeleteDescendants(interp, oPtr);
+    }
 
     /*
      * We do not run destructors on the core class objects when the
@@ -1141,14 +1121,14 @@ ObjectNamespaceDeleted(
      * of it have gone. [Bug 2949397]
      */
 
-    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
+    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
 	CallContext *contextPtr =
 		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
 	int result;
 
 	Tcl_InterpState state;
-
 	oPtr->flags |= DESTRUCTOR_CALLED;
+
 	if (contextPtr != NULL) {
 	    contextPtr->callPtr->flags |= DESTRUCTOR;
 	    contextPtr->skip = 0;
@@ -1170,7 +1150,7 @@ ObjectNamespaceDeleted(
      * points into freed memory.
      */
 
-    if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
+    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
 	/*
 	 * Something has already started the command deletion process. We can
 	 * go ahead and clean up the the namespace,
@@ -1180,10 +1160,9 @@ ObjectNamespaceDeleted(
 	 * The namespace must have been deleted directly.  Delete the command
 	 * as well.
 	 */
+
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
-	finished = 1;
     }
-    oPtr->command = NULL;
 
     if (oPtr->myCommand) {
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
@@ -1194,14 +1173,14 @@ ObjectNamespaceDeleted(
      * methods on the object.
      */
 
-    if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) {
-	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
-    }
+    /*
+     * TODO: Should this be protected with a * !IsRoot() condition?
+     */
+
+    TclOORemoveFromInstances(oPtr, oPtr->selfCls);
 
     FOREACH(mixinPtr, oPtr->mixins) {
-	if (mixinPtr && mixinPtr != oPtr->classPtr) {
-	    TclOORemoveFromInstances(oPtr, mixinPtr);
-	}
+	i -= TclOORemoveFromInstances(oPtr, mixinPtr);
     }
     if (i) {
 	ckfree(oPtr->mixins.list);
@@ -1248,21 +1227,19 @@ ObjectNamespaceDeleted(
     }
 
     /*
-     *  Because an object can be a class that is an instance of itself, the
-     *  A class object's class structure should only be cleaned after most of
-     *  the cleanup on the object is done.
-     */
-
-
-    /*
+     * Because an object can be a class that is an instance of itself, the
+     * class object's class structure should only be cleaned after most of the
+     * cleanup on the object is done.
+     *
      * The class of objects needs some special care; if it is deleted (and
      * we're not killing the whole interpreter) we force the delete of the
      * class of classes now as well. Due to the incestuous nature of those two
      * classes, if one goes the other must too and yet the tangle can
      * sometimes not go away automatically; we force it here. [Bug 2962664]
      */
-    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
-	    && !Deleted(fPtr->classCls->thisPtr)) {
+
+    if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
+	    && !Tcl_InterpDeleted(interp)) {
 	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
     }
 
@@ -1270,30 +1247,47 @@ ObjectNamespaceDeleted(
 	ReleaseClassContents(interp, oPtr);
     }
 
-
     /*
      * Delete the object structure itself.
      */
 
-    oPtr->classPtr = NULL;
     oPtr->namespacePtr = NULL;
-
-    DelRef(fPtr->classCls->thisPtr);
-    DelRef(fPtr->objectCls->thisPtr);
-    DelRef(fPtr->classCls);
-    DelRef(fPtr->objectCls);
-    if (finished) {
-	/*
-	 * ObjectRenamedTrace called us, and not the other way around.
-	 */
-	DelRef(oPtr);
-    } else {
-	/*
-	 * ObjectRenamedTrace will call DelRef(oPtr).
-	 */
-    }
+    oPtr->selfCls = NULL;
+    TclOODecrRefCount(oPtr);
     return;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODecrRefCount --
+ *
+ *	Decrement the refcount of an object and deallocate storage then object
+ *	is no longer referenced.  Returns 1 if storage was deallocated, and 0
+ *	otherwise.
+ *
+ * ----------------------------------------------------------------------
+ */
 
+int
+TclOODecrRefCount(
+    Object *oPtr)
+{
+    if (oPtr->refCount-- <= 1) {
+	Class *clsPtr = oPtr->classPtr;
+
+	if (oPtr->classPtr != NULL) {
+	    ckfree(clsPtr->superclasses.list);
+	    ckfree(clsPtr->subclasses.list);
+	    ckfree(clsPtr->instances.list);
+	    ckfree(clsPtr->mixinSubs.list);
+	    ckfree(clsPtr->mixins.list);
+	    ckfree(oPtr->classPtr);
+	}
+	ckfree(oPtr);
+	return 1;
+    }
+    return 0;
 }
 
 /*
@@ -1307,36 +1301,28 @@ ObjectNamespaceDeleted(
  * ----------------------------------------------------------------------
  */
 
-void
+int
 TclOORemoveFromInstances(
     Object *oPtr,		/* The instance to remove. */
     Class *clsPtr)		/* The class (possibly) containing the
 				 * reference to the instance. */
 {
-    int i;
+    int i, res = 0;
     Object *instPtr;
 
-    FOREACH(instPtr, clsPtr->instances) {
-	if (oPtr == instPtr) {
-	    goto removeInstance;
-	}
+    if (Deleted(clsPtr->thisPtr)) {
+	return res;
     }
-    return;
 
-  removeInstance:
-    if (Deleted(clsPtr->thisPtr)) {
-	if (!IsRootClass(clsPtr)) {
-	    DelRef(clsPtr->instances.list[i]);
-	}
-	clsPtr->instances.list[i] = NULL;
-    } else {
-	clsPtr->instances.num--;
-	if (i < clsPtr->instances.num) {
-	    clsPtr->instances.list[i] =
-		    clsPtr->instances.list[clsPtr->instances.num];
+    FOREACH(instPtr, clsPtr->instances) {
+	if (oPtr == instPtr) {
+	    RemoveItem(Object, clsPtr->instances, i);
+	    TclOODecrRefCount(oPtr);
+	    res++;
+	    break;
 	}
-	clsPtr->instances.list[clsPtr->instances.num] = NULL;
     }
+    return res;
 }
 
 /*
@@ -1357,9 +1343,6 @@ TclOOAddToInstances(
 				 * assumed that the class is not already
 				 * present as an instance in the class. */
 {
-    if (Deleted(clsPtr->thisPtr)) {
-	return;
-    }
     if (clsPtr->instances.num >= clsPtr->instances.size) {
 	clsPtr->instances.size += ALLOC_CHUNK;
 	if (clsPtr->instances.size == ALLOC_CHUNK) {
@@ -1370,6 +1353,7 @@ TclOOAddToInstances(
 	}
     }
     clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
+    AddRef(oPtr);
 }
 
 /*
@@ -1378,36 +1362,32 @@ TclOOAddToInstances(
  * TclOORemoveFromSubclasses --
  *
  *	Utility function to remove a class from the list of subclasses within
- *	another class.
+ *	another class. Returns the number of removals performed.
  *
  * ----------------------------------------------------------------------
  */
 
-void
+int
 TclOORemoveFromSubclasses(
     Class *subPtr,		/* The subclass to remove. */
     Class *superPtr)		/* The superclass to possibly remove the
 				 * subclass reference from. */
 {
-    int i;
+    int i, res = 0;
     Class *subclsPtr;
 
-    FOREACH(subclsPtr, superPtr->subclasses) {
-	if (subPtr == subclsPtr) {
-	    goto removeSubclass;
-	}
+    if (Deleted(superPtr->thisPtr)) {
+	return res;
     }
-    return;
 
-  removeSubclass:
-    if (!Deleted(superPtr->thisPtr)) {
-	superPtr->subclasses.num--;
-	if (i < superPtr->subclasses.num) {
-	    superPtr->subclasses.list[i] =
-		    superPtr->subclasses.list[superPtr->subclasses.num];
+    FOREACH(subclsPtr, superPtr->subclasses) {
+	if (subPtr == subclsPtr) {
+	    RemoveItem(Class, superPtr->subclasses, i);
+	    TclOODecrRefCount(subPtr->thisPtr);
+	    res++;
 	}
-	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
     }
+    return res;
 }
 
 /*
@@ -1434,13 +1414,14 @@ TclOOAddToSubclasses(
     if (superPtr->subclasses.num >= superPtr->subclasses.size) {
 	superPtr->subclasses.size += ALLOC_CHUNK;
 	if (superPtr->subclasses.size == ALLOC_CHUNK) {
-	    superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
+	    superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
 	} else {
 	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
 		    sizeof(Class *) * superPtr->subclasses.size);
 	}
     }
     superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
+    AddRef(subPtr->thisPtr);
 }
 
 /*
@@ -1454,31 +1435,28 @@ TclOOAddToSubclasses(
  * ----------------------------------------------------------------------
  */
 
-void
+int
 TclOORemoveFromMixinSubs(
     Class *subPtr,		/* The subclass to remove. */
     Class *superPtr)		/* The superclass to possibly remove the
 				 * subclass reference from. */
 {
-    int i;
+    int i, res = 0;
     Class *subclsPtr;
 
-    FOREACH(subclsPtr, superPtr->mixinSubs) {
-	if (subPtr == subclsPtr) {
-	    goto removeSubclass;
-	}
+    if (Deleted(superPtr->thisPtr)) {
+	return res;
     }
-    return;
 
-  removeSubclass:
-    if (!Deleted(superPtr->thisPtr)) {
-	superPtr->mixinSubs.num--;
-	if (i < superPtr->mixinSubs.num) {
-	    superPtr->mixinSubs.list[i] =
-		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
+    FOREACH(subclsPtr, superPtr->mixinSubs) {
+	if (subPtr == subclsPtr) {
+	    RemoveItem(Class, superPtr->mixinSubs, i);
+	    TclOODecrRefCount(subPtr->thisPtr);
+	    res++;
+	    break;
 	}
-	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
     }
+    return res;
 }
 
 /*
@@ -1512,6 +1490,7 @@ TclOOAddToMixinSubs(
 	}
     }
     superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
+    AddRef(subPtr->thisPtr);
 }
 
 /*
@@ -1519,37 +1498,18 @@ TclOOAddToMixinSubs(
  *
  * AllocClass --
  *
- *	Allocate a basic class. Does not splice the class object into its
+ *	Allocate a basic class. Does not add class to its
  *	class's instance list.
  *
  * ----------------------------------------------------------------------
  */
 
-static Class *
-AllocClass(
-    Tcl_Interp *interp,		/* Interpreter within which to allocate the
-				 * class. */
-    Object *useThisObj)		/* Object that is to act as the class
-				 * representation, or NULL if a new object
-				 * with automatic name is to be used. */
+static inline void
+InitClassPath(
+    Tcl_Interp *interp,
+    Class *clsPtr)
 {
     Foundation *fPtr = GetFoundation(interp);
-    Class *clsPtr = ckalloc(sizeof(Class));
-
-    /*
-     * Make an object if we haven't been given one.
-     */
-
-    memset(clsPtr, 0, sizeof(Class));
-    if (useThisObj == NULL) {
-	clsPtr->thisPtr = AllocObject(interp, NULL, NULL, NULL);
-    } else {
-	clsPtr->thisPtr = useThisObj;
-    }
-
-    /*
-     * Configure the namespace path for the class's object.
-     */
 
     if (fPtr->helpersNs != NULL) {
 	Tcl_Namespace *path[2];
@@ -1561,13 +1521,26 @@ AllocClass(
 	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
 		&fPtr->ooNs);
     }
+}
+
+static Class *
+AllocClass(
+    Tcl_Interp *interp,		/* Interpreter within which to allocate the
+				 * class. */
+    Object *useThisObj)		/* Object that is to act as the class
+				 * representation. */
+{
+    Foundation *fPtr = GetFoundation(interp);
+    Class *clsPtr = ckalloc(sizeof(Class));
+
+    memset(clsPtr, 0, sizeof(Class));
+    clsPtr->thisPtr = useThisObj;
 
     /*
-     * Class objects inherit from the class of classes unless they inherit
-     * from some subclass of it. Enforce this right now.
+     * Configure the namespace path for the class's object.
      */
 
-    clsPtr->thisPtr->selfCls = fPtr->classCls;
+    InitClassPath(interp, clsPtr);
 
     /*
      * Classes are subclasses of oo::object, i.e. the objects they create are
@@ -1577,6 +1550,7 @@ AllocClass(
     clsPtr->superclasses.num = 1;
     clsPtr->superclasses.list = ckalloc(sizeof(Class *));
     clsPtr->superclasses.list[0] = fPtr->objectCls;
+    AddRef(fPtr->objectCls->thisPtr);
 
     /*
      * Finish connecting the class structure to the object structure.
@@ -1589,7 +1563,6 @@ AllocClass(
      * fields.
      */
 
-    clsPtr->refCount = 1;
     Tcl_InitObjHashTable(&clsPtr->classMethods);
     return clsPtr;
 }
@@ -1623,7 +1596,9 @@ Tcl_NewObjectInstance(
     ClientData clientData[4];
 
     oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
-    if (oPtr == NULL) {return NULL;}
+    if (oPtr == NULL) {
+	return NULL;
+    }
 
     /*
      * Run constructors, except when objc < 0, which is a special flag case
@@ -1643,7 +1618,7 @@ Tcl_NewObjectInstance(
 	    contextPtr->skip = skip;
 
 	    /*
-	     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+	     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
 	     */
 
 	    isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
@@ -1659,7 +1634,6 @@ Tcl_NewObjectInstance(
 	    clientData[2] = state;
 	    clientData[3] = &oPtr;
 
-	    AddRef(oPtr);
 	    result = FinalizeAlloc(clientData, interp, result);
 	    if (result != TCL_OK) {
 		return NULL;
@@ -1693,7 +1667,9 @@ TclNRNewObjectInstance(
     Object *oPtr;
 
     oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
-    if (oPtr == NULL) {return TCL_ERROR;}
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
 
     /*
      * Run constructors, except when objc < 0 (a special flag case used for
@@ -1726,7 +1702,6 @@ TclNRNewObjectInstance(
      * Fire off the constructors non-recursively.
      */
 
-    AddRef(oPtr);
     TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
 	    objectPtr);
     TclPushTailcallPoint(interp);
@@ -1745,44 +1720,40 @@ TclNewObjectInstanceCommon(
     Foundation *fPtr = GetFoundation(interp);
     Object *oPtr;
     const char *simpleName = NULL;
-    Namespace *nsPtr = NULL, *dummy,
-	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
+    Namespace *nsPtr = NULL, *dummy;
+    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     int isNew;
 
     if (nameStr) {
-	TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN,
-		&nsPtr, &dummy, &dummy, &simpleName);
+	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
+		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);
 
 	/*
 	 * Disallow creation of an object over an existing command.
 	 */
 
 	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
-	if (isNew) {
-	    /* Just kidding */
-	    Tcl_DeleteHashEntry(hPtr);
-	} else {
+	if (!isNew) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "can't create object \"%s\": command already exists with"
 		    " that name", nameStr));
 	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
 	    return NULL;
 	}
+
+	/*
+	 * We could make a hash entry! Don't actually want to do that here so
+	 * nuke it immediately because we'll create it properly soon.
+	 */
+
+	Tcl_DeleteHashEntry(hPtr);
     }
 
     /*
      * Create the object.
      */
 
-    /*
-     * The command for the object could have the same name as the command
-     * associated with classPtr, so protect the structure from deallocation
-     * here.
-     */
-    AddRef(classPtr);
-
     oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
-    DelRef(classPtr);
     oPtr->selfCls = classPtr;
     TclOOAddToInstances(oPtr, classPtr);
 
@@ -1800,7 +1771,6 @@ TclNewObjectInstanceCommon(
 	 */
 
 	AllocClass(interp, oPtr);
-	oPtr->selfCls = classPtr;
 	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
     } else {
 	oPtr->classPtr = NULL;
@@ -1822,8 +1792,8 @@ FinalizeAlloc(
     Tcl_Object *objectPtr = data[3];
 
     /*
-     * Ensure an error if the object was deleted in the constructor.
-     * Don't want to lose errors by accident. [Bug 2903011]
+     * Ensure an error if the object was deleted in the constructor. Don't
+     * want to lose errors by accident. [Bug 2903011]
      */
 
     if (result != TCL_ERROR && Deleted(oPtr)) {
@@ -1832,7 +1802,6 @@ FinalizeAlloc(
 	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
 	result = TCL_ERROR;
     }
-    TclOODeleteContext(contextPtr);
     if (result != TCL_OK) {
 	Tcl_DiscardInterpState(state);
 
@@ -1846,12 +1815,22 @@ FinalizeAlloc(
 	    (void) TclOOObjectName(interp, oPtr);
 	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 	}
-	DelRef(oPtr);
+
+	/*
+	 * This decrements the refcount of oPtr.
+	 */
+
+	TclOODeleteContext(contextPtr);
 	return TCL_ERROR;
     }
     Tcl_RestoreInterpState(interp, state);
     *objectPtr = (Tcl_Object) oPtr;
-    DelRef(oPtr);
+
+    /*
+     * This decrements the refcount of oPtr.
+     */
+
+    TclOODeleteContext(contextPtr);
     return TCL_OK;
 }
 
@@ -1960,7 +1939,6 @@ Tcl_CopyObjectInstance(
 
     o2Ptr->flags = oPtr->flags & ~(
 	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
-
     /*
      * Copy the object's metadata.
      */
@@ -2972,7 +2950,7 @@ int
 Tcl_ObjectDeleted(
     Tcl_Object object)
 {
-    return Deleted(object) ? 1 : 0;
+    return ((Object *)object)->command == NULL;
 }
 
 Tcl_Object
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index d4e1e34..7da9da0 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -110,7 +110,12 @@ TclOODeleteContext(
     TclOODeleteChain(contextPtr->callPtr);
     if (oPtr != NULL) {
 	TclStackFree(oPtr->fPtr->interp, contextPtr);
-	DelRef(oPtr);
+
+	/*
+	 * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
+	 */
+
+	TclOODecrRefCount(oPtr);
     }
 }
 
@@ -900,6 +905,7 @@ InitCallChain(
  * ----------------------------------------------------------------------
  *
  * IsStillValid --
+ *
  *	Calculates whether the given call chain can be used for executing a
  *	method for the given object. The condition on a chain from a cached
  *	location being reusable is:
@@ -1171,6 +1177,11 @@ TclOOGetCallContext(
   returnContext:
     contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
     contextPtr->oPtr = oPtr;
+
+    /*
+     * Corresponding TclOODecrRefCount() in TclOODeleteContext
+     */
+
     AddRef(oPtr);
     contextPtr->callPtr = callPtr;
     contextPtr->skip = 2;
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index b0bfd9c..c08b350 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -123,6 +123,7 @@ static const struct DeclaredSlot slots[] = {
  * ----------------------------------------------------------------------
  *
  * BumpGlobalEpoch --
+ *
  *	Utility that ensures that call chains that are invalid will get thrown
  *	away at an appropriate time. Note that exactly which epoch gets
  *	advanced will depend on exactly what the class is tangled up in; in
@@ -167,6 +168,7 @@ BumpGlobalEpoch(
  * ----------------------------------------------------------------------
  *
  * RecomputeClassCacheFlag --
+ *
  *	Determine whether the object is prototypical of its class, and hence
  *	able to use the class's method chain cache.
  *
@@ -189,6 +191,7 @@ RecomputeClassCacheFlag(
  * ----------------------------------------------------------------------
  *
  * TclOOObjectSetFilters --
+ *
  *	Install a list of filter method names into an object.
  *
  * ----------------------------------------------------------------------
@@ -247,6 +250,7 @@ TclOOObjectSetFilters(
  * ----------------------------------------------------------------------
  *
  * TclOOClassSetFilters --
+ *
  *	Install a list of filter method names into a class.
  *
  * ----------------------------------------------------------------------
@@ -309,6 +313,7 @@ TclOOClassSetFilters(
  * ----------------------------------------------------------------------
  *
  * TclOOObjectSetMixins --
+ *
  *	Install a list of mixin classes into an object.
  *
  * ----------------------------------------------------------------------
@@ -326,9 +331,7 @@ TclOOObjectSetMixins(
     if (numMixins == 0) {
 	if (oPtr->mixins.num != 0) {
 	    FOREACH(mixinPtr, oPtr->mixins) {
-		if (mixinPtr) {
-		    TclOORemoveFromInstances(oPtr, mixinPtr);
-		}
+		TclOORemoveFromInstances(oPtr, mixinPtr);
 	    }
 	    ckfree(oPtr->mixins.list);
 	    oPtr->mixins.num = 0;
@@ -352,6 +355,13 @@ TclOOObjectSetMixins(
 	FOREACH(mixinPtr, oPtr->mixins) {
 	    if (mixinPtr != oPtr->selfCls) {
 		TclOOAddToInstances(oPtr, mixinPtr);
+
+		/*
+		 * Corresponding TclOODecrRefCount() is in the caller of this
+		 * function. 
+		 */
+
+		TclOODecrRefCount(mixinPtr->thisPtr);
 	    }
 	}
     }
@@ -362,6 +372,7 @@ TclOOObjectSetMixins(
  * ----------------------------------------------------------------------
  *
  * TclOOClassSetMixins --
+ *
  *	Install a list of mixin classes into a class.
  *
  * ----------------------------------------------------------------------
@@ -399,6 +410,13 @@ TclOOClassSetMixins(
 	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
 	FOREACH(mixinPtr, classPtr->mixins) {
 	    TclOOAddToMixinSubs(classPtr, mixinPtr);
+
+	    /*
+	     * Corresponding TclOODecrRefCount() is in the caller of this
+	     * function.
+	     */
+
+	    TclOODecrRefCount(mixinPtr->thisPtr);
 	}
     }
     BumpGlobalEpoch(interp, classPtr);
@@ -408,6 +426,7 @@ TclOOClassSetMixins(
  * ----------------------------------------------------------------------
  *
  * RenameDeleteMethod --
+ *
  *	Core of the code to rename and delete methods.
  *
  * ----------------------------------------------------------------------
@@ -497,6 +516,7 @@ RenameDeleteMethod(
  * ----------------------------------------------------------------------
  *
  * TclOOUnknownDefinition --
+ *
  *	Handles what happens when an unknown command is encountered during the
  *	processing of a definition script. Works by finding a command in the
  *	operating definition namespace that the requested command is a unique
@@ -575,6 +595,7 @@ TclOOUnknownDefinition(
  * ----------------------------------------------------------------------
  *
  * FindCommand --
+ *
  *	Specialized version of Tcl_FindCommand that handles command prefixes
  *	and disallows namespace magic.
  *
@@ -635,6 +656,7 @@ FindCommand(
  * ----------------------------------------------------------------------
  *
  * InitDefineContext --
+ *
  *	Does the magic incantations necessary to push the special stack frame
  *	used when processing object definitions. It is up to the caller to
  *	dispose of the frame (with TclPopStackFrame) when finished.
@@ -660,7 +682,9 @@ InitDefineContext(
 	return TCL_ERROR;
     }
 
-    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+    /*
+     * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
+     */
 
     (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
 	    namespacePtr, FRAME_IS_OO_DEFINE);
@@ -675,6 +699,7 @@ InitDefineContext(
  * ----------------------------------------------------------------------
  *
  * TclOOGetDefineCmdContext --
+ *
  *	Extracts the magic token from the current stack frame, or returns NULL
  *	(and leaves an error message) otherwise.
  *
@@ -711,6 +736,7 @@ TclOOGetDefineCmdContext(
  * ----------------------------------------------------------------------
  *
  * GetClassInOuterContext --
+ *
  *	Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
  *	context that called oo::define (or equivalent). Note that this may
  *	have to go up multiple levels to get the level that we started doing
@@ -753,6 +779,7 @@ GetClassInOuterContext(
  * ----------------------------------------------------------------------
  *
  * GenerateErrorInfo --
+ *
  *	Factored out code to generate part of the error trace messages.
  *
  * ----------------------------------------------------------------------
@@ -791,6 +818,7 @@ GenerateErrorInfo(
  * ----------------------------------------------------------------------
  *
  * MagicDefinitionInvoke --
+ *
  *	Part of the implementation of the "oo::define" and "oo::objdefine"
  *	commands that is used to implement the more-than-one-argument case,
  *	applying ensemble-like tricks with dispatch so that error messages are
@@ -854,6 +882,7 @@ MagicDefinitionInvoke(
  * ----------------------------------------------------------------------
  *
  * TclOODefineObjCmd --
+ *
  *	Implementation of the "oo::define" command. Works by effectively doing
  *	the same as 'namespace eval', but with extra magic applied so that the
  *	object to be modified is known to the commands in the target
@@ -914,7 +943,7 @@ TclOODefineObjCmd(
     } else {
 	result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
     }
-    DelRef(oPtr);
+    TclOODecrRefCount(oPtr);
 
     /*
      * Restore the previous "current" namespace.
@@ -928,6 +957,7 @@ TclOODefineObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOOObjDefObjCmd --
+ *
  *	Implementation of the "oo::objdefine" command. Works by effectively
  *	doing the same as 'namespace eval', but with extra magic applied so
  *	that the object to be modified is known to the commands in the target
@@ -981,7 +1011,7 @@ TclOOObjDefObjCmd(
     } else {
 	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
     }
-    DelRef(oPtr);
+    TclOODecrRefCount(oPtr);
 
     /*
      * Restore the previous "current" namespace.
@@ -995,6 +1025,7 @@ TclOOObjDefObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineSelfObjCmd --
+ *
  *	Implementation of the "self" subcommand of the "oo::define" command.
  *	Works by effectively doing the same as 'namespace eval', but with
  *	extra magic applied so that the object to be modified is known to the
@@ -1048,7 +1079,7 @@ TclOODefineSelfObjCmd(
     } else {
 	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
     }
-    DelRef(oPtr);
+    TclOODecrRefCount(oPtr);
 
     /*
      * Restore the previous "current" namespace.
@@ -1062,6 +1093,7 @@ TclOODefineSelfObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineObjSelfObjCmd --
+ *
  *	Implementation of the "self" subcommand of the "oo::objdefine"
  *	command.
  *
@@ -1095,6 +1127,7 @@ TclOODefineObjSelfObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineClassObjCmd --
+ *
  *	Implementation of the "class" subcommand of the "oo::objdefine"
  *	command.
  *
@@ -1168,11 +1201,14 @@ TclOODefineClassObjCmd(
 
     if (oPtr->selfCls != clsPtr) {
 	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+
+	/*
+	 * Reference count already incremented a few lines up.
+	 */
+
 	oPtr->selfCls = clsPtr;
+
 	TclOOAddToInstances(oPtr, oPtr->selfCls);
-	if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
-	    oPtr->flags &= ~CLASS_GONE;
-	}
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {
@@ -1186,6 +1222,7 @@ TclOODefineClassObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineConstructorObjCmd --
+ *
  *	Implementation of the "constructor" subcommand of the "oo::define"
  *	command.
  *
@@ -1254,6 +1291,7 @@ TclOODefineConstructorObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineDeleteMethodObjCmd --
+ *
  *	Implementation of the "deletemethod" subcommand of the "oo::define"
  *	and "oo::objdefine" commands.
  *
@@ -1310,6 +1348,7 @@ TclOODefineDeleteMethodObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineDestructorObjCmd --
+ *
  *	Implementation of the "destructor" subcommand of the "oo::define"
  *	command.
  *
@@ -1374,6 +1413,7 @@ TclOODefineDestructorObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineExportObjCmd --
+ *
  *	Implementation of the "export" subcommand of the "oo::define" and
  *	"oo::objdefine" commands.
  *
@@ -1468,6 +1508,7 @@ TclOODefineExportObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineForwardObjCmd --
+ *
  *	Implementation of the "forward" subcommand of the "oo::define" and
  *	"oo::objdefine" commands.
  *
@@ -1528,6 +1569,7 @@ TclOODefineForwardObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineMethodObjCmd --
+ *
  *	Implementation of the "method" subcommand of the "oo::define" and
  *	"oo::objdefine" commands.
  *
@@ -1585,6 +1627,7 @@ TclOODefineMethodObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineMixinObjCmd --
+ *
  *	Implementation of the "mixin" subcommand of the "oo::define" and
  *	"oo::objdefine" commands.
  *
@@ -1628,6 +1671,13 @@ TclOODefineMixinObjCmd(
 	    goto freeAndError;
 	}
 	mixins[i-1] = clsPtr;
+
+	/*
+	 * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins,
+	 * TclOOClassSetMixinsk, or just below if this function fails.
+	 */
+
+	AddRef(mixins[i-1]->thisPtr);
     }
 
     if (isInstanceMixin) {
@@ -1640,6 +1690,9 @@ TclOODefineMixinObjCmd(
     return TCL_OK;
 
   freeAndError:
+    while (--i > 0) {
+	TclOODecrRefCount(mixins[i]->thisPtr);
+    }
     TclStackFree(interp, mixins);
     return TCL_ERROR;
 }
@@ -1648,6 +1701,7 @@ TclOODefineMixinObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineRenameMethodObjCmd --
+ *
  *	Implementation of the "renamemethod" subcommand of the "oo::define"
  *	and "oo::objdefine" commands.
  *
@@ -1704,6 +1758,7 @@ TclOODefineRenameMethodObjCmd(
  * ----------------------------------------------------------------------
  *
  * TclOODefineUnexportObjCmd --
+ *
  *	Implementation of the "unexport" subcommand of the "oo::define" and
  *	"oo::objdefine" commands.
  *
@@ -1798,6 +1853,7 @@ TclOODefineUnexportObjCmd(
  * ----------------------------------------------------------------------
  *
  * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
+ *
  *	How to install a constructor or destructor into a class; API to call
  *	from C.
  *
@@ -1852,6 +1908,7 @@ Tcl_ClassSetDestructor(
  * ----------------------------------------------------------------------
  *
  * TclOODefineSlots --
+ *
  *	Create the "::oo::Slot" class and its standard instances. Class
  *	definition is empty at the stage (added by scripting).
  *
@@ -1895,6 +1952,7 @@ TclOODefineSlots(
  * ----------------------------------------------------------------------
  *
  * ClassFilterGet, ClassFilterSet --
+ *
  *	Implementation of the "filter" slot accessors of the "oo::define"
  *	command.
  *
@@ -1974,6 +2032,7 @@ ClassFilterSet(
  * ----------------------------------------------------------------------
  *
  * ClassMixinGet, ClassMixinSet --
+ *
  *	Implementation of the "mixin" slot accessors of the "oo::define"
  *	command.
  *
@@ -2055,6 +2114,7 @@ ClassMixinSet(
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
+	    i--;
 	    goto freeAndError;
 	}
 	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
@@ -2063,6 +2123,13 @@ ClassMixinSet(
 	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
 	    goto freeAndError;
 	}
+
+	/*
+	 * Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or
+	 * just below if this function fails.
+	 */
+
+	AddRef(mixins[i]->thisPtr);
     }
 
     TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
@@ -2070,6 +2137,9 @@ ClassMixinSet(
     return TCL_OK;
 
   freeAndError:
+    while (i-- > 0) {
+	TclOODecrRefCount(mixins[i]->thisPtr);
+    }
     TclStackFree(interp, mixins);
     return TCL_ERROR;
 }
@@ -2078,6 +2148,7 @@ ClassMixinSet(
  * ----------------------------------------------------------------------
  *
  * ClassSuperGet, ClassSuperSet --
+ *
  *	Implementation of the "superclass" slot accessors of the "oo::define"
  *	command.
  *
@@ -2172,16 +2243,24 @@ ClassSuperSet(
 
     if (superc == 0) {
 	superclasses = ckrealloc(superclasses, sizeof(Class *));
-	superclasses[0] = oPtr->fPtr->objectCls;
-	superc = 1;
 	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
 	    superclasses[0] = oPtr->fPtr->classCls;
+	} else {
+	    superclasses[0] = oPtr->fPtr->objectCls;
 	}
+	superc = 1;
+
+	/*
+	 * Corresponding TclOODecrRefCount is near the end of this function.
+	 */
+
+	AddRef(superclasses[0]->thisPtr);
     } else {
 	for (i=0 ; i<superc ; i++) {
 	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
 		    "only a class can be a superclass");
 	    if (superclasses[i] == NULL) {
+		i--;
 		goto failedAfterAlloc;
 	    }
 	    for (j=0 ; j<i ; j++) {
@@ -2198,9 +2277,19 @@ ClassSuperSet(
 			"attempt to form circular dependency graph", -1));
 		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
 	    failedAfterAlloc:
+		for (; i > 0; i--) {
+		    TclOODecrRefCount(superclasses[i]->thisPtr);
+		}
 		ckfree(superclasses);
 		return TCL_ERROR;
 	    }
+
+	    /*
+	     * Corresponding TclOODecrRefCount() is near the end of this
+	     * function.
+	     */
+
+	    AddRef(superclasses[i]->thisPtr);
 	}
     }
 
@@ -2221,6 +2310,12 @@ ClassSuperSet(
     oPtr->classPtr->superclasses.num = superc;
     FOREACH(superPtr, oPtr->classPtr->superclasses) {
 	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
+
+	/*
+	 * To account for the AddRef() earlier in this function.
+	 */
+
+	TclOODecrRefCount(superPtr->thisPtr);
     }
     BumpGlobalEpoch(interp, oPtr->classPtr);
 
@@ -2231,6 +2326,7 @@ ClassSuperSet(
  * ----------------------------------------------------------------------
  *
  * ClassVarsGet, ClassVarsSet --
+ *
  *	Implementation of the "variable" slot accessors of the "oo::define"
  *	command.
  *
@@ -2373,6 +2469,7 @@ ClassVarsSet(
  * ----------------------------------------------------------------------
  *
  * ObjectFilterGet, ObjectFilterSet --
+ *
  *	Implementation of the "filter" slot accessors of the "oo::objdefine"
  *	command.
  *
@@ -2440,6 +2537,7 @@ ObjFilterSet(
  * ----------------------------------------------------------------------
  *
  * ObjectMixinGet, ObjectMixinSet --
+ *
  *	Implementation of the "mixin" slot accessors of the "oo::objdefine"
  *	command.
  *
@@ -2511,9 +2609,19 @@ ObjMixinSet(
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
+	    while (i-- > 0) {
+		TclOODecrRefCount(mixins[i]->thisPtr);
+	    }
 	    TclStackFree(interp, mixins);
 	    return TCL_ERROR;
 	}
+
+	/*
+	 * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or
+	 * just above if this function fails.
+	 */
+
+	AddRef(mixins[i]->thisPtr);
     }
 
     TclOOObjectSetMixins(oPtr, mixinc, mixins);
@@ -2525,6 +2633,7 @@ ObjMixinSet(
  * ----------------------------------------------------------------------
  *
  * ObjectVarsGet, ObjectVarsSet --
+ *
  *	Implementation of the "variable" slot accessors of the "oo::objdefine"
  *	command.
  *
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 83b4d58..084c026 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -193,9 +193,10 @@ typedef struct Object {
 				 * destroyed. */
 #define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
 				 * called. */
-#define CLASS_GONE	4	/* Indicates that the class of this object has
-				 * been deleted, and so the object should not
-				 * attempt to remove itself from its class. */
+#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this
+				 * object has been deleted, and so the object
+				 * should not attempt to remove itself from its
+				 * class. */
 #define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
 				 * specially during teardown. */
@@ -222,10 +223,6 @@ typedef struct Object {
 typedef struct Class {
     Object *thisPtr;		/* Reference to the object associated with
 				 * this class. */
-    int refCount;		/* Number of strong references to this class.
-				 * Weak references are not counted; the
-				 * purpose of this is to avoid Tcl_Preserve as
-				 * that is quite slow. */
     int flags;			/* Assorted flags. */
     LIST_STATIC(struct Class *) superclasses;
 				/* List of superclasses, used for generation
@@ -499,6 +496,7 @@ MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
 			    Class *classPtr,
 			    const char *nameStr,
 			    const char *nsNameStr);
+MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
 MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
 MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
 MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
@@ -528,10 +526,10 @@ MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
 MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
 			    const DeclaredClassMethod *dcm);
 MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
-MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
-MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
+MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
 			    Class *mixinPtr);
-MODULE_SCOPE void	TclOORemoveFromSubclasses(Class *subPtr,
+MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
 			    Class *superPtr);
 MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
 			    CallChain *callPtr);
@@ -546,18 +544,21 @@ MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
 #include "tclOOIntDecls.h"
 
 /*
+ * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
+ */
+
+#define AddRef(ptr) ((ptr)->refCount++)
+
+/*
  * A convenience macro for iterating through the lists used in the internal
- * memory management of objects. This is a bit gnarly because we want to do
- * the assignment of the picked-out value only when the body test succeeds,
- * but we cannot rely on the assigned value being useful, forcing us to do
- * some nasty stuff with the comma operator. The compiler's optimizer should
- * be able to sort it all out!
- *
+ * memory management of objects.
  * REQUIRES DECLARATION: int i;
  */
 
 #define FOREACH(var,ary) \
-	for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
+    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
+	continue; \
+    } else if (var = (ary).list[i], 1) 
 
 /*
  * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
@@ -592,17 +593,6 @@ MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
 	} \
     } while(0)
 
-/*
- * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
- */
-
-#define AddRef(ptr) ((ptr)->refCount++)
-#define DelRef(ptr) do {			\
-	if ((ptr)->refCount-- <= 1) {		\
-	    ckfree(ptr);			\
-	}					\
-    } while(0)
-
 #endif /* TCL_OO_INTERNAL_H */
 
 /*
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 20d0db9..d4f4d72 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -948,6 +948,7 @@ Tcl_PackageObjCmd(
 		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
 		if (availPtr->pkgIndex) {
 		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+		    availPtr->pkgIndex = NULL;
 		}
 		ckfree(availPtr);
 	    }
@@ -1001,6 +1002,7 @@ Tcl_PackageObjCmd(
 		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
 		if (availPtr->pkgIndex) {
 		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+		    availPtr->pkgIndex = NULL;
 		}
 		break;
 	    }
@@ -1012,7 +1014,7 @@ Tcl_PackageObjCmd(
 	}
 	if (availPtr == NULL) {
 	    availPtr = ckalloc(sizeof(PkgAvail));
-	    availPtr->pkgIndex = 0;
+	    availPtr->pkgIndex = NULL;
 	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);
 
 	    if (prevPtr == NULL) {
@@ -1384,6 +1386,7 @@ TclFreePackageInfo(
 	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
 	    if (availPtr->pkgIndex) {
 		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+		availPtr->pkgIndex = NULL;
 	    }
 	    ckfree(availPtr);
 	}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 1267c75..b492b21 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -52,11 +52,11 @@
 #   define TclpIsAtty TclPlatIsAtty
 #   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
 #   define TclWinFlushDirtyChannels doNothing
-#   define TclWinResetInterfaces doNothing
 
-#if TCL_UTF_MAX < 4
-static Tcl_Encoding winTCharEncoding;
-#endif
+static void
+doNothing(void)
+{
+}
 
 static int
 TclpIsAtty(int fd)
@@ -92,19 +92,12 @@ TclpGetPid(Tcl_Pid pid)
     return (int) (size_t) pid;
 }
 
-static void
-doNothing(void)
-{
-    /* dummy implementation, no need to do anything */
-}
-
 char *
 Tcl_WinUtfToTChar(
     const char *string,
     int len,
     Tcl_DString *dsPtr)
 {
-#if TCL_UTF_MAX > 3
     WCHAR *wp;
     int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
 
@@ -116,13 +109,6 @@ Tcl_WinUtfToTChar(
     Tcl_DStringSetLength(dsPtr, 2*size);
     wp[size] = 0;
     return (char *)wp;
-#else
-    if (!winTCharEncoding) {
-	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
-    }
-    return Tcl_UtfToExternalDString(winTCharEncoding,
-	    string, len, dsPtr);
-#endif
 }
 
 char *
@@ -131,7 +117,6 @@ Tcl_WinTCharToUtf(
     int len,
     Tcl_DString *dsPtr)
 {
-#if TCL_UTF_MAX > 3
     char *p;
     int size;
 
@@ -147,13 +132,6 @@ Tcl_WinTCharToUtf(
     Tcl_DStringSetLength(dsPtr, size);
     p[size] = 0;
     return p;
-#else
-    if (!winTCharEncoding) {
-	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
-    }
-    return Tcl_ExternalToUtfDString(winTCharEncoding,
-	    string, len, dsPtr);
-#endif
 }
 
 #if defined(TCL_WIDE_INT_IS_LONG)
@@ -627,7 +605,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
     0, /* 25 */
     0, /* 26 */
     TclWinFlushDirtyChannels, /* 27 */
-    TclWinResetInterfaces, /* 28 */
+    0, /* 28 */
     TclWinCPUID, /* 29 */
     TclUnixOpenTemporaryFile, /* 30 */
 #endif /* WIN */
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 43636b4..2d8750d 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -68,11 +68,7 @@ static const unsigned char totalBytes[256] = {
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
     2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
     3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-#if TCL_UTF_MAX > 3
     4,4,4,4,4,4,4,4,
-#else
-    1,1,1,1,1,1,1,1,
-#endif
     1,1,1,1,1,1,1,1
 };
 
@@ -328,13 +324,22 @@ Tcl_UtfToUniChar(
 	 * represents itself.
 	 */
     }
-#if TCL_UTF_MAX > 3
     else if (byte < 0xF8) {
 	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
 	    /*
 	     * Four-byte-character lead byte followed by three trail bytes.
 	     */
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX == 3
+	    byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
+		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
+	    if (byte & 0x100000) {
+		/* out of range, < 0x10000 or > 0x10ffff */
+	    } else {
+		/* produce replacement character, and advance source pointer */
+		*chPtr = (Tcl_UniChar) 0xFFFD;
+		return 4;
+	    }
+#elif TCL_UTF_MAX == 4
 	    Tcl_UniChar surrogate;
 
 	    byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
@@ -365,7 +370,6 @@ Tcl_UtfToUniChar(
 	 * represents itself.
 	 */
     }
-#endif
 
     *chPtr = (Tcl_UniChar) byte;
     return 1;
@@ -499,13 +503,13 @@ Tcl_NumUtfChars(
 	}
 	if (i < 0) i = INT_MAX; /* Bug [2738427] */
     } else {
-	register const char *endPtr = src + length - TCL_UTF_MAX;
+	register const char *endPtr = src + length - 4;
 
 	while (src < endPtr) {
 	    src += TclUtfToUniChar(src, &ch);
 	    i++;
 	}
-	endPtr += TCL_UTF_MAX;
+	endPtr += 4;
 	while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
 	    src += TclUtfToUniChar(src, &ch);
 	    i++;
@@ -677,7 +681,7 @@ Tcl_UtfPrev(
     int i, byte;
 
     look = --src;
-    for (i = 0; i < TCL_UTF_MAX; i++) {
+    for (i = 0; i < 4; i++) {
 	if (look < start) {
 	    if (src < start) {
 		src = start;
diff --git a/tests/oo.test b/tests/oo.test
index a8257fd..3be5f79 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -47,7 +47,7 @@ test oo-0.2 {basic test of OO's ability to clean up its initial state} {
 } {}
 test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
     leaktest {
-	[oo::object new] destroy
+        [oo::object new] destroy
     }
 } -constraints memory -result 0
 test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
@@ -1518,9 +1518,9 @@ test oo-11.6 {
 
     # No segmentation fault
     return done
-} -cleanup {
+} -result done -cleanup {
     rename obj1 {}
-} -result done
+}
 
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
@@ -3895,9 +3895,6 @@ test oo-35.6 {
     rename obj {}
 } -result done
 
-
-
-
 test oo-36.1 {TIP #470: introspection within oo::define} {
     oo::define oo::object self
 } ::oo::object
diff --git a/tests/safe.test b/tests/safe.test
index 33ee166..df60de6 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -180,17 +180,17 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
 # leaking infos, but they still do...
 
 # high level general test
-test safe-7.1 {tests that everything works at high level} {
+test safe-7.1 {tests that everything works at high level} -body {
     set i [safe::interpCreate]
     # no error shall occur:
     # (because the default access_path shall include 1st level sub dirs so
     #  package require in a slave works like in the master)
-    set v [interp eval $i {package require http 1}]
+    set v [interp eval $i {package require http 2}]
     # no error shall occur:
-    interp eval $i {http_config}
+    interp eval $i {http::config}
     safe::interpDelete $i
     set v
-} 1.0
+} -match glob -result 2.*
 test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
     set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
     # should not add anything (p0)
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 9d46df9..b213538 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -577,12 +577,6 @@ TclpSetInitialEncodings(void)
     Tcl_DStringFree(&encodingName);
 }
 
-void
-TclpSetInterfaces(void)
-{
-    /* do nothing */
-}
-
 static const char *
 SearchKnownEncodings(
     const char *encoding)
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index da1cdfe..599c126 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -32,10 +32,6 @@ static HINSTANCE hInstance;	/* HINSTANCE of this DLL. */
 #define cpuid	__asm __emit 0fh __asm __emit 0a2h
 #endif
 
-#if TCL_UTF_MAX < 4
-static Tcl_Encoding winTCharEncoding = NULL;
-#endif
-
 /*
  * The following declaration is for the VC++ DLL entry point.
  */
@@ -196,8 +192,6 @@ TclWinInit(
     if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) {
 	Tcl_Panic("Windows NT is the only supported platform");
     }
-
-    TclWinResetInterfaces();
 }
 
 /*
@@ -234,38 +228,10 @@ TclWinNoBackslash(
 /*
  *---------------------------------------------------------------------------
  *
- * TclpSetInterfaces --
- *
- *	A helper proc.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpSetInterfaces(void)
-{
-#if TCL_UTF_MAX < 4
-    TclWinResetInterfaces();
-    winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
-#endif
-}
-
-/*
- *---------------------------------------------------------------------------
- *
  * TclWinEncodingsCleanup --
  *
- *	Called during finalization to free up any encodings we use.
- *
- *	We also clean up any memory allocated in our mount point map which is
- *	used to follow certain kinds of symlinks. That code should never be
- *	used once encodings are taken down.
+ *	Called during finalization to clean up any memory allocated in our
+ *	mount point map which is used to follow certain kinds of symlinks.
  *
  * Results:
  *	None.
@@ -281,8 +247,6 @@ TclWinEncodingsCleanup(void)
 {
     MountPointMap *dlIter, *dlIter2;
 
-    TclWinResetInterfaces();
-
     /*
      * Clean up the mount point map.
      */
@@ -299,32 +263,6 @@ TclWinEncodingsCleanup(void)
 }
 
 /*
- *---------------------------------------------------------------------------
- *
- * TclWinResetInterfaces --
- *
- *	Called during finalization to reset us to a safe state for reuse.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-void
-TclWinResetInterfaces(void)
-{
-#if TCL_UTF_MAX < 4
-    if (winTCharEncoding != NULL) {
-	Tcl_FreeEncoding(winTCharEncoding);
-	winTCharEncoding = NULL;
-    }
-#endif
-}
-
-/*
  *--------------------------------------------------------------------
  *
  * TclWinDriveLetterForVolMountPoint
@@ -533,7 +471,6 @@ Tcl_WinUtfToTChar(
     Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
 				 * converted string is stored. */
 {
-#if TCL_UTF_MAX > 3
     TCHAR *wp;
     int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
 
@@ -545,10 +482,6 @@ Tcl_WinUtfToTChar(
     Tcl_DStringSetLength(dsPtr, 2*size);
     wp[size] = 0;
     return wp;
-#else
-    return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
-	    string, len, dsPtr);
-#endif
 }
 
 char *
@@ -559,7 +492,6 @@ Tcl_WinTCharToUtf(
     Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
 				 * converted string is stored. */
 {
-#if TCL_UTF_MAX > 3
     char *p;
     int size;
 
@@ -575,10 +507,6 @@ Tcl_WinTCharToUtf(
     Tcl_DStringSetLength(dsPtr, size);
     p[size] = 0;
     return p;
-#else
-    return Tcl_ExternalToUtfDString(winTCharEncoding,
-	    (const char *) string, len, dsPtr);
-#endif
 }
 
 /*
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 4be8f1f..02fa674 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -487,7 +487,6 @@ TclpSetInitialEncodings(void)
 {
     Tcl_DString encodingName;
 
-    TclpSetInterfaces();
     Tcl_SetSystemEncoding(NULL,
 	    Tcl_GetEncodingNameFromEnvironment(&encodingName));
     Tcl_DStringFree(&encodingName);