Attachment "freeobj.diff" to
ticket [886231ffff]
added by
dkf
2004-06-16 21:40:55.
? unix/dltest.marker
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.162
diff -u -r1.162 tclInt.h
--- generic/tclInt.h 30 May 2004 12:18:25 -0000 1.162
+++ generic/tclInt.h 16 Jun 2004 14:21:49 -0000
@@ -2198,6 +2198,73 @@
# define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */
+/*
+ * All context references are pointers to this structure; every thread
+ * will have its own reference.
+ */
+
+typedef struct PendingObjData {
+ int deletionCount; /* Count of the number of invokations of
+ * TclFreeObj() are on the stack (at least
+ * conceptually; many are actually expanded
+ * macros). */
+ Tcl_Obj *deletionStack; /* Stack of objects that have had TclFreeObj()
+ * invoked upon them but which can't be deleted
+ * yet because they are in a nested invokation
+ * of TclFreeObj(). By postponing this way, we
+ * limit the maximum overall C stack depth when
+ * deleting a complex object. The down-side is
+ * that we alter the overall behaviour by
+ * altering the order in which objects are
+ * deleted, and we change the order in which
+ * the string rep and the internal rep of an
+ * object are deleted. Note that code which
+ * assumes the previous behaviour in either of
+ * these respects is unsafe anyway; it was
+ * never documented as to exactly what would
+ * happen in these cases, and the overall
+ * contract of a user-level Tcl_DecrRefCount()
+ * is still preserved (assuming that a
+ * particular T_DRC would delete an object is
+ * not very safe). */
+} PendingObjData;
+
+/*
+ * These are separated out so that some semantic content is attached
+ * to them.
+ */
+#define TclObjDeletionLock(contextPtr) (contextPtr)->deletionCount++
+#define TclObjDeletionUnlock(contextPtr) (contextPtr)->deletionCount--
+#define TclObjDeletePending(contextPtr) (contextPtr)->deletionCount > 0
+#define TclObjOnStack(contextPtr) (contextPtr)->deletionStack != NULL
+#define TclPushObjToDelete(contextPtr,objPtr) \
+ /* Invalidate the string rep first so we can use the bytes value \
+ * for our pointer chain. */ \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ ckfree((char *) (objPtr)->bytes); \
+ } \
+ /* Now push onto the head of the stack. */ \
+ (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
+ (contextPtr)->deletionStack = (objPtr)
+#define TclPopObjToDelete(contextPtr,objPtrVar) \
+ (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) \
+ PendingObjData *CONST contextPtr = &tclPendingObjData
+#else
+extern Tcl_ThreadDataKey tclPendingObjDataKey;
+#define TclObjInitDeletionContext(contextPtr) \
+ PendingObjData *CONST contextPtr = (PendingObjData *) \
+ Tcl_GetThreadData(&tclPendingObjDataKey, sizeof(PendingObjData))
+#endif
+
#ifndef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
TclIncrObjsAllocated(); \
@@ -2209,20 +2276,51 @@
# define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
- TclFreeObjMacro(objPtr); \
- }
+ TclObjInitDeletionContext(contextPtr); \
+ if (TclObjDeletePending(contextPtr)) { \
+ TclPushObjToDelete(contextPtr,objPtr); \
+ } else { \
+ TclFreeObjMacro(contextPtr,objPtr); \
+ } \
+ }
-#define TclFreeObjMacro(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()
+ 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)
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.59
diff -u -r1.59 tclObj.c
--- generic/tclObj.c 6 May 2004 04:41:53 -0000 1.59
+++ generic/tclObj.c 16 Jun 2004 14:21:49 -0000
@@ -62,6 +62,29 @@
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
/*
+ * Nested Tcl_Obj deletion management support. Note that the code
+ * that implements all this is written as macros in tclInt.h
+ */
+
+#ifdef TCL_THREADS
+
+/*
+ * Lookup key for the thread-local data used in the implementation in
+ * tclInt.h.
+ */
+Tcl_ThreadDataKey tclPendingObjDataKey;
+
+#else
+
+/*
+ * Declaration of the singleton structure referenced in the
+ * implementation in tclInt.h.
+ */
+PendingObjData tclPendingObjData = { 0, NULL };
+
+#endif
+
+/*
* Prototypes for procedures defined later in this file:
*/
@@ -739,22 +762,51 @@
register Tcl_Obj *objPtr; /* The object to be freed. */
{
register Tcl_ObjType *typePtr = objPtr->typePtr;
+ /*
+ * This macro declares a variable, so must come here...
+ */
+ TclObjInitDeletionContext(context);
- if ((objPtr)->refCount < -1) {
+ if (objPtr->refCount < -1) {
Tcl_Panic("Reference count for %lx was negative", objPtr);
}
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- typePtr->freeIntRepProc(objPtr);
- }
- Tcl_InvalidateStringRep(objPtr);
+ if (TclObjDeletePending(context)) {
+ TclPushObjToDelete(context, objPtr);
+ } else {
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ TclObjDeletionLock(context);
+ typePtr->freeIntRepProc(objPtr);
+ TclObjDeletionUnlock(context);
+ }
+ Tcl_InvalidateStringRep(objPtr);
+
+ Tcl_MutexLock(&tclObjMutex);
+ ckfree((char *) objPtr);
+ Tcl_MutexUnlock(&tclObjMutex);
+#ifdef TCL_COMPILE_STATS
+ tclObjsFreed++;
+#endif /* TCL_COMPILE_STATS */
+ TclObjDeletionLock(context);
+ while (TclObjOnStack(context)) {
+ Tcl_Obj *objToFree;
+
+ TclPopObjToDelete(context,objToFree);
+
+ if ((objToFree->typePtr != NULL)
+ && (objToFree->typePtr->freeIntRepProc != NULL)) {
+ objToFree->typePtr->freeIntRepProc(objToFree);
+ }
- Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objPtr);
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
+ ckfree((char *) objToFree);
+ Tcl_MutexUnlock(&tclObjMutex);
#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
+ tclObjsFreed++;
#endif /* TCL_COMPILE_STATS */
+ }
+ TclObjDeletionUnlock(context);
+ }
}
#else /* TCL_MEM_DEBUG */
@@ -762,7 +814,12 @@
TclFreeObj(objPtr)
register Tcl_Obj *objPtr; /* The object to be freed. */
{
- TclFreeObjMacro(objPtr);
+ TclObjInitDeletionContext(context);
+ if (TclObjDeletePending(context)) {
+ TclPushObjToDelete(context, objPtr);
+ } else {
+ TclFreeObjMacro(context, objPtr);
+ }
}
#endif
