Modified the logic of literal table cleanup at interp deletion time,

insuring that the fix of [Bug 983660] does not have a negative perf
impact.

3 files changed, 45 insertions, 32 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index aec8a18..042e22b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.107 2004/07/05 22:41:01 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.108 2004/07/08 18:46:04 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -997,12 +997,13 @@ DeleteInterpProc(interp)
      * Dismantle the namespace here, before we clear the assocData. If any
      * background errors occur here, they will be deleted below.
      *
-     * Dismantle the namespace before freeing the iPtr->handle, to insure
-     * that non-shared literals are freed properly [Bug 983660].
+     * Dismantle the namespace after freeing the iPtr->handle so that each
+     * bytecode releases its literals without caring to update the literal
+     * table, as it will be freed later in this function without further use.
      */
     
-    TclTeardownNamespace(iPtr->globalNsPtr);
     TclHandleFree(iPtr->handle);
+    TclTeardownNamespace(iPtr->globalNsPtr);
 
     /*
      * Delete all the hidden commands.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 225b9cd..5376123 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.69 2004/07/07 22:05:59 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.70 2004/07/08 18:46:05 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -590,7 +590,7 @@ TclCleanupByteCode(codePtr)
     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
     int numLitObjects = codePtr->numLitObjects;
     int numAuxDataItems = codePtr->numAuxDataItems;
-    register Tcl_Obj **objArrayPtr;
+    register Tcl_Obj **objArrayPtr, *objPtr;
     register AuxData *auxDataPtr;
     int i;
 #ifdef TCL_COMPILE_STATS
@@ -642,10 +642,17 @@ TclCleanupByteCode(codePtr)
      * like those generated from tbcload) is special, as they doesn't
      * make use of the global literal table.  They instead maintain
      * private references to their literals which must be decremented.
+     *
+     * In order to insure a proper and efficient cleanup of the literal
+     * array when it contains non-shared literals [Bug 983660], we also
+     * distinguish the case of an interpreter being deleted (signaled by
+     * interp == NULL). Also, as the interp deletion will remove the global
+     * literal table anyway, we avoid the extra cost of updating it for each
+     * literal being released.
      */
 
-    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-	register Tcl_Obj *objPtr;
+    if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+	    || (interp == NULL)) {
  
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
@@ -656,13 +663,7 @@ TclCleanupByteCode(codePtr)
 	    objArrayPtr++;
 	}
 	codePtr->numLitObjects = 0;
-    } else if (interp != NULL) {
-	/*
-	 * If the interp has already been freed, then Tcl will have already 
-	 * forcefully released all the literals used by ByteCodes compiled
-	 * with respect to that interp.
-	 */
-	 
+    } else {
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
 	    /*
@@ -670,8 +671,9 @@ TclCleanupByteCode(codePtr)
 	     * indicate that it has already freed the literal.
 	     */
 	    
-	    if (*objArrayPtr != NULL) {
-		TclReleaseLiteral(interp, *objArrayPtr);
+	    objPtr = *objArrayPtr;
+	    if (objPtr != NULL) {
+		TclReleaseLiteral(interp, objPtr);
 	    }
 	    objArrayPtr++;
 	}
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 2dfe37f..19042fd 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.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: tclLiteral.c,v 1.15 2004/07/05 22:41:02 msofer Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.16 2004/07/08 18:46:06 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -81,7 +81,8 @@ TclInitLiteralTable(tablePtr)
  * TclDeleteLiteralTable --
  *
  *	This procedure frees up everything associated with a literal table
- *	except for the table's structure itself.
+ *	except for the table's structure itself. It is called when the
+ *	interpreter is deleted.
  *
  * Results:
  *	None.
@@ -101,9 +102,10 @@ TclDeleteLiteralTable(interp, tablePtr)
 				 * referenced by the table to delete. */
     LiteralTable *tablePtr;	/* Points to the literal table to delete. */
 {
-    LiteralEntry *entryPtr;
-    int i, start;
-
+    LiteralEntry *entryPtr, *nextPtr;
+    Tcl_Obj *objPtr;
+    int i;
+    
     /*
      * Release remaining literals in the table. Note that releasing a
      * literal might release other literals, modifying the table, so we
@@ -114,18 +116,26 @@ TclDeleteLiteralTable(interp, tablePtr)
     TclVerifyGlobalLiteralTable((Interp *) interp);
 #endif /*TCL_COMPILE_DEBUG*/
 
-    start = 0;
-    while (tablePtr->numEntries > 0) {
-	for (i = start;  i < tablePtr->numBuckets;  i++) {
-	    entryPtr = tablePtr->buckets[i];
-	    if (entryPtr != NULL) {
-		TclReleaseLiteral(interp, entryPtr->objPtr);
-		start = i;
-		break;
-	    }
+    /*
+     * We used to call TclReleaseLiteral for each literal in the table, which
+     * is rather inefficient as it causes one lookup-by-hash for each
+     * reference to the literal.
+     * We now rely at interp-deletion on each bytecode object to release its
+     * references to the literal Tcl_Obj without requiring that it updates the
+     * global table itself, and deal here only with the table.
+     */
+
+    for (i = 0;  i < tablePtr->numBuckets;  i++) {
+	entryPtr = tablePtr->buckets[i];
+	while (entryPtr != NULL) {
+	    objPtr = entryPtr->objPtr;
+	    TclDecrRefCount(objPtr);
+	    nextPtr = entryPtr->nextPtr;
+	    ckfree((char *) entryPtr);
+	    entryPtr = nextPtr;
 	}
     }
-
+    
     /*
      * Free up the table's bucket array if it was dynamically allocated.
      */