summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-08-04 15:55:05 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-08-04 15:55:05 (GMT)
commitfc6f85c9ef2f8830384506911104a590ac45baa1 (patch)
tree5d9f0896dfeedd3d7b8df37b2b13c38c6aa2f961 /generic
parenteb0feb979757670c7509380a53ba1af03cb44666 (diff)
downloadtcl-fc6f85c9ef2f8830384506911104a590ac45baa1.zip
tcl-fc6f85c9ef2f8830384506911104a590ac45baa1.tar.gz
tcl-fc6f85c9ef2f8830384506911104a590ac45baa1.tar.bz2
* generic/tclObj.c: Simplified routines that manage the typeTable.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclObj.c59
1 files changed, 23 insertions, 36 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8a58b7c..f817a71 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -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: tclObj.c,v 1.89 2005/08/03 22:25:11 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.90 2005/08/04 15:55:12 dgp Exp $
*/
#include "tclInt.h"
@@ -463,27 +463,10 @@ Tcl_RegisterObjType(typePtr)
* be statically allocated (must live
* forever). */
{
- register Tcl_HashEntry *hPtr;
int new;
-
- /*
- * If there's already an object type with the given name, remove it.
- */
-
Tcl_MutexLock(&tableMutex);
- hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name);
- if (hPtr != (Tcl_HashEntry *) NULL) {
- Tcl_DeleteHashEntry(hPtr);
- }
-
- /*
- * Now insert the new object type.
- */
-
- hPtr = Tcl_CreateHashEntry(&typeTable, typePtr->name, &new);
- if (new) {
- Tcl_SetHashValue(hPtr, typePtr);
- }
+ Tcl_SetHashValue(
+ Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr);
Tcl_MutexUnlock(&tableMutex);
}
@@ -520,23 +503,27 @@ Tcl_AppendAllObjTypes(interp, objPtr)
{
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- Tcl_ObjType *typePtr;
- int result;
+ int result, objc;
+ Tcl_Obj **objv;
+
+ /*
+ * Get the test for a valid list out of the way first.
+ */
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
/*
- * This code assumes that types names do not contain embedded NULLs.
+ * Type names are NUL-terminated, not counted strings.
+ * This code relies on that.
*/
Tcl_MutexLock(&tableMutex);
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
- result = Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewStringObj(typePtr->name, -1));
- if (result == TCL_ERROR) {
- Tcl_MutexUnlock(&tableMutex);
- return result;
- }
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
}
Tcl_MutexUnlock(&tableMutex);
return TCL_OK;
@@ -564,17 +551,15 @@ Tcl_GetObjType(typeName)
CONST char *typeName; /* Name of Tcl object type to look up. */
{
register Tcl_HashEntry *hPtr;
- Tcl_ObjType *typePtr;
+ Tcl_ObjType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
- Tcl_MutexUnlock(&tableMutex);
- return typePtr;
}
Tcl_MutexUnlock(&tableMutex);
- return NULL;
+ return typePtr;
}
/*
@@ -819,7 +804,9 @@ TclAllocateFreeObjects()
* This has been noted by Purify to be a potential leak. The problem is
* that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
* Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
- * freeing the memory. These never do get freed properly.
+ * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
+ * but leaves it to Tcl's memory subsystem finalization to release it.
+ * Purify apparently can't figure that out, and fires a false alarm.
*/
basePtr = (char *) ckalloc(bytesToAlloc);
@@ -1144,7 +1131,7 @@ Tcl_InvalidateStringRep(objPtr)
* Tcl_NewBooleanObj --
*
* This procedure is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new boolean object and
+ * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
* initializes it from the argument boolean value. A nonzero "boolValue"
* is coerced to 1.
*