* generic/tclCompile.c (TclCleanupByteCode): When encountering a

	  shared bytecode structure we have to scan the literal table in
	  that structure for objects of type "cmdName". These objects hold
	  references to command structures, possibly in a different
	  interp, and interfere with the cleanup of the refered commands
	  (they keep their refcount up). Essentially at least one interp
	  in a set of clones has a circular reference comand -> proc ->
	  bytecode -> bytecode data -> cmdName obj -> command which
	  prevents the command int that interp from being freed, leaking
	  memory.

	  The solution employed here is to invalidate the internal
	  representation of 'cmdName's (but keeping the string rep),
	  driving the refcount of refered command structures down,
	  and breaking the cycle.

5 files changed, 57 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index e2d0cf4..8a1e3aa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+2002-12-05  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclCompile.c (TclCleanupByteCode): When encountering a
+	  shared bytecode structure we have to scan the literal table in
+	  that structure for objects of type "cmdName". These objects hold
+	  references to command structures, possibly in a different
+	  interp, and interfere with the cleanup of the refered commands
+	  (they keep their refcount up). Essentially at least one interp
+	  in a set of clones has a circular reference comand -> proc ->
+	  bytecode -> bytecode data -> cmdName obj -> command which
+	  prevents the command int that interp from being freed, leaking
+	  memory.
+
+	  The solution employed here is to invalidate the internal
+	  representation of 'cmdName's (but keeping the string rep),
+	  driving the refcount of refered command structures down,
+	  and breaking the cycle.
+
 2002-12-05  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* generic/tclTest.c (TestCloneObjCmd): objify testclone command.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0c20f91..2ae53c4 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.20.2.1.2.6 2002/11/26 19:48:50 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.20.2.1.2.7 2002/12/06 03:08:18 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -550,6 +550,30 @@ TclCleanupByteCode(codePtr)
 #endif /* TCL_COMPILE_STATS */
 
     bcDataPtr->refCount --;
+
+    if (bcDataPtr->refCount > 0) {
+        /*
+	 * To ensure proper cleanup of cloned Commands we scan the
+	 * shared bytecode for CmdName objects and invalidate their
+	 * internal representation.
+	 */
+
+        int numLitObjects = bcDataPtr->numLitObjects;
+	register Tcl_Obj **objArrayPtr;
+	int i;
+
+	objArrayPtr = bcDataPtr->objArrayPtr;
+	for (i = 0;  i < numLitObjects;  i++) {
+	    if (*objArrayPtr != NULL) {
+	        if ((*objArrayPtr)->typePtr == &tclCmdNameType) {
+		    Tcl_GetString ((*objArrayPtr));
+		    TclFreeCmdNameInternalRep ((*objArrayPtr));
+		    (*objArrayPtr)->typePtr = NULL;
+		}
+	    }
+	    objArrayPtr++;
+	}
+    }
     if (bcDataPtr->refCount <= 0) {
         int numLitObjects = bcDataPtr->numLitObjects;
 	int numAuxDataItems = bcDataPtr->numAuxDataItems;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 603254d..aa60377 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.10.2.2.2.7 2002/11/26 19:48:53 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.10.2.2.2.8 2002/12/06 03:08:18 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -247,8 +247,6 @@ static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
                             Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
 #endif
-static void		FreeCmdNameInternalRep _ANSI_ARGS_((
-    			    Tcl_Obj *objPtr));
 #ifdef TCL_COMPILE_DEBUG
 static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
 #endif
@@ -344,7 +342,7 @@ BuiltinFunc builtinFuncTable[] = {
 
 Tcl_ObjType tclCmdNameType = {
     "cmdName",				/* name */
-    FreeCmdNameInternalRep,		/* freeIntRepProc */
+    TclFreeCmdNameInternalRep,		/* freeIntRepProc */
     DupCmdNameInternalRep,		/* dupIntRepProc */
     (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
     SetCmdNameFromAny			/* setFromAnyProc */
@@ -5446,6 +5444,7 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
     }
     
     cmdPtr->refCount++;
+
     resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
     resPtr->cmdPtr = cmdPtr;
     resPtr->refNsPtr = currNsPtr;
@@ -5465,7 +5464,7 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
 /*
  *----------------------------------------------------------------------
  *
- * FreeCmdNameInternalRep --
+ * TclFreeCmdNameInternalRep --
  *
  *	Frees the resources associated with a cmdName object's internal
  *	representation.
@@ -5483,8 +5482,8 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
  *----------------------------------------------------------------------
  */
 
-static void
-FreeCmdNameInternalRep(objPtr)
+void
+TclFreeCmdNameInternalRep(objPtr)
     register Tcl_Obj *objPtr;	/* CmdName object with internal
 				 * representation to free. */
 {
@@ -5506,6 +5505,7 @@ FreeCmdNameInternalRep(objPtr)
 	     */
 	    
             Command *cmdPtr = resPtr->cmdPtr;
+
             TclCleanupCommand(cmdPtr);
             ckfree((char *) resPtr);
         }
@@ -5613,6 +5613,7 @@ SetCmdNameFromAny(interp, objPtr)
 	}
 	
 	cmdPtr->refCount++;
+
         resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
         resPtr->cmdPtr        = cmdPtr;
         resPtr->refNsPtr      = currNsPtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index eec1821..5941222 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.42.2.3.2.6 2002/11/26 19:48:56 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.42.2.3.2.7 2002/12/06 03:08:19 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1862,6 +1862,9 @@ EXTERN int		TclInvokeImportedCmd _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
 
+EXTERN void		TclFreeCmdNameInternalRep _ANSI_ARGS_((
+			    Tcl_Obj *objPtr));
+
 /*
  *----------------------------------------------------------------
  * Command procedures in the generic core:
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 6a4c67e..077c8bb 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclAppInit.c,v 1.9.20.1 2002/11/26 20:05:51 hobbs Exp $
+ * RCS: @(#) $Id: tclAppInit.c,v 1.9.20.2 2002/12/06 03:08:19 andreas_kupries Exp $
  */
 
 #include "tcl.h"
@@ -97,6 +97,7 @@ main(argc, argv)
 #endif
 
     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
 #ifdef PURIFY
     /*
      * This isn't necessary - we are about to exit, but it assists in