From: Nathan Froyd <froydnj@cs.rice.edu>
Date: Tue, 10 Aug 2004 02:55:33 +0000 (+0000)
Subject: 0.8.13.48:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e4937e886890f3fcef391650a494f75cfc46c528;p=sbcl.git

0.8.13.48:
	Fix 32/64-bit issues with VM-independent transforms
---

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index bf50175..47d2d8b 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -282,16 +282,16 @@
 		    bit-array result-bit-array))))
     (let ((length (length result-bit-array)))
       (if (= length 0)
-	  ;; We avoid doing anything to 0-length bit-vectors, or
-	  ;; rather, the memory that follows them. Other
-	  ;; divisible-by-32 cases are handled by the (1- length),
-	  ;; below.  CSR, 2002-04-24
+	  ;; We avoid doing anything to 0-length bit-vectors, or rather,
+	  ;; the memory that follows them. Other divisible-by
+	  ;; n-word-bits cases are handled by the (1- length), below.
+	  ;; CSR, 2002-04-24
 	  result-bit-array
 	  (do ((index sb!vm:vector-data-offset (1+ index))
 	       (end-1 (+ sb!vm:vector-data-offset
-			 ;; bit-vectors of length 1-32 need precisely
-			 ;; one (SETF %RAW-BITS), done here in the
-			 ;; epilogue. - CSR, 2002-04-24
+			 ;; bit-vectors of length 1 to n-word-bits need
+			 ;; precisely one (SETF %RAW-BITS), done here in
+			 ;; the epilogue. - CSR, 2002-04-24
 			 (truncate (truly-the index (1- length))
 				   sb!vm:n-word-bits))))
 	      ((= index end-1)
@@ -329,7 +329,8 @@
 				     (:big-endian
 				      '(- sb!vm:n-word-bits extra))))
 			     (%raw-bits y i))))
-		      (declare (type (integer 0 31) extra)
+		      (declare (type (integer 0 #.(1- sb!vm:n-word-bits))
+                                     extra)
 			       (type sb!vm:word mask numx numy))
 		      (= numx numy)))
 		(declare (type index i end-1))
@@ -358,6 +359,7 @@
 					       (:big-endian
 						'(- sb!vm:n-word-bits extra))))
 				  (%raw-bits sequence index))))
+               (declare (type (mod #.(1- sb!vm:n-word-bits)) extra))
                (declare (type sb!vm:word mask bits))
                ;; could consider LOGNOT for the zero case instead of
                ;; doing the subtraction...
@@ -383,17 +385,17 @@
   (let ((value (if (constant-lvar-p item)
 		   (if (= (lvar-value item) 0)
 		       0
-		       #.(1- (ash 1 32)))
-		   `(if (= item 0) 0 #.(1- (ash 1 32))))))
+		       #.(1- (ash 1 sb!vm:n-word-bits)))
+		   `(if (= item 0) 0 #.(1- (ash 1 sb!vm:n-word-bits))))))
     `(let ((length (length sequence))
 	   (value ,value))
        (if (= length 0)
 	   sequence
 	   (do ((index sb!vm:vector-data-offset (1+ index))
 		(end-1 (+ sb!vm:vector-data-offset
-			  ;; bit-vectors of length 1-32 need precisely
-			  ;; one (SETF %RAW-BITS), done here in the
-			  ;; epilogue. - CSR, 2002-04-24
+			  ;; bit-vectors of length 1 to n-word-bits need
+			  ;; precisely one (SETF %RAW-BITS), done here
+                          ;; in the epilogue. - CSR, 2002-04-24
 			  (truncate (truly-the index (1- length))
 				    sb!vm:n-word-bits))))
 	       ((= index end-1)
@@ -407,18 +409,21 @@
 		    :policy (>= speed space))
   (let ((value (if (constant-lvar-p item)
 		   (let* ((char (lvar-value item))
-			  (code (sb!xc:char-code char)))
-		     (logior code (ash code 8) (ash code 16) (ash code 24)))
+			  (code (sb!xc:char-code char))
+                          (accum 0))
+                     (dotimes (i sb!vm:n-word-bytes)
+                       (setf accum (logior accum (ash code (* 8 i))))))
 		   `(let ((code (sb!xc:char-code item)))
-		     (logior code (ash code 8) (ash code 16) (ash code 24))))))
+                     (logior ,@(loop for i from 0 upto sb!vm:n-word-bytes
+                                     collect `(ash code ,(* 8 i))))))))
     `(let ((length (length sequence))
 	   (value ,value))
       (multiple-value-bind (times rem)
-	  (truncate length 4)
+	  (truncate length sb!vm:n-word-bytes)
 	(do ((index sb!vm:vector-data-offset (1+ index))
 	     (end (+ times sb!vm:vector-data-offset)))
 	    ((= index end)
-	     (let ((place (* times 4)))
+	     (let ((place (* times sb!vm:n-word-bytes)))
 	       (declare (fixnum place))
 	       (dotimes (j rem sequence)
 		 (declare (index j))
diff --git a/version.lisp-expr b/version.lisp-expr
index 5337980..940f88c 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".)
-"0.8.13.47"
+"0.8.13.48"