merge 8.7

5 files changed, 36 insertions, 14 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 16bfd2f..6053a7e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1103,10 +1103,18 @@ struct Tcl_HashEntry {
  * 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.
+ * TCL_HASH_KEY_DIRECT_COMPARE -
+ * 	                        Allows fast comparison for hash keys directly
+ *                              by compare of their key.oneWordValue values,
+ *                              before call of compareKeysProc (much slower
+ *                              than a direct compare, so it is speed-up only
+ *                              flag). Don't use it if keys contain values rather
+ *                              than pointers.
  */
 
 #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
 #define TCL_HASH_KEY_SYSTEM_HASH    0x2
+#define TCL_HASH_KEY_DIRECT_COMPARE 0x4
 
 /*
  * Structure definition for the methods associated with a hash table key type.
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index df9a88c..c9ef68d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -190,7 +190,7 @@ const Tcl_ObjType tclDictType = {
 
 static const Tcl_HashKeyType chainHashType = {
     TCL_HASH_KEY_TYPE_VERSION,
-    0,
+    TCL_HASH_KEY_DIRECT_COMPARE,        /* allows compare keys by pointers */
     TclHashObjKey,
     TclCompareObjKeys,
     AllocChainEntry,
diff --git a/generic/tclHash.c b/generic/tclHash.c
index d024ecc..94317bc 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -278,19 +278,33 @@ CreateHashEntry(
 
     if (typePtr->compareKeysProc) {
 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
-
-	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-		hPtr = hPtr->nextPtr) {
-	    if (hash != hPtr->hash) {
-		continue;
-	    }
-	    /* if keys pointers or values are equal */
-	    if ((key == hPtr->key.oneWordValue)
+	if (typePtr->flags & TCL_HASH_KEY_DIRECT_COMPARE) {
+	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+		    hPtr = hPtr->nextPtr) {
+		if (hash != hPtr->hash) {
+		    continue;
+		}
+		/* if keys pointers or values are equal */
+		if ((key == hPtr->key.oneWordValue)
 		    || compareKeysProc((void *) key, hPtr)) {
-		if (newPtr) {
-		    *newPtr = 0;
+		    if (newPtr) {
+			*newPtr = 0;
+		    }
+		    return hPtr;
+		}
+	    }
+	} else { /* no direct compare */
+	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+		    hPtr = hPtr->nextPtr) {
+		if (hash != hPtr->hash) {
+		    continue;
+		}
+		if (compareKeysProc((void *) key, hPtr)) {
+		    if (newPtr) {
+			*newPtr = 0;
+		    }
+		    return hPtr;
 		}
-		return hPtr;
 	    }
 	}
     } else {
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 1070e87..e23d900 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -264,7 +264,7 @@ const Tcl_ObjType tclBignumType = {
 
 const Tcl_HashKeyType tclObjHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,	/* version */
-    0,				/* flags */
+    TCL_HASH_KEY_DIRECT_COMPARE,/* allows compare keys by pointers */
     TclHashObjKey,		/* hashKeyProc */
     TclCompareObjKeys,		/* compareKeysProc */
     AllocObjEntry,		/* allocEntryProc */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b2bd079..41bfa39 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -30,7 +30,7 @@ static int		CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
 
 static const Tcl_HashKeyType tclVarHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,	/* version */
-    0,				/* flags */
+    TCL_HASH_KEY_DIRECT_COMPARE,/* allows compare keys by pointers */
     TclHashObjKey,		/* hashKeyProc */
     CompareVarKeys,		/* compareKeysProc */
     AllocVarEntry,		/* allocEntryProc */