summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-07-08 18:46:02 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-07-08 18:46:02 (GMT)
commit5f7664fb28c03bce899572a39a9e3b343c223f3a (patch)
tree83ca945a044386ae90882b24cb30d198aa440f7e /generic
parent2e5d02410d31161822705b1b28f1743b8af402fc (diff)
downloadtcl-5f7664fb28c03bce899572a39a9e3b343c223f3a.zip
tcl-5f7664fb28c03bce899572a39a9e3b343c223f3a.tar.gz
tcl-5f7664fb28c03bce899572a39a9e3b343c223f3a.tar.bz2
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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c9
-rw-r--r--generic/tclCompile.c28
-rw-r--r--generic/tclLiteral.c40
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.
*/