summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclLiteral.c55
3 files changed, 59 insertions, 3 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6e97632..16d5052 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.109 2004/07/12 01:56:12 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.110 2004/07/21 00:42:38 kennykb Exp $
*/
#include "tclInt.h"
@@ -1002,6 +1002,7 @@ DeleteInterpProc(interp)
* table, as it will be freed later in this function without further use.
*/
+ TclCleanupLiteralTable(interp, &(iPtr->literalTable));
TclHandleFree(iPtr->handle);
TclTeardownNamespace(iPtr->globalNsPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1526c60..f3db00e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.168 2004/07/07 08:21:26 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.169 2004/07/21 00:42:38 kennykb Exp $
*/
#ifndef _TCLINT
@@ -1717,6 +1717,8 @@ EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *value));
+EXTERN void TclCleanupLiteralTable _ANSI_ARGS_((
+ Tcl_Interp* interp, LiteralTable* tablePtr ));
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
Tcl_Parse *parsePtr));
EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index c887067..58ef176 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -8,11 +8,12 @@
* that appears in tclHash.c.
*
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
*
* 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.18 2004/07/15 18:31:34 kennykb Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.19 2004/07/21 00:42:39 kennykb Exp $
*/
#include "tclInt.h"
@@ -78,6 +79,58 @@ TclInitLiteralTable(tablePtr)
/*
*----------------------------------------------------------------------
*
+ * TclCleanupLiteralTable --
+ *
+ * This procedure frees the internal representation of every
+ * literal in a literal table. It is called prior to deleting
+ * an interp, so that variable refs will be cleaned up properly.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Each literal in the table has its internal representation freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupLiteralTable( interp, tablePtr )
+ 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;
+
+#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;
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclDeleteLiteralTable --
*
* This procedure frees up everything associated with a literal table