From 36f1698a072c40091f4452ae29366b10cc4be03c Mon Sep 17 00:00:00 2001 From: mdejong Date: Thu, 24 Jul 2003 18:16:30 +0000 Subject: * generic/tcl.h: Revert change made on 2003-07-21 since it made the sizeof(Tcl_Obj) different for regular vs mem debug builds. * generic/tclInt.h: Define TclDecrRefCount in terms of Tcl_DbDecrRefCount which removes one layer of inderection. * generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared): Define ThreadSpecificData that contains a hashtable. The table is used to ensure that a Tcl_Obj is only acted upon in the thread that allocated it. This checking code is enabled only when mem debug and threads are enabled. --- ChangeLog | 16 ++++++++ generic/tcl.h | 11 +---- generic/tclInt.h | 4 +- generic/tclObj.c | 123 ++++++++++++++++++++++++++++++++++++++++++++++++------- 4 files changed, 128 insertions(+), 26 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9550813..b4497cf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +2003-07-24 Mo DeJong + + * generic/tcl.h: Revert change made on 2003-07-21 + since it made the sizeof(Tcl_Obj) different for + regular vs mem debug builds. + * generic/tclInt.h: Define TclDecrRefCount in terms + of Tcl_DbDecrRefCount which removes one layer of + inderection. + * generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount, + Tcl_DbDecrRefCount, Tcl_DbIsShared): + Define ThreadSpecificData that contains a hashtable. + The table is used to ensure that a Tcl_Obj is only + acted upon in the thread that allocated it. This + checking code is enabled only when mem debug and + threads are enabled. + 2003-07-24 Don Porter * tests/async.test: Added several tests that demonstrate Tcl diff --git a/generic/tcl.h b/generic/tcl.h index bbe13a7..1b02611 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.161 2003/07/22 00:59:58 mdejong Exp $ + * RCS: @(#) $Id: tcl.h,v 1.162 2003/07/24 18:16:30 mdejong Exp $ */ #ifndef _TCL @@ -778,15 +778,6 @@ typedef struct Tcl_Obj { VOID *ptr2; } twoPtrValue; } internalRep; - - /* - * Thread id used to check that calls to Tcl_IncrRefCount, - * Tcl_DecrRefCount, and Tcl_IsShared are being made - * from the thread that originally allocated the Tcl_Obj. - */ -#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) - Tcl_ThreadId allocThread; -#endif } Tcl_Obj; diff --git a/generic/tclInt.h b/generic/tclInt.h index 040e359..e25d632 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.129 2003/07/22 00:59:58 mdejong Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.130 2003/07/24 18:16:30 mdejong Exp $ */ #ifndef _TCLINT @@ -2123,7 +2123,7 @@ EXTERN void TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); TclDbNewObj(objPtr, __FILE__, __LINE__); # define TclDecrRefCount(objPtr) \ - Tcl_DecrRefCount(objPtr); + Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) #elif defined(PURIFY) diff --git a/generic/tclObj.c b/generic/tclObj.c index 3ab7ee9..de02962 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.48 2003/07/22 00:59:58 mdejong Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.49 2003/07/24 18:16:31 mdejong Exp $ */ #include "tclInt.h" @@ -50,6 +50,18 @@ Tcl_Mutex tclObjMutex; char tclEmptyString = '\0'; char *tclEmptyStringRep = &tclEmptyString; +#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) +/* + * Thread local table that is used to check that a Tcl_Obj + * was not allocated by some other thread. + */ +typedef struct ThreadSpecificData { + Tcl_HashTable *objThreadMap; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_MEM_DEBUG && TCL_THREADS */ + /* * Prototypes for procedures defined later in this file: */ @@ -507,7 +519,28 @@ void TclDbInitNewObj(objPtr) objPtr->length = 0; objPtr->typePtr = NULL; # ifdef TCL_THREADS - objPtr->allocThread = Tcl_GetCurrentThread(); + /* + * Add entry to a thread local map used to check if a Tcl_Obj + * was allocated by the currently executing thread. + */ + { + Tcl_HashEntry *hPtr; + Tcl_HashTable *tablePtr; + int new; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->objThreadMap == NULL) { + tsdPtr->objThreadMap = (Tcl_HashTable *) + ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS); + } + tablePtr = tsdPtr->objThreadMap; + hPtr = Tcl_CreateHashEntry(tablePtr, (char *) objPtr, &new); + if (!new) { + panic("expected to create new entry for object map"); + } + Tcl_SetHashValue(hPtr, NULL); + } # endif /* TCL_THREADS */ } #endif /* TCL_MEM_DEBUG */ @@ -2557,11 +2590,30 @@ Tcl_DbIncrRefCount(objPtr, file, line) fflush(stderr); panic("Trying to increment refCount of previously disposed object."); } -#ifdef TCL_THREADS - if (Tcl_GetCurrentThread() != objPtr->allocThread) { - panic("Attempt to incr Tcl_Obj ref count in another thread"); +# ifdef TCL_THREADS + /* + * Check to make sure that the Tcl_Obj was allocated by the + * current thread. Don't do this check when shutting down + * since thread local storage can be finalized before the + * last Tcl_Obj is freed. + */ + if (!TclInExit()) + { + Tcl_HashTable *tablePtr; + Tcl_HashEntry *hPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tablePtr = tsdPtr->objThreadMap; + if (!tablePtr) { + panic("object table not initialized"); + } + hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr); + if (!hPtr) { + panic("%s%s", + "Trying to incr ref count of", + "Tcl_Obj allocated in another thread"); + } } -#endif +# endif #endif ++(objPtr)->refCount; } @@ -2602,11 +2654,35 @@ Tcl_DbDecrRefCount(objPtr, file, line) fflush(stderr); panic("Trying to decrement refCount of previously disposed object."); } -#ifdef TCL_THREADS - if (Tcl_GetCurrentThread() != objPtr->allocThread) { - panic("Attempt to decr Tcl_Obj ref count in another thread"); +# ifdef TCL_THREADS + /* + * Check to make sure that the Tcl_Obj was allocated by the + * current thread. Don't do this check when shutting down + * since thread local storage can be finalized before the + * last Tcl_Obj is freed. + */ + if (!TclInExit()) + { + Tcl_HashTable *tablePtr; + Tcl_HashEntry *hPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tablePtr = tsdPtr->objThreadMap; + if (!tablePtr) { + panic("object table not initialized"); + } + hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr); + if (!hPtr) { + panic("%s%s", + "Trying to decr ref count of", + "Tcl_Obj allocated in another thread"); + } + + /* If the Tcl_Obj is going to be deleted, remove the entry */ + if ((((objPtr)->refCount) - 1) <= 0) { + Tcl_DeleteHashEntry(hPtr); + } } -#endif +# endif #endif if (--(objPtr)->refCount <= 0) { TclFreeObj(objPtr); @@ -2648,11 +2724,30 @@ Tcl_DbIsShared(objPtr, file, line) fflush(stderr); panic("Trying to check whether previously disposed object is shared."); } -#ifdef TCL_THREADS - if (Tcl_GetCurrentThread() != objPtr->allocThread) { - panic("Attempt to query shared status in another thread"); +# ifdef TCL_THREADS + /* + * Check to make sure that the Tcl_Obj was allocated by the + * current thread. Don't do this check when shutting down + * since thread local storage can be finalized before the + * last Tcl_Obj is freed. + */ + if (!TclInExit()) + { + Tcl_HashTable *tablePtr; + Tcl_HashEntry *hPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tablePtr = tsdPtr->objThreadMap; + if (!tablePtr) { + panic("object table not initialized"); + } + hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr); + if (!hPtr) { + panic("%s%s", + "Trying to check shared status of", + "Tcl_Obj allocated in another thread"); + } } -#endif +# endif #endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); -- cgit v0.12