diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclInt.h | 91 | ||||
| -rw-r--r-- | generic/tclObj.c | 114 |
2 files changed, 72 insertions, 133 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index b11e88b..6cf719b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.35 1999/08/02 17:45:37 redman Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.36 1999/10/30 00:27:26 welch Exp $ */ #ifndef _TCLINT @@ -2025,14 +2025,33 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp, * * EXTERN void TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); * EXTERN void TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); + * + * There are three variations on these routines for: + * TCL_MEM_DEBUG + * TCL_THREADS + * the normal case *---------------------------------------------------------------- */ +/* + * TclDecrRefCount is the same for all cases. The three cases + * are handled inside TclFreeObj. + */ + +#define TclDecrRefCount(objPtr) \ + if (--(objPtr)->refCount <= 0) { \ + TclFreeObj(objPtr); \ + } + #ifdef TCL_COMPILE_STATS # define TclIncrObjsAllocated() \ - tclObjsAlloced++ + Tcl_MutexLock(&tclCompStatsMutex); \ + tclObjsAlloced++; + Tcl_MutexUnLock(&tclCompStatsMutex) # define TclIncrObjsFreed() \ - tclObjsFreed++ + Tcl_MutexLock(&tclCompStatsMutex); \ + tclObjsFreed++; \ + Tcl_MutexUnLock(&tclCompStatsMutex) #else # define TclIncrObjsAllocated() # define TclIncrObjsFreed() @@ -2040,47 +2059,40 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp, #ifdef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - (objPtr) = (Tcl_Obj *) \ - Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \ + TclDbNewObj(objPtr, __FILE__, __LINE__) + +# define TclDbNewObj(objPtr, file, line) \ + (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL; \ TclIncrObjsAllocated() -# define TclDbNewObj(objPtr, file, line) \ - (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ +#else /* not TCL_MEM_DEBUG */ + +#ifdef TCL_THREADS + +/* + * The TclAllocateFreeObjects is a source of lock contention, + * so we just don't use it and rely on a good threaded memory allocator. + */ + +# define TclNewObj(objPtr) \ + (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL; \ TclIncrObjsAllocated() - -# define TclDecrRefCount(objPtr) \ - if (--(objPtr)->refCount <= 0) { \ - if ((objPtr)->refCount < -1) \ - panic("Reference count for %lx was negative: %s line %d", \ - (objPtr), __FILE__, __LINE__); \ - if (((objPtr)->bytes != NULL) \ - && ((objPtr)->bytes != tclEmptyStringRep)) { \ - ckfree((char *) (objPtr)->bytes); \ - } \ - if (((objPtr)->typePtr != NULL) \ - && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - ckfree((char *) (objPtr)); \ - TclIncrObjsFreed(); \ - } -#else /* not TCL_MEM_DEBUG */ +#else -#ifdef TCL_THREADS -extern Tcl_Mutex tclObjMutex; -#endif +/* + * Unthreaded case uses a special allocator. + */ # define TclNewObj(objPtr) \ - Tcl_MutexLock(&tclObjMutex); \ if (tclFreeObjList == NULL) { \ TclAllocateFreeObjects(); \ } \ @@ -2091,25 +2103,10 @@ extern Tcl_Mutex tclObjMutex; (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL; \ - TclIncrObjsAllocated(); \ - Tcl_MutexUnlock(&tclObjMutex) + TclIncrObjsAllocated() + +#endif /* TCL_THREADS */ -# define TclDecrRefCount(objPtr) \ - if (--(objPtr)->refCount <= 0) { \ - if (((objPtr)->bytes != NULL) \ - && ((objPtr)->bytes != tclEmptyStringRep)) { \ - ckfree((char *) (objPtr)->bytes); \ - } \ - if (((objPtr)->typePtr != NULL) \ - && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - Tcl_MutexLock(&tclObjMutex); \ - (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - TclIncrObjsFreed(); \ - Tcl_MutexUnlock(&tclObjMutex); \ - } #endif /* TCL_MEM_DEBUG */ /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 67be178..900a861 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -10,7 +10,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.9 1999/06/15 01:16:23 hershey Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.10 1999/10/30 00:27:26 welch Exp $ */ #include "tclInt.h" @@ -26,20 +26,12 @@ TCL_DECLARE_MUTEX(tableMutex) /* * Head of the list of free Tcl_Obj structs we maintain. + * This is not used in the threaded case, so no lock is declared. */ Tcl_Obj *tclFreeObjList = NULL; /* - * The object allocator is single threaded. This mutex is referenced - * by the TclNewObj macro, however, so must be visible. - */ - -#ifdef TCL_THREADS -Tcl_Mutex tclObjMutex; -#endif - -/* * Pointer to a heap-allocated string of length zero that the Tcl core uses * as the value of an empty string representation for an object. This value * is shared by all new objects allocated by Tcl_NewObj. @@ -56,6 +48,7 @@ char *tclEmptyStringRep = &emptyString; #ifdef TCL_COMPILE_STATS long tclObjsAlloced = 0; long tclObjsFreed = 0; +TCL_DECLARE_MUTEX(tclCompStatsMutex) #endif /* TCL_COMPILE_STATS */ /* @@ -140,10 +133,10 @@ TclInitObjSubsystem() Tcl_RegisterObjType(&tclProcBodyType); #ifdef TCL_COMPILE_STATS - Tcl_MutexLock(&tclObjMutex); + Tcl_MutexLock(&tclCompStatsMutex); tclObjsAlloced = 0; tclObjsFreed = 0; - Tcl_MutexUnlock(&tclObjMutex); + Tcl_MutexUnlock(&tclCompStatsMutex); #endif } @@ -174,9 +167,12 @@ TclFinalizeCompExecEnv() typeTableInitialized = 0; } Tcl_MutexUnlock(&tableMutex); - Tcl_MutexLock(&tclObjMutex); +#ifndef TCL_THREADS + /* + * This would a source of lock contention, so we don't use it. + */ tclFreeObjList = NULL; - Tcl_MutexUnlock(&tclObjMutex); +#endif TclFinalizeCompilation(); TclFinalizeExecution(); @@ -389,43 +385,16 @@ Tcl_ConvertToType(interp, objPtr, typePtr) #ifdef TCL_MEM_DEBUG #undef Tcl_NewObj +#endif Tcl_Obj * Tcl_NewObj() { - return Tcl_DbNewObj("unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewObj() -{ - register Tcl_Obj *objPtr; - - /* - * Allocate the object using the list of free Tcl_Obj structs - * we maintain. - */ - - Tcl_MutexLock(&tclObjMutex); - if (tclFreeObjList == NULL) { - TclAllocateFreeObjects(); - } - objPtr = tclFreeObjList; - tclFreeObjList = (Tcl_Obj *) tclFreeObjList->internalRep.otherValuePtr; - - objPtr->refCount = 0; - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; - objPtr->typePtr = NULL; -#ifdef TCL_COMPILE_STATS - tclObjsAlloced++; -#endif /* TCL_COMPILE_STATS */ - Tcl_MutexUnlock(&tclObjMutex); + Tcl_Obj *objPtr; + TclNewObj(objPtr); return objPtr; } -#endif /* TCL_MEM_DEBUG */ + /* *---------------------------------------------------------------------- @@ -441,7 +410,7 @@ Tcl_NewObj() * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the - * result of calling Tcl_NewObj. + * result of calling TclNewObj. * * Results: * The result is a newly allocated that represents the empty string. @@ -454,7 +423,6 @@ Tcl_NewObj() *---------------------------------------------------------------------- */ -#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj(file, line) @@ -464,38 +432,13 @@ Tcl_DbNewObj(file, line) * for debugging. */ { register Tcl_Obj *objPtr; - - /* - * If debugging Tcl's memory usage, allocate the object using ckalloc. - * Otherwise, allocate it using the list of free Tcl_Obj structs we - * maintain. - */ - - objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line); - objPtr->refCount = 0; - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; - objPtr->typePtr = NULL; -#ifdef TCL_COMPILE_STATS - Tcl_MutexLock(&tclObjMutex); - tclObjsAlloced++; - Tcl_MutexUnlock(&tclObjMutex); -#endif /* TCL_COMPILE_STATS */ +#ifdef TCL_MEM_DEBUG + TclDbNewObj(objPtr, file, line); +#else + TclNewObj(objPtr); +#endif return objPtr; } - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewObj(file, line) - char *file; /* The name of the source file calling this - * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ -{ - return Tcl_NewObj(); -} -#endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- @@ -505,7 +448,7 @@ Tcl_DbNewObj(file, line) * Procedure to allocate a number of free Tcl_Objs. This is done using * a single ckalloc to reduce the overhead for Tcl_Obj allocation. * - * Assumes mutex is held. + * NOTE: This memory is not freed. * * Results: * None. @@ -588,23 +531,22 @@ TclFreeObj(objPtr) Tcl_InvalidateStringRep(objPtr); /* - * If debugging Tcl's memory usage, deallocate the object using ckfree. - * Otherwise, deallocate it by adding it onto the list of free - * Tcl_Obj structs we maintain. + * There are three cases, TCL_MEM_DEBUG and TCL_THREADS just use + * ckfree. The normal case uses the special object freelist. */ - Tcl_MutexLock(&tclObjMutex); #ifdef TCL_MEM_DEBUG ckfree((char *) objPtr); #else +#ifdef TCL_THREADS + ckfree((char *) objPtr); +#else objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList; tclFreeObjList = objPtr; +#endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ -#ifdef TCL_COMPILE_STATS - tclObjsFreed++; -#endif /* TCL_COMPILE_STATS */ - Tcl_MutexUnlock(&tclObjMutex); + TclIncrObjsFreed(); } /* |