Fixed object hashing bozo-ness. The code as it stood looked like a

cargo-cult hangover from the hashing code in tclHash.c, but this looks
almost identical to that used for literals (which is fast.)

2 files changed, 24 insertions, 28 deletions

diff --git a/ChangeLog b/ChangeLog
index e7e26b1..125a461 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,17 +1,23 @@
+2004-03-30  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclObj.c (HashObjKey): Rewrote to fix fault which hashed
+	every single-character object to the same hash bucket.  The new
+	code is shorter, simpler, clearer, and (happily) faster.
+
 2004-03-30  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclExecute.c (TEBC): reverting to the previous method
 	for async tests in TEBC, as the new method turned out to be too
 	costly. Async tests now run every 64 instructions.
-	
+
 2004-03-30  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclCompile.c:     New instruction code INST_START_CMD
-	* generic/tclCompile.h:     that allows checking the bytecode's  
-	* generic/tclExecute.c:     validity [Bug 729692] and the interp's  
-	* tests/interp.test (18.9): readyness [Bug 495830] before running 
-	* tests/proc.test (7.1):    the command. It also changes the 
-	* tests/rename.test (6.1):  mechanics of the async tests in TEBC, 		   	 
+	* generic/tclCompile.h:     that allows checking the bytecode's
+	* generic/tclExecute.c:     validity [Bug 729692] and the interp's
+	* tests/interp.test (18.9): readyness [Bug 495830] before running
+	* tests/proc.test (7.1):    the command. It also changes the
+	* tests/rename.test (6.1):  mechanics of the async tests in TEBC,
 	doing it now at command start instead of every 16 instructions.
 
 2004-03-30  Vince Darley  <vincentdarley@users.sourceforge.net>
diff --git a/generic/tclObj.c b/generic/tclObj.c
index e2d6056..9d71cfe 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -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: tclObj.c,v 1.55 2004/03/19 18:33:52 kennykb Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.56 2004/03/30 21:34:15 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2854,7 +2854,7 @@ AllocObjEntry(tablePtr, keyPtr)
 
     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
     hPtr->key.oneWordValue = (char *) objPtr;
-    Tcl_IncrRefCount (objPtr);
+    Tcl_IncrRefCount(objPtr);
 
     return hPtr;
 }
@@ -2897,9 +2897,9 @@ CompareObjKeys(keyPtr, hPtr)
      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
      * in a register.
      */
-    p1 = Tcl_GetString (objPtr1);
+    p1 = TclGetString(objPtr1);
     l1 = objPtr1->length;
-    p2 = Tcl_GetString (objPtr2);
+    p2 = TclGetString(objPtr2);
     l2 = objPtr2->length;
 
     /*
@@ -2941,8 +2941,8 @@ FreeObjEntry(hPtr)
 {
     Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
 
-    Tcl_DecrRefCount (objPtr);
-    ckfree ((char *) hPtr);
+    Tcl_DecrRefCount(objPtr);
+    ckfree((char *) hPtr);
 }
 
 /*
@@ -2969,13 +2969,10 @@ HashObjKey(tablePtr, keyPtr)
     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;
+    CONST char *string = TclGetString(objPtr);
+    int length = objPtr->length;
+    unsigned int result = 0;
+    int i;
 
     /*
      * I tried a zillion different hash functions and asked many other
@@ -2993,15 +2990,8 @@ HashObjKey(tablePtr, keyPtr)
      *    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;
+    for (i=0 ; i<length ; i++) {
+	result += (result << 3) + string[i];
     }
     return result;
 }