diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclInt.h | 124 | ||||
| -rw-r--r-- | generic/tclObj.c | 162 |
2 files changed, 140 insertions, 146 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index cb72307..6efa576 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.219 2005/04/02 02:08:37 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.220 2005/04/05 16:19:09 msofer Exp $ */ #ifndef _TCLINT @@ -2448,76 +2448,6 @@ MODULE_SCOPE Tcl_Obj * TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -/* - * 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 { - 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 -MODULE_SCOPE PendingObjData tclPendingObjData; -#define TclObjInitDeletionContext(contextPtr) \ - PendingObjData *CONST contextPtr = &tclPendingObjData -#else -MODULE_SCOPE Tcl_ThreadDataKey tclPendingObjDataKey; -#define TclObjInitDeletionContext(contextPtr) \ - PendingObjData *CONST contextPtr = (PendingObjData *) \ - Tcl_GetThreadData(&tclPendingObjDataKey, sizeof(PendingObjData)) -#endif - #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ TclIncrObjsAllocated(); \ @@ -2529,52 +2459,18 @@ MODULE_SCOPE Tcl_ThreadDataKey tclPendingObjDataKey; # define TclDecrRefCount(objPtr) \ if (--(objPtr)->refCount <= 0) { \ - TclObjInitDeletionContext(contextPtr); \ - if (TclObjDeletePending(contextPtr)) { \ - TclPushObjToDelete(contextPtr,objPtr); \ + if ((objPtr)->typePtr && (objPtr)->typePtr->freeIntRepProc) { \ + TclFreeObj(objPtr); \ } else { \ - TclFreeObjMacro(contextPtr,objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != tclEmptyStringRep)) { \ + ckfree((char *) (objPtr)->bytes); \ + } \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ } \ } - -/* - * 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 70a1ae8..28c2e53 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.74 2005/04/01 15:17:25 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.75 2005/04/05 16:19:10 msofer Exp $ */ #include "tclInt.h" @@ -61,29 +61,80 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; #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; - + * Nested Tcl_Obj deletion management support + * + * 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 { + 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 ObjDeletionLock(contextPtr) (contextPtr)->deletionCount++ +#define ObjDeletionUnlock(contextPtr) (contextPtr)->deletionCount-- +#define ObjDeletePending(contextPtr) (contextPtr)->deletionCount > 0 +#define ObjOnStack(contextPtr) (contextPtr)->deletionStack != NULL +#define PushObjToDelete(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 PopObjToDelete(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 +PendingObjData pendingObjData; +#define ObjInitDeletionContext(contextPtr) \ + PendingObjData *CONST contextPtr = &pendingObjData #else - -/* - * Declaration of the singleton structure referenced in the - * implementation in tclInt.h. - */ -PendingObjData tclPendingObjData = { 0, NULL }; - +Tcl_ThreadDataKey pendingObjDataKey; +#define ObjInitDeletionContext(contextPtr) \ + PendingObjData *CONST contextPtr = (PendingObjData *) \ + Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif + /* * Prototypes for procedures defined later in this file: */ @@ -775,19 +826,19 @@ TclFreeObj(objPtr) /* * This macro declares a variable, so must come here... */ - TclObjInitDeletionContext(context); + ObjInitDeletionContext(context); if (objPtr->refCount < -1) { Tcl_Panic("Reference count for %lx was negative", objPtr); } - if (TclObjDeletePending(context)) { - TclPushObjToDelete(context, objPtr); + if (ObjDeletePending(context)) { + PushObjToDelete(context, objPtr); } else { if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - TclObjDeletionLock(context); + ObjDeletionLock(context); typePtr->freeIntRepProc(objPtr); - TclObjDeletionUnlock(context); + ObjDeletionUnlock(context); } Tcl_InvalidateStringRep(objPtr); @@ -797,11 +848,11 @@ TclFreeObj(objPtr) #ifdef TCL_COMPILE_STATS tclObjsFreed++; #endif /* TCL_COMPILE_STATS */ - TclObjDeletionLock(context); - while (TclObjOnStack(context)) { + ObjDeletionLock(context); + while (ObjOnStack(context)) { Tcl_Obj *objToFree; - TclPopObjToDelete(context,objToFree); + PopObjToDelete(context,objToFree); TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); @@ -811,7 +862,7 @@ TclFreeObj(objPtr) tclObjsFreed++; #endif /* TCL_COMPILE_STATS */ } - TclObjDeletionUnlock(context); + ObjDeletionUnlock(context); } } #else /* TCL_MEM_DEBUG */ @@ -820,11 +871,58 @@ void TclFreeObj(objPtr) register Tcl_Obj *objPtr; /* The object to be freed. */ { - TclObjInitDeletionContext(context); - if (TclObjDeletePending(context)) { - TclPushObjToDelete(context, objPtr); + if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { + /* + * objPtr can be freed safely, as it will not attempt to free any + * other objects: it will not cause recursive calls to this function. + */ + + if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) { + ckfree((char *) objPtr->bytes); + } + TclFreeObjStorage(objPtr); + TclIncrObjsFreed(); } else { - TclFreeObjMacro(context, objPtr); + /* + * This macro declares a variable, so must come here... + */ + ObjInitDeletionContext(context); + + if (ObjDeletePending(context)) { + PushObjToDelete(context, objPtr); + } else { + /* + * 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. + */ + + ObjDeletionLock(context); + objPtr->typePtr->freeIntRepProc(objPtr); + ObjDeletionUnlock(context); + + if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) { + ckfree((char *) objPtr->bytes); + } + TclFreeObjStorage(objPtr); + TclIncrObjsFreed(); + ObjDeletionLock(context); + while (ObjOnStack(context)) { + Tcl_Obj *objToFree; + PopObjToDelete(context,objToFree); + if ((objToFree->typePtr != NULL) + && (objToFree->typePtr->freeIntRepProc != NULL)) { + objToFree->typePtr->freeIntRepProc(objToFree); + } + TclFreeObjStorage(objToFree); + TclIncrObjsFreed(); + } + ObjDeletionUnlock(context); + } } } #endif |