Fix OPEN with :io and :if-does-not-exist nil.

[sbcl.git] / src / code / target-sxhash.lisp

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 2e0e06a..953160b 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -11,6 +11,9 @@
 
 (in-package "SB!IMPL")
 
+(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
@@ -80,7 +83,7 @@
 ;;;; <http://burtleburtle.net/bob/hash/doobs.html> for some more
 ;;;; information).
 
-#!-sb-fluid (declaim (inline %sxhash-substring))
+(declaim (inline %sxhash-substring))
 (defun %sxhash-substring (string &optional (count (length string)))
   ;; FIXME: As in MIX above, we wouldn't need (SAFETY 0) here if the
   ;; cross-compiler were smarter about ASH, but we need it for
@@ -139,10 +142,8 @@
 ;;;; the SXHASH function
 
 ;; simple cases
-(declaim (ftype (sfunction (integer) (integer 0 #.sb!xc:most-positive-fixnum))
-                sxhash-bignum))
-(declaim (ftype (sfunction (t) (integer 0 #.sb!xc:most-positive-fixnum))
-                sxhash-instance))
+(declaim (ftype (sfunction (integer) hash) sxhash-bignum))
+(declaim (ftype (sfunction (t) hash) sxhash-instance))
 
 (defun sxhash (x)
   ;; profiling SXHASH is hard, but we might as well try to make it go
@@ -182,12 +183,27 @@
                              (sxhash-recurse (cdr x) (1- depthoid)))
                         261835505)))
                (instance
-                (if (or (typep x 'structure-object) (typep x 'condition))
-                    (logxor 422371266
-                            (sxhash ; through DEFTRANSFORM
-                             (classoid-name
-                              (layout-classoid (%instance-layout x)))))
-                    (sxhash-instance x)))
+                (if (pathnamep x)
+                    ;; Pathnames are EQUAL if all the components are EQUAL, so
+                    ;; we hash all of the components of a pathname together.
+                    (let ((hash (sxhash-recurse (pathname-host x) depthoid)))
+                      (mixf hash (sxhash-recurse (pathname-device x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-directory x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-name x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-type x) depthoid))
+                      ;; Hash :NEWEST the same as NIL because EQUAL for
+                      ;; pathnames assumes that :newest and nil are equal.
+                      (let ((version (%pathname-version x)))
+                        (mixf hash (sxhash-recurse (if (eq version :newest)
+                                                       nil
+                                                       version)
+                                                   depthoid))))
+                    (if (or (typep x 'structure-object) (typep x 'condition))
+                        (logxor 422371266
+                                (sxhash ; through DEFTRANSFORM
+                                 (classoid-name
+                                  (layout-classoid (%instance-layout x)))))
+                        (sxhash-instance x))))
                (symbol (sxhash x)) ; through DEFTRANSFORM
                (array
                 (typecase x
@@ -199,7 +215,7 @@
                    ;; than this.  The problem is that a non-SIMPLE
                    ;; BIT-VECTOR could be displaced to another, with a
                    ;; non-zero offset -- so that significantly more
-                   ;; work needs to be done using the %RAW-BITS
+                   ;; work needs to be done using the %VECTOR-RAW-BITS
                    ;; approach.  This will probably do for now.
                    (sxhash-recurse (copy-seq x) depthoid))
                   (t (logxor 191020317 (sxhash (array-rank x))))))
@@ -337,8 +353,8 @@
     (etypecase key
       (integer (sxhash key))
       (float (macrolet ((frob (type)
-                          (let ((lo (coerce most-negative-fixnum type))
-                                (hi (coerce most-positive-fixnum type)))
+                          (let ((lo (coerce sb!xc:most-negative-fixnum type))
+                                (hi (coerce sb!xc:most-positive-fixnum type)))
                             `(cond (;; This clause allows FIXNUM-sized integer
                                     ;; values to be handled without consing.
                                     (<= ,lo key ,hi)