diff options
Diffstat (limited to 'generic/tclObj.c')
| -rw-r--r-- | generic/tclObj.c | 114 |
1 files changed, 86 insertions, 28 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index 900a861..e83d70a 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.10 1999/10/30 00:27:26 welch Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.11 1999/11/10 02:51:57 hobbs Exp $ */ #include "tclInt.h" @@ -26,12 +26,20 @@ 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. @@ -48,7 +56,6 @@ char *tclEmptyStringRep = &emptyString; #ifdef TCL_COMPILE_STATS long tclObjsAlloced = 0; long tclObjsFreed = 0; -TCL_DECLARE_MUTEX(tclCompStatsMutex) #endif /* TCL_COMPILE_STATS */ /* @@ -133,10 +140,10 @@ TclInitObjSubsystem() Tcl_RegisterObjType(&tclProcBodyType); #ifdef TCL_COMPILE_STATS - Tcl_MutexLock(&tclCompStatsMutex); + Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; - Tcl_MutexUnlock(&tclCompStatsMutex); + Tcl_MutexUnlock(&tclObjMutex); #endif } @@ -167,12 +174,9 @@ TclFinalizeCompExecEnv() typeTableInitialized = 0; } Tcl_MutexUnlock(&tableMutex); -#ifndef TCL_THREADS - /* - * This would a source of lock contention, so we don't use it. - */ + Tcl_MutexLock(&tclObjMutex); tclFreeObjList = NULL; -#endif + Tcl_MutexUnlock(&tclObjMutex); TclFinalizeCompilation(); TclFinalizeExecution(); @@ -385,16 +389,43 @@ Tcl_ConvertToType(interp, objPtr, typePtr) #ifdef TCL_MEM_DEBUG #undef Tcl_NewObj -#endif Tcl_Obj * Tcl_NewObj() { - Tcl_Obj *objPtr; - TclNewObj(objPtr); - return objPtr; + 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); + return objPtr; +} +#endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- @@ -410,7 +441,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 TclNewObj. + * result of calling Tcl_NewObj. * * Results: * The result is a newly allocated that represents the empty string. @@ -423,6 +454,7 @@ Tcl_NewObj() *---------------------------------------------------------------------- */ +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj(file, line) @@ -432,13 +464,38 @@ Tcl_DbNewObj(file, line) * for debugging. */ { register Tcl_Obj *objPtr; -#ifdef TCL_MEM_DEBUG - TclDbNewObj(objPtr, file, line); -#else - TclNewObj(objPtr); -#endif + + /* + * 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 */ 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 */ /* *---------------------------------------------------------------------- @@ -448,7 +505,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. * - * NOTE: This memory is not freed. + * Assumes mutex is held. * * Results: * None. @@ -531,22 +588,23 @@ TclFreeObj(objPtr) Tcl_InvalidateStringRep(objPtr); /* - * There are three cases, TCL_MEM_DEBUG and TCL_THREADS just use - * ckfree. The normal case uses the special object freelist. + * 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. */ + 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 */ - TclIncrObjsFreed(); +#ifdef TCL_COMPILE_STATS + tclObjsFreed++; +#endif /* TCL_COMPILE_STATS */ + Tcl_MutexUnlock(&tclObjMutex); } /* |