Attachment "tip138.patch" to
ticket [731356ffff]
added by
dgp
2003-11-15 05:28:00.
Index: doc/Hash.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/Hash.3,v
retrieving revision 1.11
diff -u -r1.11 Hash.3
--- doc/Hash.3 18 Jul 2003 16:56:41 -0000 1.11
+++ doc/Hash.3 14 Nov 2003 22:26:30 -0000
@@ -256,6 +256,15 @@
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.
+.IP \fBTCL_HASH_KEY_SYSTEM_HASH\fR 25
+If this flag is set, then Tcl will use the memory allocation
+procedures provided by the operating system when allocating
+and freeing memory used to store the hash table data structures,
+and not any of Tcl's own customized memory allocation routines.
+This is important if the hash table is to be used in the
+implementation of a custom set of allocation routines, or something
+that a custom set of allocation routines might depend on, in
+order to avoid any circular dependency.
.PP
The \fIhashKeyProc\fR member contains the address of a function
called to calculate a hash value for the key.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.167
diff -u -r1.167 tcl.h
--- generic/tcl.h 14 Nov 2003 20:44:44 -0000 1.167
+++ generic/tcl.h 14 Nov 2003 22:26:30 -0000
@@ -1169,8 +1169,13 @@
* hash table will attempt to rectify this by
* randomising the bits and then using the upper
* N bits as the index into the table.
+ * TCL_HASH_KEY_SYSTEM_HASH:
+ * If this flag is set then all memory internally
+ * allocated for the hash table that is not for an
+ * entry will use the system heap.
*/
#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
+#define TCL_HASH_KEY_SYSTEM_HASH 0x2
/*
* Structure definition for the methods associated with a hash table
Index: generic/tclHash.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclHash.c,v
retrieving revision 1.13
diff -u -r1.13 tclHash.c
--- generic/tclHash.c 24 Jun 2003 19:56:12 -0000 1.13
+++ generic/tclHash.c 14 Nov 2003 22:26:31 -0000
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* Prevent macros from clashing with function definitions.
@@ -626,8 +627,12 @@
*/
if (tablePtr->buckets != tablePtr->staticBuckets) {
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ TclpSysFree((char *) tablePtr->buckets);
+ } else {
ckfree((char *) tablePtr->buckets);
}
+ }
/*
* Arrange for panics if the table is used again without
@@ -745,6 +750,26 @@
double average, tmp;
register Tcl_HashEntry *hPtr;
char *result, *p;
+ Tcl_HashKeyType *typePtr;
+
+#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_HashStats on deleted table");
+ return NULL;
+ }
+#endif
/*
* Compute a histogram of bucket usage.
@@ -774,8 +799,11 @@
/*
* Print out the histogram and a few other pieces of information.
*/
-
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ result = (char *) TclpSysAlloc((unsigned) ((NUM_COUNTERS*60) + 300), 0);
+ } else {
result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+ }
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
@@ -1122,6 +1150,21 @@
Tcl_HashKeyType *typePtr;
VOID *key;
+#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
+
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -1131,8 +1174,13 @@
*/
tablePtr->numBuckets *= 4;
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
+ (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
+ } else {
tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+ }
for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
count > 0; count--, newChainPtr++) {
*newChainPtr = NULL;
@@ -1141,21 +1189,6 @@
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.
*/
@@ -1200,6 +1233,10 @@
*/
if (oldBuckets != tablePtr->staticBuckets) {
+ if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+ TclpSysFree((char *) oldBuckets);
+ } else {
ckfree((char *) oldBuckets);
+ }
}
}
Index: unix/tclUnixPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPort.h,v
retrieving revision 1.30
diff -u -r1.30 tclUnixPort.h
--- unix/tclUnixPort.h 11 Nov 2003 08:24:55 -0000 1.30
+++ unix/tclUnixPort.h 14 Nov 2003 22:26:31 -0000
@@ -532,15 +532,12 @@
#define TclpReleaseFile(file) /* Nothing. */
/*
- * The following defines wrap the system memory allocation routines for
- * use by tclAlloc.c. By default off unused on Unix.
+ * The following defines wrap the system memory allocation routines.
*/
-#if USE_TCLALLOC
-# define TclpSysAlloc(size, isBin) malloc((size_t)size)
-# define TclpSysFree(ptr) free((char*)ptr)
-# define TclpSysRealloc(ptr, size) realloc((char*)ptr, (size_t)size)
-#endif
+#define TclpSysAlloc(size, isBin) malloc((size_t)size)
+#define TclpSysFree(ptr) free((char*)ptr)
+#define TclpSysRealloc(ptr, size) realloc((char*)ptr, (size_t)size)
/*
* The following macros and declaration wrap the C runtime library
