summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--doc/Hash.3113
-rw-r--r--generic/tcl.decls21
-rw-r--r--generic/tcl.h184
-rw-r--r--generic/tclDecls.h36
-rw-r--r--generic/tclHash.c1216
-rw-r--r--generic/tclInt.h11
-rw-r--r--generic/tclObj.c290
-rw-r--r--generic/tclStubInit.c10
9 files changed, 1226 insertions, 665 deletions
diff --git a/ChangeLog b/ChangeLog
index f7ae1b7..fd90195 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
2000-07-21 Eric Melski <ericm@ajubasolutions.com>
+ * generic/tclStubInit.c:
+ * generic/tclObj.c:
+ * generic/tclInt.h:
+ * generic/tclHash.c:
+ * generic/tclDecls.h:
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * doc/Hash.3: Reapplied patch from Paul Duffin to extend hash tables
+ to allow custom key types, such as Tcl_Obj *'s, and others.
+
* doc/binary.n: Noted that the example in the introduction assumes a
32-bit system [Bug: 6035].
diff --git a/doc/Hash.3 b/doc/Hash.3
index 2410a45..7cbd243 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -5,19 +5,23 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Hash.3,v 1.6 2000/07/20 20:33:24 ericm Exp $
+'\" RCS: @(#) $Id: Hash.3,v 1.7 2000/07/22 01:53:23 ericm Exp $
'\"
.so man.macros
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_InitHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
+Tcl_InitHashTable, Tcl_InitHashTableEx, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_InitHashTable\fR(\fItablePtr, keyType\fR)
.sp
+\fBTcl_InitHashTableEx\fR(\fItablePtr, keyType, typePtr\fR)
+.sp
+\fBTcl_InitObjHashTable\fR(\fItablePtr\fR)
+.sp
\fBTcl_DeleteHashTable\fR(\fItablePtr\fR)
.sp
Tcl_HashEntry *
@@ -52,8 +56,10 @@ Address of hash table structure (for all procedures but
previous call to \fBTcl_InitHashTable\fR).
.AP int keyType in
Kind of keys to use for new hash table. Must be either
-TCL_STRING_KEYS, TCL_OBJ_KEYS, TCL_ONE_WORD_KEYS, or an integer value
-greater than 1.
+TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, TCL_CUSTOM_TYPE_KEYS,
+TCL_CUSTOM_PTR_KEYS, or an integer value greater than 1.
+.AP Tcl_HashKeyType *typePtr in
+Address of structure which defines the behaviour of the hash table.
.AP char *key in
Key to use for probe into table. Exact form depends on
\fIkeyType\fR used to create table.
@@ -96,7 +102,10 @@ on average.
This allows for fast lookups regardless of the number of entries
in a table.
.PP
-\fBTcl_InitHashTable\fR initializes a structure that describes
+\fBTcl_InitHashTable\fR calls the extended function
+\fBTcl_InitHashTableEx\fR with a NULL \fItypePtr\fR.
+.PP
+\fBTcl_InitHashTableEx\fR initializes a structure that describes
a new hash table.
The space for the structure is provided by the caller, not by
the hash module.
@@ -107,18 +116,22 @@ one of the following values:
Keys are null-terminated ASCII strings.
They are passed to hashing routines using the address of the
first character of the string.
-.IP \fBTCL_OBJ_KEYS\fR 25
-Keys are Tcl_Obj *. Hashing and comparison are done on the string
-representation of the object. The differences between this type and
-TCL_STRING_KEYS are: the key is not copied, instead the reference
-count is incremented; and the extra information associated with the
-Tcl_Obj * is used to optimize comparisons. The string is only
-compared if the two Tcl_Obj * are different and have the same length.
.IP \fBTCL_ONE_WORD_KEYS\fR 25
Keys are single-word values; they are passed to hashing routines
and stored in hash table entries as ``char *'' values.
The pointer value is the key; it need not (and usually doesn't)
actually point to a string.
+.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
+Keys are of arbitrary type, and are stored in the entry. Hashing
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
+\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
+
+.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
+Keys are pointers to arbitrary type, and the are stored in the entry. Hashing
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
+\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fIother\fR 25
If \fIkeyType\fR is not one of the above,
then it must be an integer value greater than 1.
@@ -129,6 +142,9 @@ All keys must have the same size.
Array keys are passed into hashing functions using the address
of the first int in the array.
.PP
+\fBTcl_InitObjHashTable\fR uses \fBTcl_InitHashTableEx\fR to
+initialize a hash table whose keys are Tcl_Obj *.
+.PP
\fBTcl_DeleteHashTable\fR deletes all of the entries in a hash
table and frees up the memory associated with the table's
bucket array and entries.
@@ -211,5 +227,78 @@ However, users of the hashing routines should never refer directly
to any of the fields of any of the hash-related data structures;
use the procedures and macros defined here.
+.SH "THE TCL_HASHKEYTYPE STRUCTURE"
+.PP
+Extension writers can define new hash key types by defining four
+procedure, initializing a Tcl_HashKeyType structure to describe
+the type, and calling \fBTcl_InitHashTableEx\fR.
+The \fBTcl_HashKeyType\fR structure is defined as follows:
+.CS
+typedef struct Tcl_HashKeyType {
+ int \fIversion\fR;
+ int \fIflags\fR;
+ Tcl_HashKeyProc *\fIhashKeyProc\fR;
+ Tcl_CompareHashKeysProc *\fIcompareKeysProc\fR;
+ Tcl_AllocHashEntryProc *\fIallocEntryProc\fR;
+ Tcl_FreeHashEntryProc *\fIfreeEntryProc\fR;
+} Tcl_HashKeyType;
+.CE
+.PP
+The \fIversion\fR member is the version of the table. If this
+structure is extended in future then the version can be used
+to distinguish between different structures. It should be set
+to \fBTCL_HASH_KEY_TYPE_VERSION\fR.
+.PP
+The \fIflags\fR member is one or more of the following OR'ed together:
+.IP \fBTCL_HASH_KEY_RANDOMIZE_HASH\fR 25
+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.
+.PP
+The \fIhashKeyProc\fR member contains the address of a function
+called to calculate a hash value for the key.
+.CS
+typedef unsigned int (Tcl_HashKeyProc) (
+ Tcl_HashTable *\fItablePtr\fR,
+ VOID *\fIkeyPtr\fR);
+.CE
+If this is NULL then \fIkeyPtr\fR is used and
+\fBTCL_HASH_KEY_RANDOMIZE_HASH\fR is assumed.
+.PP
+The \fIcompareKeysProc\fR member contains the address of a function
+called to compare two keys.
+.CS
+typedef int (Tcl_CompareHashKeysProc) (VOID *\fIkeyPtr\fR,
+ Tcl_HashEntry *\fIhPtr\fR);
+.CE
+If this is NULL then the \fIkeyPtr\fR pointers are compared.
+If the keys don't match then the function returns 0, otherwise
+it returns 1.
+.PP
+The \fIallocEntryProc\fR member contains the address of a function
+called to allocate space for an entry and initialise the key.
+.CS
+typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) (
+ Tcl_HashTable *\fItablePtr\fR, VOID *\fIkeyPtr\fR);
+.CE
+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.
+String keys and array keys use this function to allocate enough
+space for the entry and the key in one block, rather than doing
+it in two blocks. This saves space for a pointer to the key from
+the entry and another memory allocation. Tcl_Obj * keys use this
+function to allocate enough space for an entry and increment the
+reference count on the object.
+If
+.PP
+The \fIfreeEntryProc\fR member contains the address of a function
+called to free space for an entry.
+.CS
+typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *\fIhPtr\fR);
+.CE
+If this is NULL then Tcl_Free is used to free the space for the
+entry. Tcl_Obj * keys use this function to decrement the
+reference count on the object.
.SH KEYWORDS
hash table, key, lookup, search, value
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 869a402..ea5b6d2 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.37 2000/07/20 20:33:25 ericm Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.38 2000/07/22 01:53:23 ericm Exp $
library tcl
@@ -1388,6 +1388,25 @@ 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 66debf6..9b837c9 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.74 2000/07/20 20:33:25 ericm Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.75 2000/07/22 01:53:23 ericm Exp $
*/
#ifndef _TCL
@@ -337,6 +337,14 @@ 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
@@ -942,13 +950,30 @@ typedef struct Tcl_DString {
#define TCL_LINK_READ_ONLY 0x80
/*
- * 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.
+ * Forward declarations of Tcl_HashTable and related types.
*/
-#ifdef __cplusplus
-struct Tcl_HashTable;
+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
#endif
/*
@@ -957,14 +982,25 @@ struct Tcl_HashTable;
* defined below.
*/
-typedef struct Tcl_HashEntry {
- struct Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
+struct Tcl_HashEntry {
+ Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
* hash bucket, or NULL for end of
* chain. */
- struct Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
- struct Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to
+ 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
* 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: */
@@ -978,16 +1014,72 @@ typedef 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
-typedef struct Tcl_HashTable {
+struct Tcl_HashTable {
Tcl_HashEntry **buckets; /* Pointer to bucket array. Each
* element points to first entry in
* bucket's hash chain, or NULL. */
@@ -1006,16 +1098,20 @@ typedef struct Tcl_HashTable {
int mask; /* Mask value used in hashing
* function. */
int keyType; /* Type of keys used in this table.
- * It's either TCL_OBJ_KEYS,
+ * It's either TCL_CUSTOM_KEYS,
* TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
* or an integer giving the number of
* ints that is the size of the key.
*/
- Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+ Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
CONST char *key));
- Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+ Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
CONST char *key, int *newPtr));
-} Tcl_HashTable;
+#endif
+ Tcl_HashKeyType *typePtr; /* Type of the keys used in the
+ * Tcl_HashTable. */
+};
/*
* Structure definition for information used to keep track of searches
@@ -1032,35 +1128,75 @@ 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))
-#define Tcl_GetHashKey(tablePtr, h) \
- ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
- (tablePtr)->keyType == TCL_OBJ_KEYS) \
- ? (h)->key.oneWordValue \
- : (h)->key.string))
+#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
/*
* Macros to use for clients to use to invoke find and create procedures
* for hash tables:
*/
-#define Tcl_FindHashEntry(tablePtr, key) \
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+# 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 15e94ed..8b041c7 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.38 2000/07/20 20:33:25 ericm Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.39 2000/07/22 01:53:24 ericm Exp $
*/
#ifndef _TCLDECLS
@@ -1254,6 +1254,20 @@ 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;
@@ -1724,6 +1738,10 @@ 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
@@ -3381,6 +3399,22 @@ 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 3e8d0d8..0171216 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -10,19 +10,27 @@
* 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.6 2000/07/20 20:33:26 ericm Exp $
+ * RCS: @(#) $Id: tclHash.c,v 1.7 2000/07/22 01:53:24 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
@@ -35,32 +43,86 @@
(((((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:
*/
-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));
+#if TCL_PRESERVE_BINARY_COMPATABILITY
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));
-static unsigned int HashString _ANSI_ARGS_((CONST char *string));
+#endif
+
static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-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));
+
+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 */
+};
+
/*
*----------------------------------------------------------------------
@@ -80,6 +142,7 @@ static Tcl_HashEntry * ObjCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
*----------------------------------------------------------------------
*/
+#undef Tcl_InitHashTable
void
Tcl_InitHashTable(tablePtr, keyType)
register Tcl_HashTable *tablePtr; /* Pointer to table record, which
@@ -88,8 +151,48 @@ 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_InitHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+ panic("Tcl_InitHashTableEx: TCL_SMALL_HASH_TABLE is %d, not 4\n",
TCL_SMALL_HASH_TABLE);
#endif
@@ -102,19 +205,280 @@ Tcl_InitHashTable(tablePtr, keyType)
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
- 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;
+#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;
} else {
- tablePtr->findProc = ArrayFind;
- tablePtr->createProc = ArrayCreate;
- };
+ 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;
}
/*
@@ -141,11 +505,47 @@ 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 (*entryPtr->bucketPtr == entryPtr) {
- *entryPtr->bucketPtr = entryPtr->nextPtr;
+#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 {
- for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
+ 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) {
if (prevPtr == NULL) {
panic("malformed bucket chain in Tcl_DeleteHashEntry");
}
@@ -155,12 +555,13 @@ Tcl_DeleteHashEntry(entryPtr)
}
}
}
-
- if (entryPtr->tablePtr->keyType == TCL_OBJ_KEYS) {
- Tcl_DecrRefCount (entryPtr->key.objPtr);
+
+ tablePtr->numEntries--;
+ if (typePtr->freeEntryProc) {
+ typePtr->freeEntryProc (entryPtr);
+ } else {
+ ckfree((char *) entryPtr);
}
- entryPtr->tablePtr->numEntries--;
- ckfree((char *) entryPtr);
}
/*
@@ -185,8 +586,24 @@ 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.
*/
@@ -195,10 +612,11 @@ Tcl_DeleteHashTable(tablePtr)
hPtr = tablePtr->buckets[i];
while (hPtr != NULL) {
nextPtr = hPtr->nextPtr;
- if (tablePtr->keyType == TCL_OBJ_KEYS) {
- Tcl_DecrRefCount (hPtr->key.objPtr);
+ if (typePtr->freeEntryProc) {
+ typePtr->freeEntryProc (hPtr);
+ } else {
+ ckfree((char *) hPtr);
}
- ckfree((char *) hPtr);
hPtr = nextPtr;
}
}
@@ -216,8 +634,12 @@ Tcl_DeleteHashTable(tablePtr)
* re-initialization.
*/
+#if TCL_PRESERVE_BINARY_COMPATABILITY
tablePtr->findProc = BogusFind;
tablePtr->createProc = BogusCreate;
+#else
+ tablePtr->typePtr = NULL;
+#endif
}
/*
@@ -370,14 +792,12 @@ Tcl_HashStats(tablePtr)
/*
*----------------------------------------------------------------------
*
- * HashString --
+ * AllocArrayEntry --
*
- * Compute a one-word summary of a text string, which can be
- * used to generate a hash index.
+ * Allocate space for a Tcl_HashEntry containing the array key.
*
* Results:
- * The return value is a one-word summary of the information in
- * string.
+ * The return value is a pointer to the created entry.
*
* Side effects:
* None.
@@ -385,52 +805,39 @@ Tcl_HashStats(tablePtr)
*----------------------------------------------------------------------
*/
-static unsigned int
-HashString(string)
- register CONST char *string;/* String from which to compute hash value. */
+static Tcl_HashEntry *
+AllocArrayEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
{
- register unsigned int result;
- register int c;
-
- /*
- * 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.
- */
+ int *array = (int *) keyPtr;
+ register int *iPtr1, *iPtr2;
+ Tcl_HashEntry *hPtr;
+ int count;
- result = 0;
- while (1) {
- c = *string;
- string++;
- if (c == 0) {
- break;
- }
- result += (result<<3) + 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;
}
- return result;
+
+ return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * StringFind --
+ * CompareArrayKeys --
*
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key.
+ * Compares two array keys.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is 0 if they are different and 1 if they are
+ * the same.
*
* Side effects:
* None.
@@ -438,124 +845,38 @@ HashString(string)
*----------------------------------------------------------------------
*/
-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. */
+static int
+CompareArrayKeys(keyPtr, hPtr)
+ VOID *keyPtr; /* New key to compare. */
+ Tcl_HashEntry *hPtr; /* Existing key to compare. */
{
- 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;
- }
+ register CONST int *iPtr1 = (CONST int *) keyPtr;
+ register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
+ Tcl_HashTable *tablePtr = hPtr->tablePtr;
+ int count;
+
+ for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+ if (count == 0) {
+ return 1;
}
- }
- 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;
- }
+ if (*iPtr1 != *iPtr2) {
+ break;
}
}
-
- /*
- * 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;
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * OneWordFind --
+ * HashArrayKey --
*
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key.
+ * Compute a one-word summary of an array, which can be
+ * used to generate a hash index.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is a one-word summary of the information in
+ * string.
*
* Side effects:
* None.
@@ -563,111 +884,63 @@ StringCreate(tablePtr, key, newPtr)
*----------------------------------------------------------------------
*/
-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. */
+static unsigned int
+HashArrayKey(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key from which to compute hash value. */
{
- register Tcl_HashEntry *hPtr;
- int index;
-
- index = RANDOM_INDEX(tablePtr, key);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
+ register CONST int *array = (CONST int *) keyPtr;
+ register unsigned int result;
+ int count;
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- if (hPtr->key.oneWordValue == key) {
- return hPtr;
- }
+ for (result = 0, count = tablePtr->keyType; count > 0;
+ count--, array++) {
+ result += *array;
}
- return NULL;
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * OneWordCreate --
+ * AllocStringEntry --
*
- * 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.
+ * Allocate space for a Tcl_HashEntry containing the string key.
*
* 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.
+ * The return value is a pointer to the created entry.
*
* Side effects:
- * A new entry may be added to the hash table.
+ * None.
*
*----------------------------------------------------------------------
*/
static Tcl_HashEntry *
-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. */
+AllocStringEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
{
- register Tcl_HashEntry *hPtr;
- int index;
-
- 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++;
+ CONST char *string = (CONST char *) keyPtr;
+ Tcl_HashEntry *hPtr;
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
+ hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
+ (sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key)));
+ strcpy(hPtr->key.string, string);
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * ArrayFind --
+ * CompareStringKeys --
*
- * Given a hash table with array-of-int keys, and a key, find
- * the entry with a matching key.
+ * Compares two string keys.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is 0 if they are different and 1 if they are
+ * the same.
*
* Side effects:
* None.
@@ -675,198 +948,36 @@ OneWordCreate(tablePtr, key, newPtr)
*----------------------------------------------------------------------
*/
-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. */
+static int
+CompareStringKeys(keyPtr, hPtr)
+ VOID *keyPtr; /* New key to compare. */
+ Tcl_HashEntry *hPtr; /* Existing key to compare. */
{
- 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);
+ register CONST char *p1 = (CONST char *) keyPtr;
+ register CONST char *p2 = (CONST char *) hPtr->key.string;
- /*
- * 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;
- }
+ for (;; p1++, p2++) {
+ if (*p1 != *p2) {
+ break;
}
- }
- 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;
- }
+ if (*p1 == '\0') {
+ return 1;
}
}
-
- /*
- * 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;
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * BogusFind --
+ * HashStringKey --
*
- * 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.
+ * Compute a one-word summary of a text string, 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.
+ * string.
*
* Side effects:
* None.
@@ -875,17 +986,14 @@ BogusCreate(tablePtr, key, newPtr)
*/
static unsigned int
-HashObj(objPtr)
- Tcl_Obj *objPtr;
+HashStringKey(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key from which to compute hash value. */
{
- register CONST char *string;
- register int length;
+ register CONST char *string = (CONST char *) keyPtr;
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,
@@ -903,11 +1011,10 @@ HashObj(objPtr)
*/
result = 0;
- while (length) {
+ while (1) {
c = *string;
string++;
- length--;
- if (length == 0) {
+ if (c == 0) {
break;
}
result += (result<<3) + c;
@@ -915,174 +1022,66 @@ HashObj(objPtr)
return result;
}
+#if TCL_PRESERVE_BINARY_COMPATABILITY
/*
*----------------------------------------------------------------------
*
- * ObjFind --
+ * BogusFind --
*
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key.
+ * This procedure is invoked when an Tcl_FindHashEntry is called
+ * on a table that has been deleted.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * If panic returns (which it shouldn't) this procedure returns
+ * NULL.
*
* Side effects:
- * None.
+ * Generates a panic.
*
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
static Tcl_HashEntry *
-ObjFind(tablePtr, key)
+BogusFind(tablePtr, key)
Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
CONST char *key; /* Key to use to find matching entry. */
{
- 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;
- }
- }
- }
+ panic("called Tcl_FindHashEntry on deleted table");
return NULL;
}
/*
*----------------------------------------------------------------------
*
- * ObjCreate --
+ * BogusCreate --
*
- * 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.
+ * This procedure is invoked when an Tcl_CreateHashEntry is called
+ * on a table that has been deleted.
*
* 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.
+ * If panic returns (which it shouldn't) this procedure returns
+ * NULL.
*
* Side effects:
- * A new entry may be added to the hash table.
+ * Generates a panic.
*
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
static Tcl_HashEntry *
-ObjCreate(tablePtr, key, newPtr)
+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. */
{
- 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;
+ panic("called Tcl_CreateHashEntry on deleted table");
+ return NULL;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -1112,6 +1111,8 @@ 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;
@@ -1132,6 +1133,21 @@ 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.
*/
@@ -1139,25 +1155,35 @@ RebuildTable(tablePtr)
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
- 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 {
- register int *iPtr;
- int count;
- for (index = 0, count = tablePtr->keyType,
- iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
- index += *iPtr;
+ 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);
+ } 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;
}
- index = RANDOM_INDEX(tablePtr, index);
+ } else {
+ index = RANDOM_INDEX (tablePtr, key);
}
+
hPtr->bucketPtr = &(tablePtr->buckets[index]);
hPtr->nextPtr = *hPtr->bucketPtr;
*hPtr->bucketPtr = hPtr;
+#endif
}
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index faf48e4..b8571ee 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.47 2000/07/20 20:33:26 ericm Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.48 2000/07/22 01:53:24 ericm Exp $
*/
#ifndef _TCLINT
@@ -1540,6 +1540,15 @@ 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 acb9270..3d1575f 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,5 +1,5 @@
/*
- * tclObj.c --
+ * Obj.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.16 2000/07/20 20:33:26 ericm Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.17 2000/07/22 01:53:25 ericm Exp $
*/
#include "tclInt.h"
@@ -36,7 +36,7 @@ Tcl_Obj *tclFreeObjList = NULL;
*/
#ifdef TCL_THREADS
-Tcl_Mutex tclObjMutex;
+Tcl_Mutex ObjMutex;
#endif
/*
@@ -54,9 +54,9 @@ char *tclEmptyStringRep = &emptyString;
*/
#ifdef TCL_COMPILE_STATS
-long tclObjsAlloced = 0;
-long tclObjsFreed = 0;
-long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
+long ObjsAlloced = 0;
+long ObjsFreed = 0;
+long ObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
/*
@@ -74,6 +74,20 @@ 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
@@ -103,6 +117,18 @@ 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 */
+};
/*
*-------------------------------------------------------------------------
@@ -141,16 +167,16 @@ TclInitObjSubsystem()
Tcl_RegisterObjType(&tclProcBodyType);
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&tclObjMutex);
- tclObjsAlloced = 0;
- tclObjsFreed = 0;
+ Tcl_MutexLock(&ObjMutex);
+ ObjsAlloced = 0;
+ ObjsFreed = 0;
{
int i;
for (i = 0; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
- tclObjsShared[i] = 0;
+ ObjsShared[i] = 0;
}
}
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexUnlock(&ObjMutex);
#endif
}
@@ -181,9 +207,9 @@ TclFinalizeCompExecEnv()
typeTableInitialized = 0;
}
Tcl_MutexUnlock(&tableMutex);
- Tcl_MutexLock(&tclObjMutex);
+ Tcl_MutexLock(&ObjMutex);
tclFreeObjList = NULL;
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexUnlock(&ObjMutex);
TclFinalizeCompilation();
TclFinalizeExecution();
@@ -389,7 +415,7 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
*
* Side effects:
* If compiling with TCL_COMPILE_STATS, this procedure increments
- * the global count of allocated objects (tclObjsAlloced).
+ * the global count of allocated objects (ObjsAlloced).
*
*----------------------------------------------------------------------
*/
@@ -415,7 +441,7 @@ Tcl_NewObj()
* we maintain.
*/
- Tcl_MutexLock(&tclObjMutex);
+ Tcl_MutexLock(&ObjMutex);
if (tclFreeObjList == NULL) {
TclAllocateFreeObjects();
}
@@ -427,9 +453,9 @@ Tcl_NewObj()
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
- tclObjsAlloced++;
+ ObjsAlloced++;
#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexUnlock(&ObjMutex);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -456,7 +482,7 @@ Tcl_NewObj()
*
* Side effects:
* If compiling with TCL_COMPILE_STATS, this procedure increments
- * the global count of allocated objects (tclObjsAlloced).
+ * the global count of allocated objects (ObjsAlloced).
*
*----------------------------------------------------------------------
*/
@@ -484,9 +510,9 @@ Tcl_DbNewObj(file, line)
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&tclObjMutex);
- tclObjsAlloced++;
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexLock(&ObjMutex);
+ ObjsAlloced++;
+ Tcl_MutexUnlock(&ObjMutex);
#endif /* TCL_COMPILE_STATS */
return objPtr;
}
@@ -572,7 +598,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
- * (tclObjsFreed).
+ * (ObjsFreed).
*
*----------------------------------------------------------------------
*/
@@ -600,7 +626,7 @@ TclFreeObj(objPtr)
* Tcl_Obj structs we maintain.
*/
- Tcl_MutexLock(&tclObjMutex);
+ Tcl_MutexLock(&ObjMutex);
#ifdef TCL_MEM_DEBUG
ckfree((char *) objPtr);
#else
@@ -609,9 +635,9 @@ TclFreeObj(objPtr)
#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
+ ObjsFreed++;
#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexUnlock(&ObjMutex);
}
/*
@@ -2086,15 +2112,219 @@ Tcl_DbIsShared(objPtr, file, line)
}
#endif
#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&tclObjMutex);
+ Tcl_MutexLock(&ObjMutex);
if ((objPtr)->refCount <= 1) {
- tclObjsShared[1]++;
+ ObjsShared[1]++;
} else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
- tclObjsShared[(objPtr)->refCount]++;
+ ObjsShared[(objPtr)->refCount]++;
} else {
- tclObjsShared[0]++;
+ ObjsShared[0]++;
}
- Tcl_MutexUnlock(&tclObjMutex);
+ Tcl_MutexUnlock(&ObjMutex);
#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 0389de8..996b5b9 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.40 2000/07/20 20:33:27 ericm Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.41 2000/07/22 01:53:25 ericm Exp $
*/
#include "tclInt.h"
@@ -31,6 +31,10 @@
#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
@@ -801,6 +805,10 @@ 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. */
generated by cgit v0.12 at 2024-06-28 22:40:02 (GMT)