summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-06-18 15:12:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-06-18 15:12:37 (GMT)
commit9a1a3e2f07dfc0b90751b9ccce5015cb42119ae6 (patch)
treefb825bf571652f6b3d06ba63b712e696bef425d0
parentde76c226887e818f393568bf07dd6fdebd8347de (diff)
downloadtcl-9a1a3e2f07dfc0b90751b9ccce5015cb42119ae6.zip
tcl-9a1a3e2f07dfc0b90751b9ccce5015cb42119ae6.tar.gz
tcl-9a1a3e2f07dfc0b90751b9ccce5015cb42119ae6.tar.bz2
Fixed [Bug 886231] properly this time rather than with a broken version that
breaks the core completely. :^}
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclInt.h128
-rw-r--r--generic/tclObj.c4
3 files changed, 74 insertions, 63 deletions
diff --git a/ChangeLog b/ChangeLog
index 70c8817..0d8eb00 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
2004-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclInt.h (PendingObjData,TclFreeObjMacro,etc):
+ * generic/tclObj.c (TclFreeObj): Added scheme for making TclFreeObj()
+ avoid blowing up the C stack when freeing up very large object
+ trees. [Bug 886231]
+
* win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and
add comments.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8dbecfa..e96b5a8 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.163 2004/06/18 13:42:41 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.164 2004/06/18 15:12:39 dkf Exp $
*/
#ifndef _TCLINT
@@ -2198,66 +2198,12 @@ EXTERN Tcl_Obj *TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
# define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */
-#ifndef TCL_MEM_DEBUG
-# define TclNewObj(objPtr) \
- TclIncrObjsAllocated(); \
- TclAllocObjStorage(objPtr); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- (objPtr)->typePtr = NULL
-
-# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount <= 0) { \
- TclObjInitDeletionContext(contextPtr); \
- if (TclObjDeletePending(contextPtr)) { \
- TclPushObjToDelete(contextPtr,objPtr); \
- } else { \
- TclFreeObjMacro(contextPtr,objPtr); \
- } \
- }
-
/*
- * Note that the contents of the while loop assume that the string rep
- * has already been freed and we don't want to do anything fancy with
- * adding to the queue inside ourselves. Must take care to unstack the
- * object first since freeing the internal rep can add further objects
- * to the stack. The code assumes that it is the first thing in a
- * block; all current usages in the core satisfy this.
- *
- * Optimization opportunity: Allocate the context once in a large
- * function (e.g. TclExecuteByteCode) and use it directly instead of
- * looking it up each time.
- */
-#define TclFreeObjMacro(contextPtr,objPtr) \
- if (((objPtr)->typePtr != NULL) \
- && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
- TclObjDeletionLock(contextPtr); \
- (objPtr)->typePtr->freeIntRepProc(objPtr); \
- TclObjDeletionUnlock(contextPtr); \
- } \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
- TclFreeObjStorage(objPtr); \
- TclIncrObjsFreed(); \
- TclObjDeletionLock(contextPtr); \
- while (TclObjOnStack(contextPtr)) { \
- Tcl_Obj *objToFree; \
- TclPopObjToDelete(contextPtr,objToFree); \
- if ((objToFre->typePtr != NULL) \
- && (objToFree->typePtr->freeIntRepProc != NULL)) { \
- objToFree->typePtr->freeIntRepProc(objToFree); \
- } \
- TclFreeObjStorage(objToFree); \
- TclIncrObjsFreed(); \
- } \
- TclObjDeletionUnlock(contextPtr)
-
-/*
- * All context references are pointers to this structure; every thread
- * will have its own reference.
+ * All context references used in the object freeing code are pointers
+ * to this structure; every thread will have its own structure
+ * instance. The purpose of this structure is to allow deeply nested
+ * collections of Tcl_Objs to be freed without taking a vast depth of
+ * C stack (which could cause all sorts of breakage.)
*/
typedef struct PendingObjData {
@@ -2308,6 +2254,9 @@ typedef struct PendingObjData {
(objPtrVar) = (contextPtr)->deletionStack; \
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
+/*
+ * Macro to set up the local reference to the deletion context.
+ */
#ifndef TCL_THREADS
extern PendingObjData tclPendingObjData;
#define TclObjInitDeletionContext(contextPtr) \
@@ -2316,9 +2265,66 @@ extern PendingObjData tclPendingObjData;
extern Tcl_ThreadDataKey tclPendingObjDataKey;
#define TclObjInitDeletionContext(contextPtr) \
PendingObjData *CONST contextPtr = (PendingObjData *) \
- Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
+ Tcl_GetThreadData(&tclPendingObjDataKey, sizeof(PendingObjData))
#endif
+#ifndef TCL_MEM_DEBUG
+# define TclNewObj(objPtr) \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorage(objPtr); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->length = 0; \
+ (objPtr)->typePtr = NULL
+
+# define TclDecrRefCount(objPtr) \
+ if (--(objPtr)->refCount <= 0) { \
+ TclObjInitDeletionContext(contextPtr); \
+ if (TclObjDeletePending(contextPtr)) { \
+ TclPushObjToDelete(contextPtr,objPtr); \
+ } else { \
+ TclFreeObjMacro(contextPtr,objPtr); \
+ } \
+ }
+
+/*
+ * Note that the contents of the while loop assume that the string rep
+ * has already been freed and we don't want to do anything fancy with
+ * adding to the queue inside ourselves. Must take care to unstack the
+ * object first since freeing the internal rep can add further objects
+ * to the stack. The code assumes that it is the first thing in a
+ * block; all current usages in the core satisfy this.
+ *
+ * Optimization opportunity: Allocate the context once in a large
+ * function (e.g. TclExecuteByteCode) and use it directly instead of
+ * looking it up each time.
+ */
+#define TclFreeObjMacro(contextPtr,objPtr) \
+ if (((objPtr)->typePtr != NULL) \
+ && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+ TclObjDeletionLock(contextPtr); \
+ (objPtr)->typePtr->freeIntRepProc(objPtr); \
+ TclObjDeletionUnlock(contextPtr); \
+ } \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ ckfree((char *) (objPtr)->bytes); \
+ } \
+ TclFreeObjStorage(objPtr); \
+ TclIncrObjsFreed(); \
+ TclObjDeletionLock(contextPtr); \
+ while (TclObjOnStack(contextPtr)) { \
+ Tcl_Obj *objToFree; \
+ TclPopObjToDelete(contextPtr,objToFree); \
+ if ((objToFree->typePtr != NULL) \
+ && (objToFree->typePtr->freeIntRepProc != NULL)) { \
+ objToFree->typePtr->freeIntRepProc(objToFree); \
+ } \
+ TclFreeObjStorage(objToFree); \
+ TclIncrObjsFreed(); \
+ } \
+ TclObjDeletionUnlock(contextPtr)
+
#if defined(PURIFY)
/*
diff --git a/generic/tclObj.c b/generic/tclObj.c
index ba617cf..ec3eeb5 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.61 2004/06/18 13:42:41 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.62 2004/06/18 15:12:39 dkf Exp $
*/
#include "tclInt.h"
@@ -793,7 +793,7 @@ TclFreeObj(objPtr)
TclPopObjToDelete(context,objToFree);
- if ((objToFre->typePtr != NULL)
+ if ((objToFree->typePtr != NULL)
&& (objToFree->typePtr->freeIntRepProc != NULL)) {
objToFree->typePtr->freeIntRepProc(objToFree);
}