diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclInt.h | 105 | ||||
| -rw-r--r-- | generic/tclObj.c | 79 | ||||
| -rw-r--r-- | win/tclWinInit.c | 39 |
4 files changed, 200 insertions, 28 deletions
@@ -1,3 +1,8 @@ +2004-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and + add comments. + 2004-06-17 Don Porter <dgp@users.sourceforge.net> * generic/tclObj.c: Added missing space in panic message. diff --git a/generic/tclInt.h b/generic/tclInt.h index ebf5b57..8dbecfa 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.162 2004/05/30 12:18:25 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.163 2004/06/18 13:42:41 dkf Exp $ */ #ifndef _TCLINT @@ -2209,20 +2209,115 @@ EXTERN Tcl_Obj *TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, # 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 ((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. + */ + +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 + +#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(&pendingObjDataKey, sizeof(PendingObjData)) +#endif #if defined(PURIFY) diff --git a/generic/tclObj.c b/generic/tclObj.c index 750fb00..ba617cf 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.60 2004/06/17 21:39:03 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.61 2004/06/18 13:42:41 dkf Exp $ */ #include "tclInt.h" @@ -62,6 +62,29 @@ 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; + +#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 @@ TclFreeObj(objPtr) 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); + 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 ((objToFre->typePtr != NULL) + && (objToFree->typePtr->freeIntRepProc != NULL)) { + objToFree->typePtr->freeIntRepProc(objToFree); + } + + 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 @@ void 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 diff --git a/win/tclWinInit.c b/win/tclWinInit.c index e9b1255..bae876e 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.56 2004/06/17 22:13:00 dgp Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.57 2004/06/18 13:42:42 dkf Exp $ */ #include "tclWinInt.h" @@ -159,29 +159,44 @@ SetDefaultLibraryDir(directory) Tcl_GetThreadData(&defaultLibraryDirKey, (int)sizeof(Tcl_Obj *)); Tcl_IncrRefCount(directory); - if (NULL == *savedDirectoryPtr) { - /* First call in this thread, set up the thread exit handler */ + if (*savedDirectoryPtr == NULL) { + /* + * First call in this thread, set up the thread exit handler + */ Tcl_CreateThreadExitHandler(FreeThreadDefaultLibraryDir, (ClientData) savedDirectoryPtr); } else { - /* Called SetDLD after a previous SetDLD or GetDLD in this thread ?! */ + /* + * Called SetDLD after a previous SetDLD or GetDLD in this thread ?! + */ Tcl_DecrRefCount(*savedDirectoryPtr); } *savedDirectoryPtr = directory; - /* No Mutex protection, as the only caller is already in TclpInitLock */ + /* + * No Mutex protection, as the only caller is already in TclpInitLock + */ bytes = Tcl_GetStringFromObj(directory, &numBytes); - if (NULL == defaultLibraryDir) { - /* First call from any thread; set up exit handler */ - Tcl_CreateExitHandler(FreeDefaultLibraryDir, NULL); - } else { - if ((defaultLibraryDirLength != numBytes) - || (0 != strcmp(defaultLibraryDir, bytes, numBytes))) { - Tcl_Panic("Attempt to overwrite defaultLibraryDir"); + if (defaultLibraryDir != NULL) { + /* + * This function has been called before. We only ever want to + * set up the default library directory once, but if it is set + * multiple times to the same value that's not harmful. + */ + if (defaultLibraryDirLength != numBytes + || memcmp(defaultLibraryDir, bytes, numBytes) != 0) { + Tcl_Panic("Attempt to modify defaultLibraryDir"); } return; } + + /* + * First call from any thread; set up exit handler + */ + + Tcl_CreateExitHandler(FreeDefaultLibraryDir, NULL); + defaultLibraryDirLength = numBytes; defaultLibraryDir = ckalloc((unsigned int) numBytes + 1); memcpy(defaultLibraryDir, bytes, (unsigned int) numBytes + 1); |