1.0.14.27: rename MAKE-FIXNUM to POINTER-HASH

 * Use VOP translation instead of %PRIMITIVE.

 * On x86 and x86-64 improve the pointer-hash slightly: use the whole
   address, but none of the tag bits in the hash.

 * Fix type in INDEX-FOR-HASHING: the first argument is a HASH, not an
   INDEX. Given the better quality of low bits on x86oids (and
   hopefully soon on others as well), adjust the mixing a bit.

diff --git a/NEWS b/NEWS
index f73e488..2106520 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,8 @@ changes in sbcl-1.0.15 relative to sbcl-1.0.14:
     when SB-DEBUG:*SHOW-ENTRY-POINT-DETAILS* is NIL.
   * unreadably printed representation of hash-tables now includes
     weakness if any.
+  * bug fix: on x86 and x86-64 pointer based EQ-hashing now uses the
+    full address of the object, and none of the tag bits.
   * bug fix: readably printing hash-tables now respects other printer
     control variables. (reported by Cedric St-Jean)
   * bug fix: compiler gave a bogus STYLE-WARNING for the :SYNCHRONIZED

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index fd710df..f577d11 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -281,7 +281,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "LAMBDA-WITH-LEXENV" "LEXENV-FIND"
                "LOCATION=" "LTN-ANNOTATE"
                "MAKE-ALIAS-TN" "MAKE-CATCH-BLOCK"
-               "MAKE-CLOSURE" "MAKE-CONSTANT-TN" "MAKE-FIXNUM"
+               "MAKE-CLOSURE" "MAKE-CONSTANT-TN"
                "MAKE-FIXUP-NOTE"
                "MAKE-LOAD-TIME-CONSTANT-TN" "MAKE-N-TNS" "MAKE-NORMAL-TN"
                "MAKE-OTHER-IMMEDIATE-TYPE" "MAKE-RANDOM-TN"
@@ -1476,6 +1476,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "PACKAGE-INTERNAL-SYMBOLS" "PACKAGE-EXTERNAL-SYMBOLS"
                "PARSE-DEFMACRO" "PARSE-UNKNOWN-TYPE"
                "PARSE-UNKNOWN-TYPE-SPECIFIER" "PATHNAME-DESIGNATOR"
+               "POINTER-HASH"
                #!+(or x86 x86-64) "*PSEUDO-ATOMIC-BITS*"
                "PUNT-PRINT-IF-TOO-LONG"
                "RAW-INSTANCE-SLOTS-EQUALP"

diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
index a5720bc..bdb5514 100644 (file)
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -14,9 +14,6 @@
 \f
 ;;;; utilities
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant max-hash sb!xc:most-positive-fixnum))
-
 ;;; Code for detecting concurrent accesses to the same table from
 ;;; multiple threads. Only compiled in when the :SB-HASH-TABLE-DEBUG
 ;;; feature is enabled. The main reason for the existence of this code
@@ -74,19 +71,6 @@
                    (setf (,thread-slot-accessor ,hash-table) nil)))
                (body-fun)))))))
 
-(deftype hash ()
-  `(integer 0 ,max-hash))
-
-;;; FIXME: Does this always make a nonnegative FIXNUM? If so, then
-;;; explain why. If not (or if the reason it always makes a
-;;; nonnegative FIXNUM is only the accident that pointers in supported
-;;; architectures happen to be in the lower half of the address
-;;; space), then fix it.
-#!-sb-fluid (declaim (inline pointer-hash))
-(defun pointer-hash (key)
-  (declare (values hash))
-  (truly-the hash (%primitive sb!c:make-fixnum key)))
-
 #!-sb-fluid (declaim (inline eq-hash))
 (defun eq-hash (key)
   (declare (values hash (member t nil)))
@@ -129,18 +113,19 @@
   (ash 1 (integer-length num)))
 
 (declaim (inline index-for-hashing))
-(defun index-for-hashing (index length)
-  (declare (type index index length))
+(defun index-for-hashing (hash length)
+  (declare (type hash hash length))
   ;; We're using power of two tables which obviously are very
   ;; sensitive to the exact values of the low bits in the hash
   ;; value. Do a little shuffling of the value to mix the high bits in
   ;; there too.
-  (logand (1- length)
-          (+ (logxor #b11100101010001011010100111
-                     index)
-             (ash index -6)
-             (ash index -15)
-             (ash index -23))))
+  (truly-the index
+             (logand (1- length)
+                     (+ (logxor #b11100101010001011010100111
+                                hash)
+                        (ash hash -3)
+                        (ash hash -12)
+                        (ash hash -20)))))
 
 \f
 ;;;; user-defined hash table tests

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 2e0e06a..c64ef1a 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -11,6 +11,15 @@
 
 (in-package "SB!IMPL")
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant max-hash sb!xc:most-positive-fixnum))
+
+(deftype hash ()
+  `(integer 0 ,max-hash))
+
+(defun pointer-hash (key)
+  (pointer-hash key))
+
 ;;; the depthoid explored when calculating hash values
 ;;;
 ;;; "Depthoid" here is a sort of mixture of what Common Lisp ordinarily calls

diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp
index 70c7c47..5a9945a 100644 (file)
--- a/src/compiler/alpha/system.lisp
+++ b/src/compiler/alpha/system.lisp
@@ -129,13 +129,14 @@
     (storew t1 x 0 other-pointer-lowtag)
     (move x res)))
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg)))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;;
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
+    ;; FIXME: It would be better if this would mask the lowtag,
+    ;; and shift the result into a positive fixnum like on x86.
     (inst sll ptr 35 res)
     (inst srl res 33 res)))
 

diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index 7a497fd..ff95944 100644 (file)
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -69,6 +69,8 @@
 \f
 ;;;; miscellaneous "sub-primitives"
 
+(defknown pointer-hash (t) hash (flushable))
+
 (defknown %sp-string-compare
   (simple-string index index simple-string index index)
   (or index null)

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index bc68512..e55bc34 100644 (file)
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -583,11 +583,11 @@
                                        :element-type 'compact-info-entry))
              (sorted (sort (names)
                            #+sb-xc-host #'<
-                           ;; (This MAKE-FIXNUM hack implements
-                           ;; pointer comparison, as explained above.)
+                           ;; POINTER-HASH hack implements pointer
+                           ;; comparison, as explained above.
                            #-sb-xc-host (lambda (x y)
-                                          (< (%primitive make-fixnum x)
-                                             (%primitive make-fixnum y))))))
+                                          (< (pointer-hash x)
+                                             (pointer-hash y))))))
         (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT")
         (let ((entries-idx 0))
           (dolist (types sorted)

diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp
index 74bb0d7..8246323 100644 (file)
--- a/src/compiler/hppa/system.lisp
+++ b/src/compiler/hppa/system.lisp
@@ -105,13 +105,14 @@
     (storew temp x 0 other-pointer-lowtag)
     (move x res)))
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg)))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;;
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
+    ;; FIXME: It would be better if this would mask the lowtag,
+    ;; and shift the result into a positive fixnum like on x86.
     (inst zdep ptr 29 29 res)))
 
 (define-vop (make-other-immediate-type)

diff --git a/src/compiler/mips/system.lisp b/src/compiler/mips/system.lisp
index b31d80d..4ac025c 100644 (file)
--- a/src/compiler/mips/system.lisp
+++ b/src/compiler/mips/system.lisp
@@ -130,13 +130,14 @@
     (storew t1 x 0 other-pointer-lowtag)
     (move res x)))
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg)))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;;
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
+    ;; FIXME: It would be better if this would mask the lowtag,
+    ;; and shift the result into a positive fixnum like on x86.
     (inst sll res ptr 3)
     (inst srl res res 1)))
 

diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
index d640ab9..b5ed227 100644 (file)
--- a/src/compiler/ppc/system.lisp
+++ b/src/compiler/ppc/system.lisp
@@ -121,13 +121,14 @@
     (move res x)))
 
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg)))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;;
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
+    ;; FIXME: It would be better if this would mask the lowtag,
+    ;; and shift the result into a positive fixnum like on x86.
     (inst rlwinm res ptr n-fixnum-tag-bits 1 n-positive-fixnum-bits)))
 
 (define-vop (make-other-immediate-type)

diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp
index d95c26b..576dac2 100644 (file)
--- a/src/compiler/sparc/system.lisp
+++ b/src/compiler/sparc/system.lisp
@@ -126,13 +126,14 @@
     (move res x)))
 
 
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg)))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;; FIXME: CMUCL comment:
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
+    ;; FIXME: It would be better if this would mask the lowtag,
+    ;; and shift the result into a positive fixnum like on x86.
     (inst sll res ptr 3)
     (inst srl res res 1)))
 

diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp
index 5d8ab1c..86d80df 100644 (file)
--- a/src/compiler/x86-64/system.lisp
+++ b/src/compiler/x86-64/system.lisp
@@ -126,14 +126,16 @@
     (storew eax x 0 other-pointer-lowtag)
     (move res x)))
 \f
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg) :target res))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
     (move res ptr)
-    (inst shl res 4)
+    ;; Mask the lowtag, and shift the whole address into a positive
+    ;; fixnum.
+    (inst and res (lognot lowtag-mask))
     (inst shr res 1)))
 
 (define-vop (make-other-immediate-type)

diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp
index 96ca14d..597e3c2 100644 (file)
--- a/src/compiler/x86/system.lisp
+++ b/src/compiler/x86/system.lisp
@@ -124,14 +124,16 @@
     (storew eax x 0 other-pointer-lowtag)
     (move res x)))
 \f
-(define-vop (make-fixnum)
+(define-vop (pointer-hash)
+  (:translate pointer-hash)
   (:args (ptr :scs (any-reg descriptor-reg) :target res))
   (:results (res :scs (any-reg descriptor-reg)))
+  (:policy :fast-safe)
   (:generator 1
-    ;; Some code (the hash table code) depends on this returning a
-    ;; positive number so make sure it does.
     (move res ptr)
-    (inst shl res 3)
+    ;; Mask the lowtag, and shift the whole address into a positive
+    ;; fixnum.
+    (inst and res (lognot lowtag-mask))
     (inst shr res 1)))
 
 (define-vop (make-other-immediate-type)

diff --git a/version.lisp-expr b/version.lisp-expr
index 3a10048..350a0e2 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.14.26"
+"1.0.14.27"