From 4cb16425e2ffce3f70ad6ca10f0cde4f1545fa9d Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 14 Feb 2008 16:40:45 +0000 Subject: [PATCH] 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. --- NEWS | 2 ++ package-data-list.lisp-expr | 3 ++- src/code/target-hash-table.lisp | 33 +++++++++------------------------ src/code/target-sxhash.lisp | 9 +++++++++ src/compiler/alpha/system.lisp | 9 +++++---- src/compiler/generic/vm-fndb.lisp | 2 ++ src/compiler/globaldb.lisp | 8 ++++---- src/compiler/hppa/system.lisp | 9 +++++---- src/compiler/mips/system.lisp | 9 +++++---- src/compiler/ppc/system.lisp | 9 +++++---- src/compiler/sparc/system.lisp | 9 +++++---- src/compiler/x86-64/system.lisp | 10 ++++++---- src/compiler/x86/system.lisp | 10 ++++++---- version.lisp-expr | 2 +- 14 files changed, 66 insertions(+), 58 deletions(-) diff --git a/NEWS b/NEWS index f73e488..2106520 100644 --- 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 --- 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 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -14,9 +14,6 @@ ;;;; 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))))) ;;;; user-defined hash table tests diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 2e0e06a..c64ef1a 100644 --- 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 --- 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 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -69,6 +69,8 @@ ;;;; 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))) -(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 --- 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))) -(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 --- 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" -- 1.7.10.4