From a3ab89c1db0dd9bfb911532ca134be16f16c4c1b Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Sat, 15 Mar 2003 19:01:30 +0000
Subject: [PATCH] 0.7.13.28: 	Merge SXHASH improvements 	...
 distribute (SXHASH <fixnum>) a little more widely over the 
 	available space; 	... make (SXHASH
 <bit-vector>) consider rather more than just 		the
 first four bits. 	Miscellaneous cleanups 	... don't
 delete contrib's html documentation 	... make vanilla
 modules depend on the (newly-built) sbcl.core 	... some
 cleanups in snapshot/SB-SHOW logic 	... quit from the
 low-level debugger now exits the process with 		an
 error code (because, um, even getting to ldb is a 	
 pretty serious error)

---
 NEWS                        |   15 +++++++++------
 clean.sh                    |    4 ++--
 contrib/vanilla-module.mk   |    2 +-
 doc/clean.sh                |    5 +++++
 src/code/sxhash.lisp        |   40 ++++++++++++++++++++++++++++++++++++++--
 src/code/target-sxhash.lisp |   17 ++++++++++++-----
 src/cold/snapshot.lisp      |    6 +++++-
 src/runtime/monitor.c       |    2 +-
 tests/hash.impure.lisp      |   13 ++++++++++++-
 version.lisp-expr           |    2 +-
 10 files changed, 86 insertions(+), 20 deletions(-)
 create mode 100644 doc/clean.sh

diff --git a/NEWS b/NEWS
index dfb3d64..c488bce 100644
--- a/NEWS
+++ b/NEWS
@@ -1584,10 +1584,19 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12:
     DEFSTRUCT-SLOT-DESCRIPTION structure.
 
 changes in sbcl-0.7.14 relative to sbcl-0.7.13:
+  * a better implementation of SXHASH on bit vectors, measured both in
+    execution speed and in distribution of results over the positive
+    fixnums, has been installed.
   * fixed CEILING optimization for a divisor of form 2^k.
   * fixed bug 240 (emitting extra style warnings "using the lexical
     binding of the symbol *XXX*" for &OPTIONAL arguments).  (reported
     by Antonio Martinez)
+  * fixed SXHASH, giving different results for NIL depending on type
+    declarations (SYMBOL or LIST). (thanks to Gerd Moellmann)
+  * fixed bug in DEFPARAMETER and DEFVAR: they could assign a lexical
+    variable. (found by Rolf Wester)
+  * SBCL does not ignore type declarations for special
+    variables. (reported by rif on c.l.l 2003-03-05)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** a bug in the CONS type specifier, whereby the CAR and CDR
        types got intertwined, has been fixed;
@@ -1599,12 +1608,6 @@ changes in sbcl-0.7.14 relative to sbcl-0.7.13:
        implemented (as required -- yes, really) by ANSI;
     ** GETF and GET-PROPERTIES throw a TYPE-ERROR, not a SIMPLE-ERROR,
        on malformed property lists;
-  * fixed SXHASH, giving different results for NIL depending on type
-    declarations (SYMBOL or LIST). (thanks to Gerd Moellmann)
-  * fixed bug in DEFPARAMETER and DEFVAR: they could assign a lexical
-    variable. (found by Rolf Wester)
-  * SBCL does not ignore type declarations for special
-    variables. (reported by rif on c.l.l 2003-03-05)
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/clean.sh b/clean.sh
index 351150b..6088d37 100755
--- a/clean.sh
+++ b/clean.sh
@@ -93,9 +93,9 @@ find . \( \
 	-name 'sbcl' -o \
 	-name 'sbcl.h' -o \
 	-name 'depend' -o \
-	-name '*.htm' -o \
-	-name '*.html' -o \
 	-name 'TAGS' -o \
 	-name 'tags' -o \
 	-name 'test-passed' -o \
 	-name 'local-target-features.lisp-expr' \) -print | xargs rm -f
+
+cd doc && sh ./clean.sh
diff --git a/contrib/vanilla-module.mk b/contrib/vanilla-module.mk
index 4b86e46..2aebda3 100644
--- a/contrib/vanilla-module.mk
+++ b/contrib/vanilla-module.mk
@@ -1,5 +1,5 @@
 
-$(MODULE).fasl: $(MODULE).lisp
+$(MODULE).fasl: $(MODULE).lisp ../../output/sbcl.core
 	$(SBCL) --eval '(compile-file "$(MODULE)")' </dev/null
 
 test:: $(MODULE).fasl
diff --git a/doc/clean.sh b/doc/clean.sh
new file mode 100644
index 0000000..92c882d
--- /dev/null
+++ b/doc/clean.sh
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+find . \( \
+	-name '*.htm' -o \
+	-name '*.html' \) -print | xargs rm -f
diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp
index 2db5a48..61f4d29 100644
--- a/src/code/sxhash.lisp
+++ b/src/code/sxhash.lisp
@@ -38,10 +38,44 @@
 ;;; simple.
 (deftransform sxhash ((x) (fixnum))
   '(logand most-positive-fixnum
-	   (logxor x
-		   (ash x -3) ; to get sign bit into hash
+	   (logxor (ash (logand x (ash most-positive-fixnum -4)) 4) 
+		   (ash x -1) ; to get sign bit into hash
 		   361475658)))
 
+;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
+;;; because it is endian-dependent.
+(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)))))))))
+
 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
 ;;; order to avoid having to do TYPECASE at runtime.
 ;;;
@@ -59,3 +93,5 @@
   (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
       (sxhash (continuation-value x))
       '(%sxhash-simple-string (symbol-name x))))
+
+
diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 890dfed..0b65801 100644
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -115,6 +115,9 @@
 ;;;; the SXHASH function
 
 (defun sxhash (x)
+  ;; profiling SXHASH is hard, but we might as well try to make it go
+  ;; fast, in case it is the bottleneck somwhere.  -- CSR, 2003-03-14
+  (declare (optimize speed))
   (labels ((sxhash-number (x)
 	     (etypecase x
 	       (fixnum (sxhash x))	; through DEFTRANSFORM
@@ -151,11 +154,15 @@
 		(typecase x
 		  (simple-string (sxhash x)) ; through DEFTRANSFORM
 		  (string (%sxhash-substring x))
-		  (bit-vector (let ((result 410823708))
-				(declare (type fixnum result))
-				(dotimes (i (min depthoid (length x)))
-				  (mixf result (aref x i)))
-				result))
+		  (simple-bit-vector (sxhash x)) ; through DEFTRANSFORM
+		  (bit-vector
+		   ;; FIXME: It must surely be possible to do better
+		   ;; 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
+		   ;; approach.  This will probably do for now.
+		   (sxhash-recurse (copy-seq x) depthoid))
 		  (t (logxor 191020317 (sxhash (array-rank x))))))
 	       (character
 		(logxor 72185131
diff --git a/src/cold/snapshot.lisp b/src/cold/snapshot.lisp
index a52d1ca..0e6723d 100644
--- a/src/cold/snapshot.lisp
+++ b/src/cold/snapshot.lisp
@@ -121,7 +121,7 @@
 		      #-cmu nil
 		      #+cmu (cl::*gc-trigger*
 			     cl::inch-ptr
-			     cl::*internal-symbol-output-fun*
+			     cl::*internal-symbol-output-function*
 			     cl::ouch-ptr
 			     cl::*previous-case*
 			     cl::read-buffer
@@ -131,6 +131,10 @@
 			     cl::*current-unwind-protect-block*
 			     cl::*load-depth*
 			     cl::*free-fop-tables*
+			     cl::*load-symbol-buffer*
+			     cl::*load-symbol-buffer-size*
+			     cl::in-index
+			     cl::in-buffer
 			     ;; These two are changed by PURIFY.
 			     cl::*static-space-free-pointer*
 			     cl::*static-space-end-pointer*)
diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
index 89851b0..e61faf3 100644
--- a/src/runtime/monitor.c
+++ b/src/runtime/monitor.c
@@ -283,7 +283,7 @@ quit_cmd(char **ptr)
     fflush(stdout);
     fgets(buf, sizeof(buf), ldb_in);
     if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
-        exit(0);
+        exit(1);
 }
 
 static void
diff --git a/tests/hash.impure.lisp b/tests/hash.impure.lisp
index 8b3636c..fae5863 100644
--- a/tests/hash.impure.lisp
+++ b/tests/hash.impure.lisp
@@ -52,7 +52,17 @@
 		 (complex 1.5 -3/2) (complex 1.5 -1.5d0)
 	       
 		 #\x #\X #\*
+		 
+		 (copy-seq "foo") (copy-seq "foobar") (copy-seq "foobarbaz")
 
+		 (copy-seq #*)
+		 (copy-seq #*0) (copy-seq #*1)
+		 (copy-seq #*00) (copy-seq #*10)
+		 (copy-seq #*01) (copy-seq #*11)
+		 (copy-seq #*10010) (copy-seq #*100101) (bit-not #*01101)
+		 (make-array 6 :fill-pointer 6
+			     :element-type 'bit :initial-contents #*100101)
+		 
 		 #'allocate-instance #'no-applicable-method))
 	 (make-psxhash-extra-subtests ()
 	   (list (copy-seq "")
@@ -180,7 +190,8 @@
       ;; that the SXHASH distribution changes, not once every time the
       ;; tests are run.)
       (dolist (i sxhash-tests)
-	(unless (typep (sxhash i) '(and fixnum unsigned-byte))
+	(declare (notinline funcall))
+	(unless (typep (funcall #'sxhash i) '(and fixnum unsigned-byte))
 	  (error "bad SXHASH behavior for ~S" i))
 	(dolist (j sxhash-tests)
 	  (unless (eq (t->boolean (equal i j))
diff --git a/version.lisp-expr b/version.lisp-expr
index 46e7979..b3ebddb 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.13.27"
+"0.7.13.28"
-- 
1.7.10.4