summaryrefslogtreecommitdiffstats
path: root/generic/tclLiteral.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLiteral.c')
-rw-r--r--generic/tclLiteral.c63
1 files changed, 42 insertions, 21 deletions
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 58ef176..f5af52d 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.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: tclLiteral.c,v 1.19 2004/07/21 00:42:39 kennykb Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.20 2004/08/02 15:33:36 dgp Exp $
*/
#include "tclInt.h"
@@ -96,34 +96,55 @@ TclInitLiteralTable(tablePtr)
void
TclCleanupLiteralTable( interp, tablePtr )
- Tcl_Interp* interp; /* Interpreter containing literals to purge */
- LiteralTable* tablePtr; /* Points to the literal table being cleaned */
+ Tcl_Interp* interp; /* Interpreter containing literals to purge */
+ LiteralTable* tablePtr; /* Points to the literal table being cleaned */
{
int i;
- LiteralEntry* entryPtr;
- LiteralEntry* nextPtr;
- Tcl_Obj* objPtr;
- Tcl_ObjType* typePtr;
+ LiteralEntry* entryPtr; /* Pointer to the current entry in the
+ * hash table of literals */
+ LiteralEntry* nextPtr; /* Pointer to the next entry in tbe
+ * bucket */
+ Tcl_Obj* objPtr; /* Pointer to a literal object whose internal
+ * rep is being freed */
+ Tcl_ObjType* typePtr; /* Pointer to the object's type */
+ int didOne; /* Flag for whether we've removed a literal
+ * in the current bucket */
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable( (Interp*) interp );
#endif /* TCL_COMPILE_DEBUG */
for ( i = 0; i < tablePtr->numBuckets; i++ ) {
- entryPtr = tablePtr->buckets[i];
- while ( entryPtr != NULL ) {
- objPtr = entryPtr->objPtr;
- nextPtr = entryPtr->nextPtr;
- typePtr = objPtr->typePtr;
- if ( ( typePtr != NULL ) && ( typePtr->freeIntRepProc != NULL ) ) {
- if ( objPtr->bytes == NULL ) {
- Tcl_Panic( "literal without a string rep" );
- }
- objPtr->typePtr = NULL;
- typePtr->freeIntRepProc( objPtr );
- }
- entryPtr = nextPtr;
- }
+
+ /*
+ * It is tempting simply to walk each hash bucket once and
+ * delete the internal representations of each literal in turn.
+ * It's also wrong. The problem is that freeing a literal's
+ * internal representation can delete other literals to which
+ * it refers, making nextPtr invalid. So each time we free an
+ * internal rep, we start its bucket over again.
+ */
+ didOne = 1;
+ while ( didOne ) {
+ didOne = 0;
+ entryPtr = tablePtr->buckets[i];
+ while ( entryPtr != NULL ) {
+ objPtr = entryPtr->objPtr;
+ nextPtr = entryPtr->nextPtr;
+ typePtr = objPtr->typePtr;
+ if ( ( typePtr != NULL )
+ && ( typePtr->freeIntRepProc != NULL ) ) {
+ if ( objPtr->bytes == NULL ) {
+ Tcl_Panic( "literal without a string rep" );
+ }
+ objPtr->typePtr = NULL;
+ typePtr->freeIntRepProc( objPtr );
+ didOne = 1;
+ } else {
+ entryPtr = nextPtr;
+ }
+ }
+ }
}
}