X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=b5f20d7570643b60775995653d8e3fd125b90615;hb=c9b36f04557bd6c7208863e73bae7b1bc6e64842;hp=0557abc6013d7c898e104a011aab9b37a186cc1b;hpb=eb4a67799308fc2e610ca330401c9cb07533143c;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 0557abc..b5f20d7 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -260,7 +260,7 @@
                                        ;; epilogue. - CSR, 2002-04-24
                                        (truncate (truly-the index (1- length))
                                                  sb!vm:n-word-bits))))
-                            ((= index end-1)
+                            ((>= index end-1)
                              (setf (%raw-bits result-bit-array index)
                                    (,',wordfun (%raw-bits bit-array-1 index)
                                                (%raw-bits bit-array-2 index)))
@@ -306,7 +306,7 @@
                          ;; the epilogue. - CSR, 2002-04-24
                          (truncate (truly-the index (1- length))
                                    sb!vm:n-word-bits))))
-              ((= index end-1)
+              ((>= index end-1)
                (setf (%raw-bits result-bit-array index)
                      (word-logical-not (%raw-bits bit-array index)))
                result-bit-array)
@@ -322,7 +322,7 @@
               (do* ((i sb!vm:vector-data-offset (+ i 1))
                     (end-1 (+ sb!vm:vector-data-offset
                               (floor (1- length) sb!vm:n-word-bits))))
-                   ((= i end-1)
+                   ((>= i end-1)
                     (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)))
@@ -362,7 +362,7 @@
              (end-1 (+ sb!vm:vector-data-offset
                        (truncate (truly-the index (1- length))
                                  sb!vm:n-word-bits))))
-            ((= index end-1)
+            ((>= index end-1)
              (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)))
@@ -374,24 +374,17 @@
                                   (%raw-bits sequence index))))
                (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...
-               (incf count ,(if (constant-lvar-p item)
-                                (if (zerop (lvar-value item))
-                                    '(- extra (logcount bits))
-                                    '(logcount bits))
-                                '(if (zerop item)
-                                     (- extra (logcount bits))
-                                     (logcount bits))))))
+               (incf count (logcount bits))
+               ,(if (constant-lvar-p item)
+                    (if (zerop (lvar-value item))
+                        '(- length count)
+                        'count)
+                    '(if (zerop item)
+                         (- length count)
+                         count))))
           (declare (type index index count end-1)
                    (optimize (speed 3) (safety 0)))
-          (incf count ,(if (constant-lvar-p item)
-                           (if (zerop (lvar-value item))
-                               '(- sb!vm:n-word-bits (logcount (%raw-bits sequence index)))
-                               '(logcount (%raw-bits sequence index)))
-                           '(if (zerop item)
-                             (- sb!vm:n-word-bits (logcount (%raw-bits sequence index)))
-                             (logcount (%raw-bits sequence index)))))))))
+          (incf count (logcount (%raw-bits sequence index)))))))
 
 (deftransform fill ((sequence item) (simple-bit-vector bit) *
                     :policy (>= speed space))
@@ -411,7 +404,7 @@
                           ;; in the epilogue. - CSR, 2002-04-24
                           (truncate (truly-the index (1- length))
                                     sb!vm:n-word-bits))))
-               ((= index end-1)
+               ((>= index end-1)
                 (setf (%raw-bits sequence index) value)
                 sequence)
              (declare (optimize (speed 3) (safety 0))
@@ -435,7 +428,7 @@
           (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)
+            ((>= index end)
              (let ((place (* times sb!vm:n-word-bytes)))
                (declare (fixnum place))
                (dotimes (j rem sequence)