0.9.2.40:

[sbcl.git] / src / compiler / generic / vm-tran.lisp

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 1489bac..36d4227 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -317,8 +317,9 @@
                    (end-1 (+ sb!vm:vector-data-offset
                              (floor (1- length) sb!vm:n-word-bits))))
                   ((= i end-1)
-                   (let* ((extra (mod length sb!vm:n-word-bits))
-                          (mask (1- (ash 1 extra)))
+                   (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
+                          (mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
+                                     (- extra sb!vm:n-word-bits)))
                           (numx
                            (logand
                             (ash mask
@@ -335,8 +336,7 @@
                                     (:big-endian
                                      '(- sb!vm:n-word-bits extra))))
                             (%raw-bits y i))))
-                     (declare (type (mod #.sb!vm:n-word-bits)
-                                     extra)
+                     (declare (type (integer 1 #.sb!vm:n-word-bits) extra)
                               (type sb!vm:word mask numx numy))
                      (= numx numy)))
                (declare (type index i end-1))
@@ -357,15 +357,16 @@
                        (truncate (truly-the index (1- length))
                                  sb!vm:n-word-bits))))
             ((= index end-1)
-             (let* ((extra (mod length sb!vm:n-word-bits))
-                   (mask (1- (ash 1 extra)))
+             (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
+                   (mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
+                              (- extra sb!vm:n-word-bits)))
                    (bits (logand (ash mask
                                       ,(ecase sb!c:*backend-byte-order*
                                               (:little-endian 0)
                                               (:big-endian
                                                '(- sb!vm:n-word-bits extra))))
                                  (%raw-bits sequence index))))
-               (declare (type (mod #.sb!vm:n-word-bits) extra))
+               (declare (type (integer 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...