diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.decls | 21 | ||||
| -rw-r--r-- | generic/tcl.h | 184 | ||||
| -rw-r--r-- | generic/tclDecls.h | 36 | ||||
| -rw-r--r-- | generic/tclHash.c | 1216 | ||||
| -rw-r--r-- | generic/tclInt.h | 11 | ||||
| -rw-r--r-- | generic/tclObj.c | 290 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 10 |
7 files changed, 653 insertions, 1115 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index fd5bb54..869a402 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.36 2000/07/19 22:15:29 ericm Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.37 2000/07/20 20:33:25 ericm Exp $ library tcl @@ -1388,25 +1388,6 @@ declare 402 generic { CONST Tcl_UniChar *pattern, int nocase) } -declare 403 generic { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, \ - CONST char *key) -} - -declare 404 generic { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, \ - CONST char *key, int *newPtr) -} - -declare 405 generic { - void Tcl_InitHashTableEx(Tcl_HashTable *tablePtr, int keyType, \ - Tcl_HashKeyType *typePtr) -} - -declare 406 generic { - void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) -} - ############################################################################## # Define the platform specific public Tcl interface. These functions are diff --git a/generic/tcl.h b/generic/tcl.h index 2add458..66debf6 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -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: tcl.h,v 1.73 2000/07/19 22:15:29 ericm Exp $ + * RCS: @(#) $Id: tcl.h,v 1.74 2000/07/20 20:33:25 ericm Exp $ */ #ifndef _TCL @@ -337,14 +337,6 @@ typedef long LONG; #endif /* - * This flag controls whether binary compatability is maintained with - * extensions built against a previous version of Tcl. - */ -#ifndef TCL_PRESERVE_BINARY_COMPATABILITY -#define TCL_PRESERVE_BINARY_COMPATABILITY 1 -#endif - -/* * Data structures defined opaquely in this module. The definitions below * just provide dummy types. A few fields are made visible in Tcl_Interp * structures, namely those used for returning a string result from @@ -950,30 +942,13 @@ typedef struct Tcl_DString { #define TCL_LINK_READ_ONLY 0x80 /* - * Forward declarations of Tcl_HashTable and related types. + * Forward declaration of Tcl_HashTable. Needed by some C++ compilers + * to prevent errors when the forward reference to Tcl_HashTable is + * encountered in the Tcl_HashEntry structure. */ -typedef struct Tcl_HashKeyType Tcl_HashKeyType; -typedef struct Tcl_HashTable Tcl_HashTable; -typedef struct Tcl_HashEntry Tcl_HashEntry; - -typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, - VOID *keyPtr)); -typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr, - Tcl_HashEntry *hPtr)); -typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, VOID *keyPtr)); -typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr)); - -/* - * This flag controls whether the hash table stores the hash of a key, or - * recalculates it. There should be no reason for turning this flag off - * as it is completely binary and source compatible unless you directly - * access the bucketPtr member of the Tcl_HashTableEntry structure. This - * member has been removed and the space used to store the hash value. - */ -#ifndef TCL_HASH_KEY_STORE_HASH -#define TCL_HASH_KEY_STORE_HASH 1 +#ifdef __cplusplus +struct Tcl_HashTable; #endif /* @@ -982,25 +957,14 @@ typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr)); * defined below. */ -struct Tcl_HashEntry { - Tcl_HashEntry *nextPtr; /* Pointer to next entry in this +typedef struct Tcl_HashEntry { + struct Tcl_HashEntry *nextPtr; /* Pointer to next entry in this * hash bucket, or NULL for end of * chain. */ - Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ -#if TCL_HASH_KEY_STORE_HASH -# if TCL_PRESERVE_BINARY_COMPATABILITY - VOID *hash; /* Hash value, stored as pointer to - * ensure that the offsets of the - * fields in this structure are not - * changed. */ -# else - unsigned int hash; /* Hash value. */ -# endif -#else - Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to + struct Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ + struct Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to * first entry in this entry's chain: * used for deleting the entry. */ -#endif ClientData clientData; /* Application stores something here * with Tcl_SetHashValue. */ union { /* Key has one of these forms: */ @@ -1014,72 +978,16 @@ struct Tcl_HashEntry { * will be as large as needed to hold * the key. */ } key; /* MUST BE LAST FIELD IN RECORD!! */ -}; +} Tcl_HashEntry; /* - * Flags used in Tcl_HashKeyType. - * - * TCL_HASH_KEY_RANDOMIZE_HASH: - * There are some things, pointers for example - * which don't hash well because they do not use - * the lower bits. If this flag is set then the - * hash table will attempt to rectify this by - * randomising the bits and then using the upper - * N bits as the index into the table. - */ -#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1 - -/* - * Structure definition for the methods associated with a hash table - * key type. - */ -#define TCL_HASH_KEY_TYPE_VERSION 1 -struct Tcl_HashKeyType { - int version; /* Version of the table. If this structure is - * extended in future then the version can be - * used to distinguish between different - * structures. - */ - - int flags; /* Flags, see above for details. */ - - /* Calculates a hash value for the key. If this is NULL then the pointer - * itself is used as a hash value. - */ - Tcl_HashKeyProc *hashKeyProc; - - /* Compares two keys and returns zero if they do not match, and non-zero - * if they do. If this is NULL then the pointers are compared. - */ - Tcl_CompareHashKeysProc *compareKeysProc; - - /* Called to allocate memory for a new entry, i.e. if the key is a - * string then this could allocate a single block which contains enough - * space for both the entry and the string. Only the key field of the - * allocated Tcl_HashEntry structure needs to be filled in. If something - * else needs to be done to the key, i.e. incrementing a reference count - * then that should be done by this function. If this is NULL then Tcl_Alloc - * is used to allocate enough space for a Tcl_HashEntry and the key pointer - * is assigned to key.oneWordValue. - */ - Tcl_AllocHashEntryProc *allocEntryProc; - - /* Called to free memory associated with an entry. If something else needs - * to be done to the key, i.e. decrementing a reference count then that - * should be done by this function. If this is NULL then Tcl_Free is used - * to free the Tcl_HashEntry. - */ - Tcl_FreeHashEntryProc *freeEntryProc; -}; - -/* * Structure definition for a hash table. Must be in tcl.h so clients * can allocate space for these structures, but clients should never * access any fields in this structure. */ #define TCL_SMALL_HASH_TABLE 4 -struct Tcl_HashTable { +typedef struct Tcl_HashTable { Tcl_HashEntry **buckets; /* Pointer to bucket array. Each * element points to first entry in * bucket's hash chain, or NULL. */ @@ -1098,20 +1006,16 @@ struct Tcl_HashTable { int mask; /* Mask value used in hashing * function. */ int keyType; /* Type of keys used in this table. - * It's either TCL_CUSTOM_KEYS, + * It's either TCL_OBJ_KEYS, * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * or an integer giving the number of * ints that is the size of the key. */ -#if TCL_PRESERVE_BINARY_COMPATABILITY - Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, + Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr, CONST char *key)); - Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, + Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)); -#endif - Tcl_HashKeyType *typePtr; /* Type of the keys used in the - * Tcl_HashTable. */ -}; +} Tcl_HashTable; /* * Structure definition for information used to keep track of searches @@ -1128,75 +1032,35 @@ typedef struct Tcl_HashSearch { /* * Acceptable key types for hash tables: - * - * TCL_STRING_KEYS: The keys are strings, they are copied into - * the entry. - * TCL_ONE_WORD_KEYS: The keys are pointers, the pointer is stored - * in the entry. - * TCL_CUSTOM_TYPE_KEYS: The keys are arbitrary types which are copied - * into the entry. - * TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the - * pointer is stored in the entry. - * - * While maintaining binary compatability the above have to be distinct - * values as they are used to differentiate between old versions of the - * hash table which don't have a typePtr and new ones which do. Once binary - * compatability is discarded in favour of making more wide spread changes - * TCL_STRING_KEYS can be the same as TCL_CUSTOM_TYPE_KEYS, and - * TCL_ONE_WORD_KEYS can be the same as TCL_CUSTOM_PTR_KEYS because they - * simply determine how the key is accessed from the entry and not the - * behaviour. */ +#define TCL_OBJ_KEYS -1 #define TCL_STRING_KEYS 0 #define TCL_ONE_WORD_KEYS 1 -#if TCL_PRESERVE_BINARY_COMPATABILITY -# define TCL_CUSTOM_TYPE_KEYS -2 -# define TCL_CUSTOM_PTR_KEYS -1 -#else -# define TCL_CUSTOM_TYPE_KEYS TCL_STRING_KEYS -# define TCL_CUSTOM_PTR_KEYS TCL_ONE_WORD_KEYS -#endif - /* * Macros for clients to use to access fields of hash entries: */ #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) -#if TCL_PRESERVE_BINARY_COMPATABILITY -# define Tcl_GetHashKey(tablePtr, h) \ - ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ - (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) -#else -# define Tcl_GetHashKey(tablePtr, h) \ - ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) -#endif +#define Tcl_GetHashKey(tablePtr, h) \ + ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ + (tablePtr)->keyType == TCL_OBJ_KEYS) \ + ? (h)->key.oneWordValue \ + : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create procedures * for hash tables: */ -#if TCL_PRESERVE_BINARY_COMPATABILITY -# define Tcl_FindHashEntry(tablePtr, key) \ +#define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, key) -# define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ +#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, key, newPtr) -#endif /* - * Macro to use new extended version of Tcl_InitHashTable. - */ -#define Tcl_InitHashTable(tablePtr, keyType) \ - Tcl_InitHashTableEx(tablePtr, keyType, NULL) - -/* * Flag values to pass to Tcl_DoOneEvent to disable searches * for some kinds of events: */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 098010b..15e94ed 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.37 2000/07/19 22:15:29 ericm Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.38 2000/07/20 20:33:25 ericm Exp $ */ #ifndef _TCLDECLS @@ -1254,20 +1254,6 @@ EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_(( EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_(( CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); -/* 403 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry _ANSI_ARGS_(( - Tcl_HashTable * tablePtr, CONST char * key)); -/* 404 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry _ANSI_ARGS_(( - Tcl_HashTable * tablePtr, CONST char * key, - int * newPtr)); -/* 405 */ -EXTERN void Tcl_InitHashTableEx _ANSI_ARGS_(( - Tcl_HashTable * tablePtr, int keyType, - Tcl_HashKeyType * typePtr)); -/* 406 */ -EXTERN void Tcl_InitObjHashTable _ANSI_ARGS_(( - Tcl_HashTable * tablePtr)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1738,10 +1724,6 @@ typedef struct TclStubs { int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 400 */ int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 401 */ int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); /* 402 */ - Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key)); /* 403 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 404 */ - void (*tcl_InitHashTableEx) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 405 */ - void (*tcl_InitObjHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 406 */ } TclStubs; #ifdef __cplusplus @@ -3399,22 +3381,6 @@ extern TclStubs *tclStubsPtr; #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 402 */ #endif -#ifndef Tcl_FindHashEntry -#define Tcl_FindHashEntry \ - (tclStubsPtr->tcl_FindHashEntry) /* 403 */ -#endif -#ifndef Tcl_CreateHashEntry -#define Tcl_CreateHashEntry \ - (tclStubsPtr->tcl_CreateHashEntry) /* 404 */ -#endif -#ifndef Tcl_InitHashTableEx -#define Tcl_InitHashTableEx \ - (tclStubsPtr->tcl_InitHashTableEx) /* 405 */ -#endif -#ifndef Tcl_InitObjHashTable -#define Tcl_InitObjHashTable \ - (tclStubsPtr->tcl_InitObjHashTable) /* 406 */ -#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclHash.c b/generic/tclHash.c index 026f730..3e8d0d8 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -10,27 +10,19 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclHash.c,v 1.5 2000/07/19 22:15:30 ericm Exp $ + * RCS: @(#) $Id: tclHash.c,v 1.6 2000/07/20 20:33:26 ericm Exp $ */ #include "tclInt.h" /* - * Prevent macros from clashing with function definitions. - */ - -#if TCL_PRESERVE_BINARY_COMPATABILITY -# undef Tcl_FindHashEntry -# undef Tcl_CreateHashEntry -#endif - -/* * When there are this many entries per bucket, on average, rebuild * the hash table to make it larger. */ #define REBUILD_MULTIPLIER 3 + /* * The following macro takes a preliminary integer hash value and * produces an index into a hash tables bucket list. The idea is @@ -43,86 +35,32 @@ (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) /* - * Prototypes for the array hash key methods. - */ - -static Tcl_HashEntry * AllocArrayEntry _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, - VOID *keyPtr)); -static int CompareArrayKeys _ANSI_ARGS_(( - VOID *keyPtr, Tcl_HashEntry *hPtr)); -static unsigned int HashArrayKey _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, - VOID *keyPtr)); - -/* - * Prototypes for the one word hash key methods. - */ - -#if 0 -static Tcl_HashEntry * AllocOneWordEntry _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, - VOID *keyPtr)); -static int CompareOneWordKeys _ANSI_ARGS_(( - VOID *keyPtr, Tcl_HashEntry *hPtr)); -static unsigned int HashOneWordKey _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, -#endif VOID *keyPtr)); - - -/* - * Prototypes for the string hash key methods. - */ - -static Tcl_HashEntry * AllocStringEntry _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, - VOID *keyPtr)); -static int CompareStringKeys _ANSI_ARGS_(( - VOID *keyPtr, Tcl_HashEntry *hPtr)); -static unsigned int HashStringKey _ANSI_ARGS_(( - Tcl_HashTable *tablePtr, - VOID *keyPtr)); - -/* * Procedure prototypes for static procedures in this file: */ -#if TCL_PRESERVE_BINARY_COMPATABILITY +static Tcl_HashEntry * ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key)); +static Tcl_HashEntry * ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key, int *newPtr)); static Tcl_HashEntry * BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key)); static Tcl_HashEntry * BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)); -#endif - +static unsigned int HashString _ANSI_ARGS_((CONST char *string)); static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr)); - -Tcl_HashKeyType tclArrayHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ - HashArrayKey, /* hashKeyProc */ - CompareArrayKeys, /* compareKeysProc */ - AllocArrayEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ -}; - -Tcl_HashKeyType tclOneWordHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - NULL, /* HashOneWordKey, */ /* hashProc */ - NULL, /* CompareOneWordKey, */ /* compareProc */ - NULL, /* AllocOneWordKey, */ /* allocEntryProc */ - NULL /* FreeOneWordKey, */ /* freeEntryProc */ -}; - -Tcl_HashKeyType tclStringHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - HashStringKey, /* hashKeyProc */ - CompareStringKeys, /* compareKeysProc */ - AllocStringEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ -}; - +static Tcl_HashEntry * StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key)); +static Tcl_HashEntry * StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key, int *newPtr)); +static Tcl_HashEntry * OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key)); +static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key, int *newPtr)); +static unsigned int HashObj _ANSI_ARGS_((Tcl_Obj *objPtr)); +static Tcl_HashEntry * ObjFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key)); +static Tcl_HashEntry * ObjCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key, int *newPtr)); /* *---------------------------------------------------------------------- @@ -142,7 +80,6 @@ Tcl_HashKeyType tclStringHashKeyType = { *---------------------------------------------------------------------- */ -#undef Tcl_InitHashTable void Tcl_InitHashTable(tablePtr, keyType) register Tcl_HashTable *tablePtr; /* Pointer to table record, which @@ -151,48 +88,8 @@ Tcl_InitHashTable(tablePtr, keyType) * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * or an integer >= 2. */ { - /* - * Use a special value to inform the extended version that it must - * not access any of the new fields in the Tcl_HashTable. If an - * extension is rebuilt then any calls to this function will be - * redirected to the extended version by a macro. - */ - Tcl_InitHashTableEx(tablePtr, keyType, (Tcl_HashKeyType *) -1); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_InitHashTableEx -- - * - * Given storage for a hash table, set up the fields to prepare - * the hash table for use. This is an extended version of - * Tcl_InitHashTableEx which supports user defined keys. - * - * Results: - * None. - * - * Side effects: - * TablePtr is now ready to be passed to Tcl_FindHashEntry and - * Tcl_CreateHashEntry. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_InitHashTableEx(tablePtr, keyType, typePtr) - register Tcl_HashTable *tablePtr; /* Pointer to table record, which - * is supplied by the caller. */ - int keyType; /* Type of keys to use in table: - * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, - * TCL_CUSTOM_TYPE_KEYS, - * TCL_CUSTOM_PTR_KEYS, or an - * integer >= 2. */ - Tcl_HashKeyType *typePtr; /* Pointer to structure which defines - * the behaviour of this table. */ -{ #if (TCL_SMALL_HASH_TABLE != 4) - panic("Tcl_InitHashTableEx: TCL_SMALL_HASH_TABLE is %d, not 4\n", + panic("Tcl_InitHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n", TCL_SMALL_HASH_TABLE); #endif @@ -205,280 +102,19 @@ Tcl_InitHashTableEx(tablePtr, keyType, typePtr) tablePtr->downShift = 28; tablePtr->mask = 3; tablePtr->keyType = keyType; -#if TCL_PRESERVE_BINARY_COMPATABILITY - tablePtr->findProc = Tcl_FindHashEntry; - tablePtr->createProc = Tcl_CreateHashEntry; - - if (typePtr == NULL) { - /* - * The caller has been rebuilt so the hash table is an extended - * version. - */ - } else if (typePtr != (Tcl_HashKeyType *) -1) { - /* - * The caller is requesting a customized hash table so it must be - * an extended version. - */ - tablePtr->typePtr = typePtr; - } else { - /* - * The caller has not been rebuilt so the hash table is not - * extended. - */ - } -#else - if (typePtr == NULL) { - /* - * Use the key type to decide which key type is needed. - */ - if (keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (keyType == TCL_CUSTOM_TYPE_KEYS) { - Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS"); - } else if (keyType == TCL_CUSTOM_PTR_KEYS) { - Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS"); - } else { - typePtr = &tclArrayHashKeyType; - } - } else if (typePtr == (Tcl_HashKeyType *) -1) { - /* - * If the caller has not been rebuilt then we cannot continue as - * the hash table is not an extended version. - */ - Tcl_Panic ("Hash table is not compatible"); - } - tablePtr->typePtr = typePtr; -#endif -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_FindHashEntry -- - * - * Given a hash table find the entry with a matching key. - * - * Results: - * The return value is a token for the matching entry in the - * hash table, or NULL if there was no matching entry. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_HashEntry * -Tcl_FindHashEntry(tablePtr, key) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find matching entry. */ -{ - register Tcl_HashEntry *hPtr; - Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; - -#if TCL_PRESERVE_BINARY_COMPATABILITY - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; + if (keyType == TCL_OBJ_KEYS) { + tablePtr->findProc = ObjFind; + tablePtr->createProc = ObjCreate; + } else if (keyType == TCL_STRING_KEYS) { + tablePtr->findProc = StringFind; + tablePtr->createProc = StringCreate; + } else if (keyType == TCL_ONE_WORD_KEYS) { + tablePtr->findProc = OneWordFind; + tablePtr->createProc = OneWordCreate; } else { - typePtr = &tclArrayHashKeyType; - } -#else - typePtr = tablePtr->typePtr; - if (typePtr == NULL) { - Tcl_Panic("called Tcl_FindHashEntry on deleted table"); - return NULL; - } -#endif - - if (typePtr->hashKeyProc) { - hash = typePtr->hashKeyProc (tablePtr, (VOID *) key); - if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX (tablePtr, hash); - } else { - index = hash & tablePtr->mask; - } - } else { - hash = (unsigned int) key; - index = RANDOM_INDEX (tablePtr, hash); - } - - /* - * Search all of the entries in the appropriate bucket. - */ - - if (typePtr->compareKeysProc) { - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { -#if TCL_HASH_KEY_STORE_HASH - if (hash != (unsigned int) hPtr->hash) { - continue; - } -#endif - if (typePtr->compareKeysProc ((VOID *) key, hPtr)) { - return hPtr; - } - } - } else { - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { -#if TCL_HASH_KEY_STORE_HASH - if (hash != (unsigned int) hPtr->hash) { - continue; - } -#endif - if (key == hPtr->key.oneWordValue) { - return hPtr; - } - } - } - - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_CreateHashEntry -- - * - * Given a hash table with string keys, and a string key, find - * the entry with a matching key. If there is no matching entry, - * then create a new entry that does match. - * - * Results: - * The return value is a pointer to the matching entry. If this - * is a newly-created entry, then *newPtr will be set to a non-zero - * value; otherwise *newPtr will be set to 0. If this is a new - * entry the value stored in the entry will initially be 0. - * - * Side effects: - * A new entry may be added to the hash table. - * - *---------------------------------------------------------------------- - */ - -Tcl_HashEntry * -Tcl_CreateHashEntry(tablePtr, key, newPtr) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find or create matching - * entry. */ - int *newPtr; /* Store info here telling whether a new - * entry was created. */ -{ - register Tcl_HashEntry *hPtr; - Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; - -#if TCL_PRESERVE_BINARY_COMPATABILITY - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; - } else { - typePtr = &tclArrayHashKeyType; - } -#else - typePtr = tablePtr->typePtr; - if (typePtr == NULL) { - Tcl_Panic("called Tcl_CreateHashEntry on deleted table"); - return NULL; - } -#endif - - if (typePtr->hashKeyProc) { - hash = typePtr->hashKeyProc (tablePtr, (VOID *) key); - if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX (tablePtr, hash); - } else { - index = hash & tablePtr->mask; - } - } else { - hash = (unsigned int) key; - index = RANDOM_INDEX (tablePtr, hash); - } - - /* - * Search all of the entries in the appropriate bucket. - */ - - if (typePtr->compareKeysProc) { - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { -#if TCL_HASH_KEY_STORE_HASH - if (hash != (unsigned int) hPtr->hash) { - continue; - } -#endif - if (typePtr->compareKeysProc ((VOID *) key, hPtr)) { - *newPtr = 0; - return hPtr; - } - } - } else { - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { -#if TCL_HASH_KEY_STORE_HASH - if (hash != (unsigned int) hPtr->hash) { - continue; - } -#endif - if (key == hPtr->key.oneWordValue) { - *newPtr = 0; - return hPtr; - } - } - } - - /* - * Entry not found. Add a new one to the bucket. - */ - - *newPtr = 1; - if (typePtr->allocEntryProc) { - hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key); - } else { - hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry)); - hPtr->key.oneWordValue = (char *) key; - } - - hPtr->tablePtr = tablePtr; -#if TCL_HASH_KEY_STORE_HASH -# if TCL_PRESERVE_BINARY_COMPATABILITY - hPtr->hash = (VOID *) hash; -# else - hPtr->hash = hash; -# endif - hPtr->nextPtr = tablePtr->buckets[index]; - tablePtr->buckets[index] = hPtr; -#else - hPtr->bucketPtr = &(tablePtr->buckets[index]); - hPtr->nextPtr = *hPtr->bucketPtr; - *hPtr->bucketPtr = hPtr; -#endif - hPtr->clientData = 0; - tablePtr->numEntries++; - - /* - * If the table has exceeded a decent size, rebuild it with many - * more buckets. - */ - - if (tablePtr->numEntries >= tablePtr->rebuildSize) { - RebuildTable(tablePtr); - } - return hPtr; + tablePtr->findProc = ArrayFind; + tablePtr->createProc = ArrayCreate; + }; } /* @@ -505,47 +141,11 @@ Tcl_DeleteHashEntry(entryPtr) Tcl_HashEntry *entryPtr; { register Tcl_HashEntry *prevPtr; - Tcl_HashKeyType *typePtr; - Tcl_HashTable *tablePtr; - Tcl_HashEntry **bucketPtr; -#if TCL_HASH_KEY_STORE_HASH - int index; -#endif - - tablePtr = entryPtr->tablePtr; -#if TCL_PRESERVE_BINARY_COMPATABILITY - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; + if (*entryPtr->bucketPtr == entryPtr) { + *entryPtr->bucketPtr = entryPtr->nextPtr; } else { - typePtr = &tclArrayHashKeyType; - } -#else - typePtr = tablePtr->typePtr; -#endif - -#if TCL_HASH_KEY_STORE_HASH - if (typePtr->hashKeyProc == NULL - || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX (tablePtr, entryPtr->hash); - } else { - index = ((unsigned int) entryPtr->hash) & tablePtr->mask; - } - - bucketPtr = &(tablePtr->buckets[index]); -#else - bucketPtr = entryPtr->bucketPtr; -#endif - - if (*bucketPtr == entryPtr) { - *bucketPtr = entryPtr->nextPtr; - } else { - for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) { + for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { panic("malformed bucket chain in Tcl_DeleteHashEntry"); } @@ -555,13 +155,12 @@ Tcl_DeleteHashEntry(entryPtr) } } } - - tablePtr->numEntries--; - if (typePtr->freeEntryProc) { - typePtr->freeEntryProc (entryPtr); - } else { - ckfree((char *) entryPtr); + + if (entryPtr->tablePtr->keyType == TCL_OBJ_KEYS) { + Tcl_DecrRefCount (entryPtr->key.objPtr); } + entryPtr->tablePtr->numEntries--; + ckfree((char *) entryPtr); } /* @@ -586,24 +185,8 @@ Tcl_DeleteHashTable(tablePtr) register Tcl_HashTable *tablePtr; /* Table to delete. */ { register Tcl_HashEntry *hPtr, *nextPtr; - Tcl_HashKeyType *typePtr; int i; -#if TCL_PRESERVE_BINARY_COMPATABILITY - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; - } else { - typePtr = &tclArrayHashKeyType; - } -#else - typePtr = tablePtr->typePtr; -#endif - /* * Free up all the entries in the table. */ @@ -612,11 +195,10 @@ Tcl_DeleteHashTable(tablePtr) hPtr = tablePtr->buckets[i]; while (hPtr != NULL) { nextPtr = hPtr->nextPtr; - if (typePtr->freeEntryProc) { - typePtr->freeEntryProc (hPtr); - } else { - ckfree((char *) hPtr); + if (tablePtr->keyType == TCL_OBJ_KEYS) { + Tcl_DecrRefCount (hPtr->key.objPtr); } + ckfree((char *) hPtr); hPtr = nextPtr; } } @@ -634,12 +216,8 @@ Tcl_DeleteHashTable(tablePtr) * re-initialization. */ -#if TCL_PRESERVE_BINARY_COMPATABILITY tablePtr->findProc = BogusFind; tablePtr->createProc = BogusCreate; -#else - tablePtr->typePtr = NULL; -#endif } /* @@ -792,12 +370,14 @@ Tcl_HashStats(tablePtr) /* *---------------------------------------------------------------------- * - * AllocArrayEntry -- + * HashString -- * - * Allocate space for a Tcl_HashEntry containing the array key. + * Compute a one-word summary of a text string, which can be + * used to generate a hash index. * * Results: - * The return value is a pointer to the created entry. + * The return value is a one-word summary of the information in + * string. * * Side effects: * None. @@ -805,39 +385,52 @@ Tcl_HashStats(tablePtr) *---------------------------------------------------------------------- */ -static Tcl_HashEntry * -AllocArrayEntry(tablePtr, keyPtr) - Tcl_HashTable *tablePtr; /* Hash table. */ - VOID *keyPtr; /* Key to store in the hash table entry. */ +static unsigned int +HashString(string) + register CONST char *string;/* String from which to compute hash value. */ { - int *array = (int *) keyPtr; - register int *iPtr1, *iPtr2; - Tcl_HashEntry *hPtr; - int count; + register unsigned int result; + register int c; - count = tablePtr->keyType; - - hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry) - + (count*sizeof(int)) - sizeof(hPtr->key))); - - for (iPtr1 = array, iPtr2 = hPtr->key.words; - count > 0; count--, iPtr1++, iPtr2++) { - *iPtr2 = *iPtr1; - } + /* + * 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. + */ - return hPtr; + result = 0; + while (1) { + c = *string; + string++; + if (c == 0) { + break; + } + result += (result<<3) + c; + } + return result; } /* *---------------------------------------------------------------------- * - * CompareArrayKeys -- + * StringFind -- * - * Compares two array keys. + * Given a hash table with string keys, and a string key, find + * the entry with a matching key. * * Results: - * The return value is 0 if they are different and 1 if they are - * the same. + * The return value is a token for the matching entry in the + * hash table, or NULL if there was no matching entry. * * Side effects: * None. @@ -845,38 +438,124 @@ AllocArrayEntry(tablePtr, keyPtr) *---------------------------------------------------------------------- */ -static int -CompareArrayKeys(keyPtr, hPtr) - VOID *keyPtr; /* New key to compare. */ - Tcl_HashEntry *hPtr; /* Existing key to compare. */ +static Tcl_HashEntry * +StringFind(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ { - register CONST char *iPtr1 = (CONST char *) keyPtr; - register CONST char *iPtr2 = (CONST char *) hPtr->key.words; - Tcl_HashTable *tablePtr = hPtr->tablePtr; - int count; - - for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { - if (count == 0) { - return 1; + register Tcl_HashEntry *hPtr; + register CONST char *p1, *p2; + int index; + + index = HashString(key) & tablePtr->mask; + + /* + * Search all of the entries in the appropriate bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) { + if (*p1 != *p2) { + break; + } + if (*p1 == '\0') { + return hPtr; + } } - if (*iPtr1 != *iPtr2) { - break; + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * StringCreate -- + * + * Given a hash table with string keys, and a string key, find + * the entry with a matching key. If there is no matching entry, + * then create a new entry that does match. + * + * Results: + * The return value is a pointer to the matching entry. If this + * is a newly-created entry, then *newPtr will be set to a non-zero + * value; otherwise *newPtr will be set to 0. If this is a new + * entry the value stored in the entry will initially be 0. + * + * Side effects: + * A new entry may be added to the hash table. + * + *---------------------------------------------------------------------- + */ + +static Tcl_HashEntry * +StringCreate(tablePtr, key, newPtr) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find or create matching + * entry. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ +{ + register Tcl_HashEntry *hPtr; + register CONST char *p1, *p2; + int index; + + index = HashString(key) & tablePtr->mask; + + /* + * Search all of the entries in this bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) { + if (*p1 != *p2) { + break; + } + if (*p1 == '\0') { + *newPtr = 0; + return hPtr; + } } } - return 0; + + /* + * Entry not found. Add a new one to the bucket. + */ + + *newPtr = 1; + hPtr = (Tcl_HashEntry *) ckalloc((unsigned) + (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1))); + hPtr->tablePtr = tablePtr; + hPtr->bucketPtr = &(tablePtr->buckets[index]); + hPtr->nextPtr = *hPtr->bucketPtr; + hPtr->clientData = 0; + strcpy(hPtr->key.string, key); + *hPtr->bucketPtr = hPtr; + tablePtr->numEntries++; + + /* + * If the table has exceeded a decent size, rebuild it with many + * more buckets. + */ + + if (tablePtr->numEntries >= tablePtr->rebuildSize) { + RebuildTable(tablePtr); + } + return hPtr; } /* *---------------------------------------------------------------------- * - * HashArrayKey -- + * OneWordFind -- * - * Compute a one-word summary of an array, which can be - * used to generate a hash index. + * Given a hash table with one-word keys, and a one-word key, find + * the entry with a matching key. * * Results: - * The return value is a one-word summary of the information in - * string. + * The return value is a token for the matching entry in the + * hash table, or NULL if there was no matching entry. * * Side effects: * None. @@ -884,63 +563,111 @@ CompareArrayKeys(keyPtr, hPtr) *---------------------------------------------------------------------- */ -static unsigned int -HashArrayKey(tablePtr, keyPtr) - Tcl_HashTable *tablePtr; /* Hash table. */ - VOID *keyPtr; /* Key from which to compute hash value. */ +static Tcl_HashEntry * +OneWordFind(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + register CONST char *key; /* Key to use to find matching entry. */ { - register CONST char *array = (CONST char *) keyPtr; - register unsigned int result; - int count; + register Tcl_HashEntry *hPtr; + int index; + + index = RANDOM_INDEX(tablePtr, key); - for (result = 0, count = tablePtr->keyType; count > 0; - count--, array++) { - result += *array; + /* + * Search all of the entries in the appropriate bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + if (hPtr->key.oneWordValue == key) { + return hPtr; + } } - return result; + return NULL; } /* *---------------------------------------------------------------------- * - * AllocStringEntry -- + * OneWordCreate -- * - * Allocate space for a Tcl_HashEntry containing the string key. + * Given a hash table with one-word keys, and a one-word key, find + * the entry with a matching key. If there is no matching entry, + * then create a new entry that does match. * * Results: - * The return value is a pointer to the created entry. + * The return value is a pointer to the matching entry. If this + * is a newly-created entry, then *newPtr will be set to a non-zero + * value; otherwise *newPtr will be set to 0. If this is a new + * entry the value stored in the entry will initially be 0. * * Side effects: - * None. + * A new entry may be added to the hash table. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * -AllocStringEntry(tablePtr, keyPtr) - Tcl_HashTable *tablePtr; /* Hash table. */ - VOID *keyPtr; /* Key to store in the hash table entry. */ +OneWordCreate(tablePtr, key, newPtr) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + register CONST char *key; /* Key to use to find or create matching + * entry. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ { - CONST char *string = (CONST char *) keyPtr; - Tcl_HashEntry *hPtr; + register Tcl_HashEntry *hPtr; + int index; - hPtr = (Tcl_HashEntry *) ckalloc((unsigned) - (sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key))); - strcpy(hPtr->key.string, string); + index = RANDOM_INDEX(tablePtr, key); + + /* + * Search all of the entries in this bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + if (hPtr->key.oneWordValue == key) { + *newPtr = 0; + return hPtr; + } + } + + /* + * Entry not found. Add a new one to the bucket. + */ + *newPtr = 1; + hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry)); + hPtr->tablePtr = tablePtr; + hPtr->bucketPtr = &(tablePtr->buckets[index]); + hPtr->nextPtr = *hPtr->bucketPtr; + hPtr->clientData = 0; + hPtr->key.oneWordValue = (char *) key; /* CONST XXXX */ + *hPtr->bucketPtr = hPtr; + tablePtr->numEntries++; + + /* + * If the table has exceeded a decent size, rebuild it with many + * more buckets. + */ + + if (tablePtr->numEntries >= tablePtr->rebuildSize) { + RebuildTable(tablePtr); + } return hPtr; } /* *---------------------------------------------------------------------- * - * CompareStringKeys -- + * ArrayFind -- * - * Compares two string keys. + * Given a hash table with array-of-int keys, and a key, find + * the entry with a matching key. * * Results: - * The return value is 0 if they are different and 1 if they are - * the same. + * The return value is a token for the matching entry in the + * hash table, or NULL if there was no matching entry. * * Side effects: * None. @@ -948,36 +675,198 @@ AllocStringEntry(tablePtr, keyPtr) *---------------------------------------------------------------------- */ -static int -CompareStringKeys(keyPtr, hPtr) - VOID *keyPtr; /* New key to compare. */ - Tcl_HashEntry *hPtr; /* Existing key to compare. */ +static Tcl_HashEntry * +ArrayFind(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ { - register CONST char *p1 = (CONST char *) keyPtr; - register CONST char *p2 = (CONST char *) hPtr->key.string; + register Tcl_HashEntry *hPtr; + int *arrayPtr = (int *) key; + register int *iPtr1, *iPtr2; + int index, count; - for (;; p1++, p2++) { - if (*p1 != *p2) { - break; + for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr; + count > 0; count--, iPtr1++) { + index += *iPtr1; + } + index = RANDOM_INDEX(tablePtr, index); + + /* + * Search all of the entries in the appropriate bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, + count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { + if (count == 0) { + return hPtr; + } + if (*iPtr1 != *iPtr2) { + break; + } } - if (*p1 == '\0') { - return 1; + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ArrayCreate -- + * + * Given a hash table with one-word keys, and a one-word key, find + * the entry with a matching key. If there is no matching entry, + * then create a new entry that does match. + * + * Results: + * The return value is a pointer to the matching entry. If this + * is a newly-created entry, then *newPtr will be set to a non-zero + * value; otherwise *newPtr will be set to 0. If this is a new + * entry the value stored in the entry will initially be 0. + * + * Side effects: + * A new entry may be added to the hash table. + * + *---------------------------------------------------------------------- + */ + +static Tcl_HashEntry * +ArrayCreate(tablePtr, key, newPtr) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + register CONST char *key; /* Key to use to find or create matching + * entry. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ +{ + register Tcl_HashEntry *hPtr; + int *arrayPtr = (int *) key; + register int *iPtr1, *iPtr2; + int index, count; + + for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr; + count > 0; count--, iPtr1++) { + index += *iPtr1; + } + index = RANDOM_INDEX(tablePtr, index); + + /* + * Search all of the entries in the appropriate bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, + count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { + if (count == 0) { + *newPtr = 0; + return hPtr; + } + if (*iPtr1 != *iPtr2) { + break; + } } } - return 0; + + /* + * Entry not found. Add a new one to the bucket. + */ + + *newPtr = 1; + hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry) + + (tablePtr->keyType*sizeof(int)) - 4)); + hPtr->tablePtr = tablePtr; + hPtr->bucketPtr = &(tablePtr->buckets[index]); + hPtr->nextPtr = *hPtr->bucketPtr; + hPtr->clientData = 0; + for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType; + count > 0; count--, iPtr1++, iPtr2++) { + *iPtr2 = *iPtr1; + } + *hPtr->bucketPtr = hPtr; + tablePtr->numEntries++; + + /* + * If the table has exceeded a decent size, rebuild it with many + * more buckets. + */ + + if (tablePtr->numEntries >= tablePtr->rebuildSize) { + RebuildTable(tablePtr); + } + return hPtr; } /* *---------------------------------------------------------------------- * - * HashStringKey -- + * BogusFind -- * - * Compute a one-word summary of a text string, which can be - * used to generate a hash index. + * This procedure is invoked when an Tcl_FindHashEntry is called + * on a table that has been deleted. + * + * Results: + * If panic returns (which it shouldn't) this procedure returns + * NULL. + * + * Side effects: + * Generates a panic. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static Tcl_HashEntry * +BogusFind(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ +{ + panic("called Tcl_FindHashEntry on deleted table"); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * BogusCreate -- + * + * This procedure is invoked when an Tcl_CreateHashEntry is called + * on a table that has been deleted. + * + * Results: + * If panic returns (which it shouldn't) this procedure returns + * NULL. + * + * Side effects: + * Generates a panic. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static Tcl_HashEntry * +BogusCreate(tablePtr, key, newPtr) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find or create matching + * entry. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ +{ + panic("called Tcl_CreateHashEntry on deleted table"); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * HashObj -- + * + * 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 - * string. + * the string representation of the Tcl_Obj. * * Side effects: * None. @@ -986,14 +875,17 @@ CompareStringKeys(keyPtr, hPtr) */ static unsigned int -HashStringKey(tablePtr, keyPtr) - Tcl_HashTable *tablePtr; /* Hash table. */ - VOID *keyPtr; /* Key from which to compute hash value. */ +HashObj(objPtr) + Tcl_Obj *objPtr; { - register CONST char *string = (CONST char *) keyPtr; + register CONST char *string; + register int length; register unsigned int result; register int c; + string = Tcl_GetStringFromObj (objPtr, NULL); + length = objPtr->length; + /* * I tried a zillion different hash functions and asked many other * people for advice. Many people had their own favorite functions, @@ -1011,10 +903,11 @@ HashStringKey(tablePtr, keyPtr) */ result = 0; - while (1) { + while (length) { c = *string; string++; - if (c == 0) { + length--; + if (length == 0) { break; } result += (result<<3) + c; @@ -1022,66 +915,174 @@ HashStringKey(tablePtr, keyPtr) return result; } -#if TCL_PRESERVE_BINARY_COMPATABILITY /* *---------------------------------------------------------------------- * - * BogusFind -- + * ObjFind -- * - * This procedure is invoked when an Tcl_FindHashEntry is called - * on a table that has been deleted. + * Given a hash table with string keys, and a string key, find + * the entry with a matching key. * * Results: - * If panic returns (which it shouldn't) this procedure returns - * NULL. + * The return value is a token for the matching entry in the + * hash table, or NULL if there was no matching entry. * * Side effects: - * Generates a panic. + * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static Tcl_HashEntry * -BogusFind(tablePtr, key) +ObjFind(tablePtr, key) Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ CONST char *key; /* Key to use to find matching entry. */ { - panic("called Tcl_FindHashEntry on deleted table"); + Tcl_Obj *objPtr = (Tcl_Obj *) key; + register Tcl_HashEntry *hPtr; + register CONST char *p1, *p2; + register int l1, l2; + int index; + + index = HashObj(objPtr) & tablePtr->mask; + + /* + * Search all of the entries in the appropriate bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + /* + * If the object pointers are the same then they match. + */ + if (objPtr == hPtr->key.objPtr) { + return hPtr; + } + + p1 = Tcl_GetStringFromObj (objPtr, (int *) 0); + l1 = objPtr->length; + p2 = Tcl_GetStringFromObj (hPtr->key.objPtr, (int *) 0); + l2 = hPtr->key.objPtr->length; + + /* + * If the lengths are different then they do not match. + */ + if (l1 != l2) { + continue; + } + + for (;; p1++, p2++, l1--) { + if (*p1 != *p2) { + break; + } + if (l1 == 0) { + return hPtr; + } + } + } return NULL; } /* *---------------------------------------------------------------------- * - * BogusCreate -- + * ObjCreate -- * - * This procedure is invoked when an Tcl_CreateHashEntry is called - * on a table that has been deleted. + * Given a hash table with string keys, and a string key, find + * the entry with a matching key. If there is no matching entry, + * then create a new entry that does match. * * Results: - * If panic returns (which it shouldn't) this procedure returns - * NULL. + * The return value is a pointer to the matching entry. If this + * is a newly-created entry, then *newPtr will be set to a non-zero + * value; otherwise *newPtr will be set to 0. If this is a new + * entry the value stored in the entry will initially be 0. * * Side effects: - * Generates a panic. + * A new entry may be added to the hash table. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static Tcl_HashEntry * -BogusCreate(tablePtr, key, newPtr) +ObjCreate(tablePtr, key, newPtr) Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ CONST char *key; /* Key to use to find or create matching * entry. */ int *newPtr; /* Store info here telling whether a new * entry was created. */ { - panic("called Tcl_CreateHashEntry on deleted table"); - return NULL; + Tcl_Obj *objPtr = (Tcl_Obj *) key; + register Tcl_HashEntry *hPtr; + register CONST char *p1, *p2; + register int l1, l2; + int index; + + index = HashObj(objPtr) & tablePtr->mask; + + /* + * Search all of the entries in this bucket. + */ + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { + /* + * If the object pointers are the same then they match. + */ + if (objPtr == hPtr->key.objPtr) { + *newPtr = 0; + return hPtr; + } + + p1 = Tcl_GetStringFromObj (objPtr, (int *) 0); + l1 = objPtr->length; + p2 = Tcl_GetStringFromObj (hPtr->key.objPtr, (int *) 0); + l2 = hPtr->key.objPtr->length; + + /* + * If the lengths are different then they do not match. + */ + if (l1 != l2) { + continue; + } + + for (;; p1++, p2++, l1--) { + if (*p1 != *p2) { + break; + } + if (l1 == 0) { + *newPtr = 0; + return hPtr; + } + } + } + + /* + * Entry not found. Add a new one to the bucket. + */ + + *newPtr = 1; + hPtr = (Tcl_HashEntry *) + Tcl_Alloc((unsigned) sizeof(Tcl_HashEntry)); + hPtr->tablePtr = tablePtr; + hPtr->bucketPtr = &(tablePtr->buckets[index]); + hPtr->nextPtr = *hPtr->bucketPtr; + hPtr->clientData = 0; + hPtr->key.objPtr = objPtr; + Tcl_IncrRefCount (objPtr); + *hPtr->bucketPtr = hPtr; + tablePtr->numEntries++; + + /* + * If the table has exceeded a decent size, rebuild it with many + * more buckets. + */ + + if (tablePtr->numEntries >= tablePtr->rebuildSize) { + RebuildTable(tablePtr); + } + return hPtr; } -#endif /* *---------------------------------------------------------------------- @@ -1111,8 +1112,6 @@ RebuildTable(tablePtr) Tcl_HashEntry **oldBuckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; - Tcl_HashKeyType *typePtr; - VOID *key; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -1133,21 +1132,6 @@ RebuildTable(tablePtr) tablePtr->downShift -= 2; tablePtr->mask = (tablePtr->mask << 2) + 3; -#if TCL_PRESERVE_BINARY_COMPATABILITY - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; - } else { - typePtr = &tclArrayHashKeyType; - } -#else - typePtr = tablePtr->typePtr; -#endif - /* * Rehash all of the existing entries into the new bucket array. */ @@ -1155,35 +1139,25 @@ RebuildTable(tablePtr) for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) { for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) { *oldChainPtr = hPtr->nextPtr; - - key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr); - -#if TCL_HASH_KEY_STORE_HASH - if (typePtr->hashKeyProc == NULL - || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX (tablePtr, hPtr->hash); + if (tablePtr->keyType == TCL_OBJ_KEYS) { + index = HashObj(hPtr->key.objPtr) & tablePtr->mask; + } else if (tablePtr->keyType == TCL_STRING_KEYS) { + index = HashString(hPtr->key.string) & tablePtr->mask; + } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { + index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue); } else { - index = ((unsigned int) hPtr->hash) & tablePtr->mask; - } - hPtr->nextPtr = tablePtr->buckets[index]; - tablePtr->buckets[index] = hPtr; -#else - if (typePtr->hashKeyProc) { - unsigned int hash; - hash = typePtr->hashKeyProc (tablePtr, (VOID *) key); - if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX (tablePtr, hash); - } else { - index = hash & tablePtr->mask; + register int *iPtr; + int count; + + for (index = 0, count = tablePtr->keyType, + iPtr = hPtr->key.words; count > 0; count--, iPtr++) { + index += *iPtr; } - } else { - index = RANDOM_INDEX (tablePtr, key); + index = RANDOM_INDEX(tablePtr, index); } - hPtr->bucketPtr = &(tablePtr->buckets[index]); hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; -#endif } } diff --git a/generic/tclInt.h b/generic/tclInt.h index b513b45..faf48e4 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.46 2000/07/19 22:15:30 ericm Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.47 2000/07/20 20:33:26 ericm Exp $ */ #ifndef _TCLINT @@ -1540,15 +1540,6 @@ extern Tcl_ObjType tclProcBodyType; extern Tcl_ObjType tclStringType; /* - * Variables denoting the hash key types defined in the core. - */ - -extern Tcl_HashKeyType tclArrayHashKeyType; -extern Tcl_HashKeyType tclOneWordHashKeyType; -extern Tcl_HashKeyType tclStringHashKeyType; -extern Tcl_HashKeyType tclObjHashKeyType; - -/* * The head of the list of free Tcl objects, and the total number of Tcl * objects ever allocated and freed. */ 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; -} diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ad68ecf..0389de8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.39 2000/07/19 22:15:31 ericm Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.40 2000/07/20 20:33:27 ericm Exp $ */ #include "tclInt.h" @@ -31,10 +31,6 @@ #undef Tcl_NewStringObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory -#if TCL_PRESERVE_BINARY_COMPATABILITY -# undef Tcl_FindHashEntry -# undef Tcl_CreateHashEntry -#endif /* * WARNING: The contents of this file is automatically generated by the @@ -805,10 +801,6 @@ TclStubs tclStubs = { Tcl_IsChannelExisting, /* 400 */ Tcl_UniCharNcasecmp, /* 401 */ Tcl_UniCharCaseMatch, /* 402 */ - Tcl_FindHashEntry, /* 403 */ - Tcl_CreateHashEntry, /* 404 */ - Tcl_InitHashTableEx, /* 405 */ - Tcl_InitObjHashTable, /* 406 */ }; /* !END!: Do not edit above this line. */ |