X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-hash-table.lisp;h=26d751ebb83218c67ff90736c1a95c49e7819efd;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=02f354ec0fa4f0a7b065ce370a73acc4cc7a3bbb;hpb=667ec9d494530079bef28e8589dd0d3274b935ec;p=sbcl.git

diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
index 02f354e..26d751e 100644
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -15,7 +15,7 @@
 ;;;; utilities
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant max-hash most-positive-fixnum))
+  (defconstant max-hash sb!xc:most-positive-fixnum))
 
 (deftype hash ()
   `(integer 0 ,max-hash))
@@ -81,6 +81,7 @@
 ;;;; construction and simple accessors
 
 (defconstant +min-hash-table-size+ 16)
+(defconstant +min-hash-table-rehash-threshold+ (float 1/16 1.0))
 
 (defun make-hash-table (&key (test 'eql)
 			     (size +min-hash-table-size+)
@@ -130,17 +131,29 @@
 		      (min size
 			   ;; SIZE is just a hint, so if the user asks
 			   ;; for a SIZE which'd be too big for us to
-			   ;; easily implement, we bump it down.
-			   (floor array-dimension-limit 16))))
+ 			   ;; easily implement, we bump it down.
+			   (floor array-dimension-limit 1024))))
 	   (rehash-size (if (integerp rehash-size)
 			    rehash-size
 			    (float rehash-size 1.0)))
 	   ;; FIXME: Original REHASH-THRESHOLD default should be 1.0,
 	   ;; not 1, to make it easier for the compiler to avoid
 	   ;; boxing.
-	   (rehash-threshold (float rehash-threshold 1.0))
+	   (rehash-threshold (max +min-hash-table-rehash-threshold+
+				  (float rehash-threshold 1.0)))
 	   (size+1 (1+ size))		; The first element is not usable.
-	   (scaled-size (round (/ (float size+1) rehash-threshold)))
+           ;; KLUDGE: The most natural way of expressing the below is
+           ;; (round (/ (float size+1) rehash-threshold)), and indeed
+           ;; it was expressed like that until 0.7.0. However,
+           ;; MAKE-HASH-TABLE is called very early in cold-init, and
+           ;; the SPARC has no primitive instructions for rounding,
+           ;; but only for truncating; therefore, we fudge this issue
+           ;; a little. The other uses of truncate, below, similarly
+           ;; used to be round. -- CSR, 2002-10-01
+	   ;;
+	   ;; Note that this has not yet been audited for
+	   ;; correctness. It just seems to work. -- CSR, 2002-11-02
+	   (scaled-size (truncate (/ (float size+1) rehash-threshold)))
 	   (length (almost-primify (max scaled-size
 					(1+ +min-hash-table-size+))))
 	   (index-vector (make-array length
@@ -165,6 +178,14 @@
 		   :hash-vector (unless (eq test 'eq)
 				  (make-array size+1
 					      :element-type '(unsigned-byte 32)
+					      ;; as explained by pmai on
+					      ;; openprojects #lisp IRC
+					      ;; 2002-07-30: #x80000000 is
+					      ;; bigger than any possible nonEQ
+					      ;; hash value, and thus indicates
+					      ;; an empty slot; and EQ hash
+					      ;; tables don't use
+					      ;; HASH-TABLE-HASH-VECTOR
 					      :initial-element #x80000000)))))
       (declare (type index size+1 scaled-size length))
       ;; Set up the free list, all free. These lists are 0 terminated.
@@ -224,7 +245,7 @@
 	      (fixnum
 	       (+ rehash-size old-size))
 	      (float
-	       (the index (round (* rehash-size old-size)))))))
+	       (the index (truncate (* rehash-size old-size)))))))
 	 (new-kv-vector (make-array (* 2 new-size)
 				    :initial-element +empty-ht-slot+))
 	 (new-next-vector (make-array new-size
@@ -236,7 +257,7 @@
 					:initial-element #x80000000)))
 	 (old-index-vector (hash-table-index-vector table))
 	 (new-length (almost-primify
-		      (round (/ (float new-size)
+		      (truncate (/ (float new-size)
 				(hash-table-rehash-threshold table)))))
 	 (new-index-vector (make-array new-length
 				       :element-type '(unsigned-byte 32)
@@ -648,7 +669,7 @@
   #!+sb-doc
   "For each entry in HASH-TABLE, call the designated two-argument function
    on the key and value of the entry. Return NIL."
-  (let ((fun (%coerce-callable-to-function function-designator))
+  (let ((fun (%coerce-callable-to-fun function-designator))
 	(size (length (hash-table-next-vector hash-table))))
     (declare (type function fun))
     (do ((i 1 (1+ i)))