merge 8.6

5 files changed, 37 insertions, 15 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index de74afb..de1daf6 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1236,10 +1236,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 8f8755c..2359e23 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -176,7 +176,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 385b9e4..742691c 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -304,20 +304,34 @@ CreateHashEntry(
 
     if (typePtr->compareKeysProc) {
 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
-
-	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-		hPtr = hPtr->nextPtr) {
-	    if (hash != PTR2UINT(hPtr->hash)) {
-		continue;
+	if (typePtr->flags & TCL_HASH_KEY_DIRECT_COMPARE) {
+	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+		    hPtr = hPtr->nextPtr) {
+		if (hash != PTR2UINT(hPtr->hash)) {
+		    continue;
+		}
+		/* if keys pointers or values are equal */
+		if ((key == hPtr->key.oneWordValue)
+		    || compareKeysProc((void *) key, hPtr)
+		) {
+		    if (newPtr) {
+			*newPtr = 0;
+		    }
+		    return hPtr;
+		}
 	    }
-	    /* if keys pointers or values are equal */
-	    if ((key == hPtr->key.oneWordValue)
-		|| compareKeysProc((void *) key, hPtr)
-	    ) {
-		if (newPtr) {
-		    *newPtr = 0;
+	} else { /* no direct compare */
+	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+		    hPtr = hPtr->nextPtr) {
+		if (hash != PTR2UINT(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 2ddabfb..2b86a25 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -285,7 +285,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 570ab99..8deb2b7 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 */