Attachment "litTable.patch" to
ticket [994838ffff]
added by
kennykb
2004-07-21 04:57:27.
? NSK1KENNKEVI01
? NSK1KENNKEVI01-mingw
? unix/autom4te.cache
? win/autom4te.cache
? win/config.status.lineno
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.109
diff -b -u -r1.109 tclBasic.c
--- generic/tclBasic.c 12 Jul 2004 01:56:12 -0000 1.109
+++ generic/tclBasic.c 20 Jul 2004 21:57:00 -0000
@@ -1002,6 +1002,7 @@
* table, as it will be freed later in this function without further use.
*/
+ TclCleanupLiteralTable(interp, &(iPtr->literalTable));
TclHandleFree(iPtr->handle);
TclTeardownNamespace(iPtr->globalNsPtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.168
diff -b -u -r1.168 tclInt.h
--- generic/tclInt.h 7 Jul 2004 08:21:26 -0000 1.168
+++ generic/tclInt.h 20 Jul 2004 21:57:01 -0000
@@ -1717,6 +1717,8 @@
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,
Index: generic/tclLiteral.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLiteral.c,v
retrieving revision 1.18
diff -b -u -r1.18 tclLiteral.c
--- generic/tclLiteral.c 15 Jul 2004 18:31:34 -0000 1.18
+++ generic/tclLiteral.c 20 Jul 2004 21:57:01 -0000
@@ -78,6 +78,58 @@
/*
*----------------------------------------------------------------------
*
+ * 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
