summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c290
1 files changed, 30 insertions, 260 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 56555e1..acb9270 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,5 +1,5 @@
/*
- * Obj.c --
+ * tclObj.c --
*
* This file contains Tcl object-related procedures that are used by
* many Tcl commands.
@@ -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.15 2000/07/19 22:15:30 ericm Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.16 2000/07/20 20:33:26 ericm Exp $
*/
#include "tclInt.h"
@@ -36,7 +36,7 @@ Tcl_Obj *tclFreeObjList = NULL;
*/
#ifdef TCL_THREADS
-Tcl_Mutex ObjMutex;
+Tcl_Mutex tclObjMutex;
#endif
/*
@@ -54,9 +54,9 @@ char *tclEmptyStringRep = &emptyString;
*/
#ifdef TCL_COMPILE_STATS
-long ObjsAlloced = 0;
-long ObjsFreed = 0;
-long ObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
+long tclObjsAlloced = 0;
+long tclObjsFreed = 0;
+long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
/*
@@ -74,20 +74,6 @@ static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
/*
- * Prototypes for the array hash key methods.
- */
-
-static Tcl_HashEntry * AllocObjEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareObjKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static void FreeObjEntry _ANSI_ARGS_((
- Tcl_HashEntry *hPtr));
-static unsigned int HashObjKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr,
- VOID *keyPtr));
-
-/*
* The structures below defines the Tcl object types defined in this file by
* means of procedures that can be invoked by generic object code. See also
* tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
@@ -117,18 +103,6 @@ Tcl_ObjType tclIntType = {
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-
-/*
- * The structure below defines the Tcl obj hash key type.
- */
-Tcl_HashKeyType tclObjHashKeyType = {
- TCL_HASH_KEY_TYPE_VERSION, /* version */
- 0, /* flags */
- HashObjKey, /* hashKeyProc */
- CompareObjKeys, /* compareKeysProc */
- AllocObjEntry, /* allocEntryProc */
- FreeObjEntry /* freeEntryProc */
-};
/*
*-------------------------------------------------------------------------
@@ -167,16 +141,16 @@ TclInitObjSubsystem()
Tcl_RegisterObjType(&tclProcBodyType);
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&ObjMutex);
- ObjsAlloced = 0;
- ObjsFreed = 0;
+ Tcl_MutexLock(&tclObjMutex);
+ tclObjsAlloced = 0;
+ tclObjsFreed = 0;
{
int i;
for (i = 0; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
- ObjsShared[i] = 0;
+ tclObjsShared[i] = 0;
}
}
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexUnlock(&tclObjMutex);
#endif
}
@@ -207,9 +181,9 @@ TclFinalizeCompExecEnv()
typeTableInitialized = 0;
}
Tcl_MutexUnlock(&tableMutex);
- Tcl_MutexLock(&ObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexUnlock(&tclObjMutex);
TclFinalizeCompilation();
TclFinalizeExecution();
@@ -415,7 +389,7 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
*
* Side effects:
* If compiling with TCL_COMPILE_STATS, this procedure increments
- * the global count of allocated objects (ObjsAlloced).
+ * the global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
*/
@@ -441,7 +415,7 @@ Tcl_NewObj()
* we maintain.
*/
- Tcl_MutexLock(&ObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
if (tclFreeObjList == NULL) {
TclAllocateFreeObjects();
}
@@ -453,9 +427,9 @@ Tcl_NewObj()
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
- ObjsAlloced++;
+ tclObjsAlloced++;
#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexUnlock(&tclObjMutex);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -482,7 +456,7 @@ Tcl_NewObj()
*
* Side effects:
* If compiling with TCL_COMPILE_STATS, this procedure increments
- * the global count of allocated objects (ObjsAlloced).
+ * the global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
*/
@@ -510,9 +484,9 @@ Tcl_DbNewObj(file, line)
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&ObjMutex);
- ObjsAlloced++;
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
+ tclObjsAlloced++;
+ Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_COMPILE_STATS */
return objPtr;
}
@@ -598,7 +572,7 @@ TclAllocateFreeObjects()
* type-specific Tcl_FreeInternalRepProc to deallocate the object's
* internal representation. If compiling with TCL_COMPILE_STATS,
* this procedure increments the global count of freed objects
- * (ObjsFreed).
+ * (tclObjsFreed).
*
*----------------------------------------------------------------------
*/
@@ -626,7 +600,7 @@ TclFreeObj(objPtr)
* Tcl_Obj structs we maintain.
*/
- Tcl_MutexLock(&ObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
#ifdef TCL_MEM_DEBUG
ckfree((char *) objPtr);
#else
@@ -635,9 +609,9 @@ TclFreeObj(objPtr)
#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
- ObjsFreed++;
+ tclObjsFreed++;
#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexUnlock(&tclObjMutex);
}
/*
@@ -2112,219 +2086,15 @@ Tcl_DbIsShared(objPtr, file, line)
}
#endif
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&ObjMutex);
+ Tcl_MutexLock(&tclObjMutex);
if ((objPtr)->refCount <= 1) {
- ObjsShared[1]++;
+ tclObjsShared[1]++;
} else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
- ObjsShared[(objPtr)->refCount]++;
+ tclObjsShared[(objPtr)->refCount]++;
} else {
- ObjsShared[0]++;
+ tclObjsShared[0]++;
}
- Tcl_MutexUnlock(&ObjMutex);
+ Tcl_MutexUnlock(&tclObjMutex);
#endif
return ((objPtr)->refCount > 1);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitObjHashTable --
- *
- * Given storage for a hash table, set up the fields to prepare
- * the hash table for use, the keys are Tcl_Obj *.
- *
- * Results:
- * None.
- *
- * Side effects:
- * TablePtr is now ready to be passed to Tcl_FindHashEntry and
- * Tcl_CreateHashEntry.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_InitObjHashTable(tablePtr)
- register Tcl_HashTable *tablePtr; /* Pointer to table record, which
- * is supplied by the caller. */
-{
- Tcl_InitHashTableEx (tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AllocObjEntry --
- *
- * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key.
- *
- * Results:
- * The return value is a pointer to the created entry.
- *
- * Side effects:
- * Increments the reference count on the object.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-AllocObjEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key to store in the hash table entry. */
-{
- Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
- Tcl_HashEntry *hPtr;
-
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
- hPtr->key.oneWordValue = (char *) objPtr;
- Tcl_IncrRefCount (objPtr);
-
- return hPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompareObjKeys --
- *
- * Compares two Tcl_Obj * keys.
- *
- * Results:
- * The return value is 0 if they are different and 1 if they are
- * the same.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompareObjKeys(keyPtr, hPtr)
- VOID *keyPtr; /* New key to compare. */
- Tcl_HashEntry *hPtr; /* Existing key to compare. */
-{
- Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
- Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
- register CONST char *p1, *p2;
- register int l1, l2;
-
- /*
- * If the object pointers are the same then they match.
- */
- if (objPtr1 == objPtr2) {
- return 1;
- }
-
- /*
- * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
- * in a register.
- */
- p1 = Tcl_GetString (objPtr1);
- l1 = objPtr1->length;
- p2 = Tcl_GetString (objPtr2);
- l2 = objPtr2->length;
-
- /*
- * Only compare if the string representations are of the same length.
- */
- if (l1 == l2) {
- for (;; p1++, p2++, l1--) {
- if (*p1 != *p2) {
- break;
- }
- if (l1 == 0) {
- return 1;
- }
- }
- }
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeObjEntry --
- *
- * Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
- *
- * Results:
- * The return value is a pointer to the created entry.
- *
- * Side effects:
- * Decrements the reference count of the object.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeObjEntry(hPtr)
- Tcl_HashEntry *hPtr; /* Hash entry to free. */
-{
- Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
-
- Tcl_DecrRefCount (objPtr);
- ckfree ((char *) hPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * HashObjKey --
- *
- * Compute a one-word summary of the string representation of the
- * Tcl_Obj, which can be used to generate a hash index.
- *
- * Results:
- * The return value is a one-word summary of the information in
- * the string representation of the Tcl_Obj.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static unsigned int
-HashObjKey(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key from which to compute hash value. */
-{
- Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
- register CONST char *string;
- register int length;
- register unsigned int result;
- register int c;
-
- string = Tcl_GetString (objPtr);
- length = objPtr->length;
-
- /*
- * I tried a zillion different hash functions and asked many other
- * people for advice. Many people had their own favorite functions,
- * all different, but no-one had much idea why they were good ones.
- * I chose the one below (multiply by 9 and add new character)
- * because of the following reasons:
- *
- * 1. Multiplying by 10 is perfect for keys that are decimal strings,
- * and multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
- * character's bits hang around in the low-order bits of the
- * hash value for ever, plus they spread fairly rapidly up to
- * the high-order bits to fill out the hash value. This seems
- * works well both for decimal and non-decimal strings.
- */
-
- result = 0;
- while (length) {
- c = *string;
- string++;
- length--;
- if (length == 0) {
- break;
- }
- result += (result<<3) + c;
- }
- return result;
-}