[Sbcl-commits] CVS: sbcl/src/code pred.lisp,1.8,1.9 sxhash.lisp,1.3,1.4

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv2844/src/code

Modified Files:
	pred.lisp sxhash.lisp 
Log Message:
0.7.13.30:
	Install faster EQUAL on simple-bit-vectors
	... word-at-a-time, not bit-at-a-time
	Frobs for correctness
	... much like one that was solved for 0.7.3.5, we must be 
		careful about identifying the last word of the bit vector, 
		particularly for bit-vectors whose length is divisible by 
        	32^Wn-word-bits.  Less critical in this case, but we could 
		still be reading into random space, even if not writing.
	Frobs for yet more speed
	... allow CMUCL to optimize ASH, as long as none of the values
		are in the danger zone.  Also reported the bug to CMUCL 
		people, and it is now fixed, so when all traces of 18d 
		are removed from this earth, the conditional in 
		ASH-DERIVE-TYPE-AUX can go too.


Index: pred.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/pred.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- pred.lisp	27 Jan 2003 17:27:52 -0000	1.8
+++ pred.lisp	17 Mar 2003 17:44:39 -0000	1.9
@@ -135,6 +135,19 @@
   "Return T if OBJ1 and OBJ2 are the same object, otherwise NIL."
   (eq obj1 obj2))
 
+(defun bit-vector-= (x y)
+  (declare (type bit-vector x y))
+  (if (and (simple-bit-vector-p x)
+	   (simple-bit-vector-p y))
+      (bit-vector-= x y) ; DEFTRANSFORM
+      (and (= (length x) (length y))
+	   (do ((i 0 (1+ i))
+		(length (length x)))
+	       ((= i length) t)
+	     (declare (fixnum i))
+	     (unless (= (bit x i) (bit y i))
+	       (return nil))))))
+
 (defun equal (x y)
   #!+sb-doc
   "Return T if X and Y are EQL or if they are structured components
@@ -152,15 +165,7 @@
 	 (and (pathnamep y) (pathname= x y)))
 	((bit-vector-p x)
 	 (and (bit-vector-p y)
-	      (= (the fixnum (length x))
-		 (the fixnum (length y)))
-	      (do ((i 0 (1+ i))
-		   (length (length x)))
-		  ((= i length) t)
-		(declare (fixnum i))
-		(or (= (the fixnum (bit x i))
-		       (the fixnum (bit y i)))
-		    (return nil)))))
+	      (bit-vector-= x y)))
 	(t nil)))
 
 ;;; EQUALP comparison of HASH-TABLE values

Index: sxhash.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sxhash.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- sxhash.lisp	15 Mar 2003 19:01:34 -0000	1.3
+++ sxhash.lisp	17 Mar 2003 17:44:39 -0000	1.4
@@ -47,34 +47,46 @@
 (deftransform sxhash ((x) (simple-bit-vector))
   `(let ((result 410823708))
     (declare (type fixnum result))
-    (mixf result (sxhash (length x)))
-    (do* ((i sb!vm:vector-data-offset (+ i 1))
-	  ;; FIXME: should we respect DEPTHOID?  SXHASH on strings
-	  ;; doesn't seem to...
-	  (end (+ sb!vm:vector-data-offset
-		  (ceiling (length x) sb!vm:n-word-bits))))
-	 ((= i end) result)
-      (declare (type index i end))
-      (let ((num
-	     (if (= i (1- end))
-		 (logand
-		  (ash (1- (ash 1 (mod (length x) sb!vm:n-word-bits)))
-		       ,(ecase sb!c:*backend-byte-order*
-			  (:little-endian 0)
-			  (:big-endian
-			   '(- sb!vm:n-word-bits
-			       (mod (length x) sb!vm:n-word-bits)))))
-		  (%raw-bits x i))
-		 (%raw-bits x i))))
-	(declare (type (unsigned-byte 32) num))
-	(mixf result ,(ecase sb!c:*backend-byte-order*
-			(:little-endian '(logand num most-positive-fixnum))
-			;; FIXME: I'm not certain that N-LOWTAG-BITS
-			;; is the clearest way of expressing this:
-			;; it's essentially the difference between
-			;; `(UNSIGNED-BYTE ,SB!VM:N-WORD-BITS) and
-			;; (AND FIXNUM UNSIGNED-BYTE).
-			(:big-endian '(ash num (- sb!vm:n-lowtag-bits)))))))))
+    (let ((length (length x)))
+      (cond
+	((= length 0) (mix result (sxhash 0)))
+	(t
+	 (mixf result (sxhash (length x)))
+	 (do* ((i sb!vm:vector-data-offset (+ i 1))
+	       ;; FIXME: should we respect DEPTHOID?  SXHASH on
+	       ;; strings doesn't seem to...
+	       (end-1 (+ sb!vm:vector-data-offset
+			 (floor (1- length) sb!vm:n-word-bits))))
+	      ((= i end-1)
+	       (let ((num
+		      (logand
+		       (ash (1- (ash 1 (mod length sb!vm:n-word-bits)))
+			    ,(ecase sb!c:*backend-byte-order*
+			       (:little-endian 0)
+			       (:big-endian
+				'(- sb!vm:n-word-bits
+				    (mod length sb!vm:n-word-bits)))))
+		       (%raw-bits x i))))
+		 (declare (type (unsigned-byte 32) num))
+		 (mix result ,(ecase sb!c:*backend-byte-order*
+				(:little-endian
+				 '(logand num most-positive-fixnum))
+				(:big-endian
+				 '(ash num (- sb!vm:n-lowtag-bits)))))))
+	   (declare (type index i end-1))
+	   (let ((num (%raw-bits x i)))
+	     (declare (type (unsigned-byte 32) num))
+	     (mixf result ,(ecase sb!c:*backend-byte-order*
+			     (:little-endian
+			      '(logand num most-positive-fixnum))
+			     ;; FIXME: I'm not certain that
+			     ;; N-LOWTAG-BITS is the clearest way of
+			     ;; expressing this: it's essentially the
+			     ;; difference between `(UNSIGNED-BYTE
+			     ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
+			     ;; UNSIGNED-BYTE).
+			     (:big-endian
+			      '(ash num (- sb!vm:n-lowtag-bits))))))))))))
 
 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
 ;;; order to avoid having to do TYPECASE at runtime.