summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h91
-rw-r--r--generic/tclObj.c114
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();
}
/*