X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=4ff8a4dcd8bc531953dd22b4fddac3fcdf4bfb8a;hb=13fb19c3183a0effb7c35a2d453d6c6c91726e26;hp=065674e1efc01ab88357239e2b002c7c1f7c768a;hpb=7f9f1fd113d7047731bda9dab2c7719cdf092a21;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 065674e..4ff8a4d 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -317,6 +317,8 @@
            function-name key-functions variant)))
 
 (defun transform-list-item-seek (name item list key test test-not node)
+  (when (and test test-not)
+    (abort-ir1-transform "Both ~S and ~S supplied to ~S." :test :test-not name))
   ;; If TEST is EQL, drop it.
   (when (and test (lvar-fun-is test '(eql)))
     (setf test nil))
@@ -569,40 +571,44 @@
                                         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
                                         (:complex-single-float
                                          (logior (ash (single-float-bits (imagpart tmp)) 32)
-                                                 (single-float-bits (realpart tmp)))))))
+                                                 (ldb (byte 32 0)
+                                                      (single-float-bits (realpart tmp))))))))
                                 (res bits))
                            (loop for i of-type sb!vm:word from n-bits by n-bits
                                  until (= i sb!vm:n-word-bits)
                                  do (setf res (ldb (byte sb!vm:n-word-bits 0)
                                                    (logior res (ash bits i)))))
                            res))
-                       `(let* ((bits (ldb (byte ,n-bits 0)
-                                          ,(ecase kind
-                                                  (:tagged
-                                                   `(ash item ,sb!vm:n-fixnum-tag-bits))
-                                                  (:char
-                                                   `(char-code item))
-                                                  (:bits
-                                                   `item)
-                                                  (:single-float
-                                                   `(single-float-bits item))
-                                                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                                                  (:double-float
-                                                   `(logior (ash (double-float-high-bits item) 32)
-                                                            (double-float-low-bits item)))
-                                                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                                                  (:complex-single-float
-                                                   `(logior (ash (single-float-bits (imagpart item)) 32)
-                                                            (single-float-bits (realpart item)))))))
-                               (res bits))
-                          (declare (type sb!vm:word res))
-                          ,@(unless (= sb!vm:n-word-bits n-bits)
-                                    `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits
-                                            until (= i sb!vm:n-word-bits)
-                                            do (setf res
-                                                     (ldb (byte ,sb!vm:n-word-bits 0)
-                                                          (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i))))))))
-                          res))))
+                       (progn
+                         (delay-ir1-transform node :constraint)
+                        `(let* ((bits (ldb (byte ,n-bits 0)
+                                           ,(ecase kind
+                                                   (:tagged
+                                                    `(ash item ,sb!vm:n-fixnum-tag-bits))
+                                                   (:char
+                                                    `(char-code item))
+                                                   (:bits
+                                                    `item)
+                                                   (:single-float
+                                                    `(single-float-bits item))
+                                                   #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                                                   (:double-float
+                                                    `(logior (ash (double-float-high-bits item) 32)
+                                                             (double-float-low-bits item)))
+                                                   #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                                                   (:complex-single-float
+                                                    `(logior (ash (single-float-bits (imagpart item)) 32)
+                                                             (ldb (byte 32 0)
+                                                                  (single-float-bits (realpart item))))))))
+                                (res bits))
+                           (declare (type sb!vm:word res))
+                           ,@(unless (= sb!vm:n-word-bits n-bits)
+                                     `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits
+                                             until (= i sb!vm:n-word-bits)
+                                             do (setf res
+                                                      (ldb (byte ,sb!vm:n-word-bits 0)
+                                                           (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i))))))))
+                           res)))))
              (values
               `(with-array-data ((data seq)
                                  (start start)