UPGRADED-ARRAY-ELEMENT-TYPE: more thoroughly signal errors on unknown types.

[sbcl.git] / src / compiler / x86-64 / move.lisp

diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index 423a0b9..f10a953 100644 (file)
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -103,9 +103,7 @@
         (let ((val (tn-value x)))
           (etypecase val
             (integer
-             (if (and (zerop val) (sc-is y any-reg descriptor-reg))
-                 (zeroize y)
-                 (move-immediate y (fixnumize val) temp)))
+             (move-immediate y (fixnumize val) temp))
             (symbol
              (inst mov y (+ nil-value (static-symbol-offset val))))
             (character
@@ -127,7 +125,9 @@
     ;; If target is a register, we can just mov it there directly
     ((and (tn-p target)
           (sc-is target signed-reg unsigned-reg descriptor-reg any-reg))
-     (inst mov target val))
+     (if (zerop val)
+         (zeroize target)
+         (inst mov target val)))
     ;; Likewise if the value is small enough.
     ((typep val '(signed-byte 32))
      (inst mov target val))
@@ -327,35 +327,43 @@
 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
 ;;; routine.
 (define-vop (move-from-signed)
-  (:args (x :scs (signed-reg unsigned-reg) :to :result))
-  (:results (y :scs (any-reg descriptor-reg) :from :argument))
+  (:args (x :scs (signed-reg unsigned-reg) :to :result . #.(and (= 1 n-fixnum-tag-bits)
+                                                                '(:target y))))
+  (:results (y :scs (any-reg descriptor-reg) . #.(and (> n-fixnum-tag-bits 1)
+                                                      '(:from :argument))))
   (:note "signed word to integer coercion")
   ;; Worst case cost to make sure people know they may be number consing.
   (:generator 20
-     (aver (not (location= x y)))
-     (let ((done (gen-label)))
-       (inst imul y x #.(ash 1 n-fixnum-tag-bits))
-       (inst jmp :no done)
-       (inst mov y x)
-       (inst lea temp-reg-tn
-             (make-ea :qword :disp
-                      (make-fixup (ecase (tn-offset y)
-                                    (#.rax-offset 'alloc-signed-bignum-in-rax)
-                                    (#.rcx-offset 'alloc-signed-bignum-in-rcx)
-                                    (#.rdx-offset 'alloc-signed-bignum-in-rdx)
-                                    (#.rbx-offset 'alloc-signed-bignum-in-rbx)
-                                    (#.rsi-offset 'alloc-signed-bignum-in-rsi)
-                                    (#.rdi-offset 'alloc-signed-bignum-in-rdi)
-                                    (#.r8-offset  'alloc-signed-bignum-in-r8)
-                                    (#.r9-offset  'alloc-signed-bignum-in-r9)
-                                    (#.r10-offset 'alloc-signed-bignum-in-r10)
-                                    (#.r12-offset 'alloc-signed-bignum-in-r12)
-                                    (#.r13-offset 'alloc-signed-bignum-in-r13)
-                                    (#.r14-offset 'alloc-signed-bignum-in-r14)
-                                    (#.r15-offset 'alloc-signed-bignum-in-r15))
-                                  :assembly-routine)))
-       (inst call temp-reg-tn)
-       (emit-label done))))
+     (cond ((= 1 n-fixnum-tag-bits)
+            (move y x)
+            (inst shl y 1)
+            (inst jmp :no DONE)
+            (if (location= y x)
+                (inst rcr y 1) ; we're about to cons a bignum. this RCR is noise
+                (inst mov y x)))
+           (t
+            (aver (not (location= x y)))
+            (inst imul y x #.(ash 1 n-fixnum-tag-bits))
+            (inst jmp :no DONE)
+            (inst mov y x)))
+     (inst mov temp-reg-tn
+           (make-fixup (ecase (tn-offset y)
+                         (#.rax-offset 'alloc-signed-bignum-in-rax)
+                         (#.rcx-offset 'alloc-signed-bignum-in-rcx)
+                         (#.rdx-offset 'alloc-signed-bignum-in-rdx)
+                         (#.rbx-offset 'alloc-signed-bignum-in-rbx)
+                         (#.rsi-offset 'alloc-signed-bignum-in-rsi)
+                         (#.rdi-offset 'alloc-signed-bignum-in-rdi)
+                         (#.r8-offset  'alloc-signed-bignum-in-r8)
+                         (#.r9-offset  'alloc-signed-bignum-in-r9)
+                         (#.r10-offset 'alloc-signed-bignum-in-r10)
+                         (#.r12-offset 'alloc-signed-bignum-in-r12)
+                         (#.r13-offset 'alloc-signed-bignum-in-r13)
+                         (#.r14-offset 'alloc-signed-bignum-in-r14)
+                         (#.r15-offset 'alloc-signed-bignum-in-r15))
+                       :assembly-routine))
+     (inst call temp-reg-tn)
+     DONE))
 (define-move-vop move-from-signed :move
   (signed-reg) (descriptor-reg))
 
@@ -386,23 +394,22 @@
                                :scale (ash 1 n-fixnum-tag-bits))))
       (inst jmp :z done)
       (inst mov y x)
-      (inst lea temp-reg-tn
-            (make-ea :qword :disp
-                     (make-fixup (ecase (tn-offset y)
-                                   (#.rax-offset 'alloc-unsigned-bignum-in-rax)
-                                   (#.rcx-offset 'alloc-unsigned-bignum-in-rcx)
-                                   (#.rdx-offset 'alloc-unsigned-bignum-in-rdx)
-                                   (#.rbx-offset 'alloc-unsigned-bignum-in-rbx)
-                                   (#.rsi-offset 'alloc-unsigned-bignum-in-rsi)
-                                   (#.rdi-offset 'alloc-unsigned-bignum-in-rdi)
-                                   (#.r8-offset  'alloc-unsigned-bignum-in-r8)
-                                   (#.r9-offset  'alloc-unsigned-bignum-in-r9)
-                                   (#.r10-offset 'alloc-unsigned-bignum-in-r10)
-                                   (#.r12-offset 'alloc-unsigned-bignum-in-r12)
-                                   (#.r13-offset 'alloc-unsigned-bignum-in-r13)
-                                   (#.r14-offset 'alloc-unsigned-bignum-in-r14)
-                                   (#.r15-offset 'alloc-unsigned-bignum-in-r15))
-                                 :assembly-routine)))
+      (inst mov temp-reg-tn
+            (make-fixup (ecase (tn-offset y)
+                          (#.rax-offset 'alloc-unsigned-bignum-in-rax)
+                          (#.rcx-offset 'alloc-unsigned-bignum-in-rcx)
+                          (#.rdx-offset 'alloc-unsigned-bignum-in-rdx)
+                          (#.rbx-offset 'alloc-unsigned-bignum-in-rbx)
+                          (#.rsi-offset 'alloc-unsigned-bignum-in-rsi)
+                          (#.rdi-offset 'alloc-unsigned-bignum-in-rdi)
+                          (#.r8-offset  'alloc-unsigned-bignum-in-r8)
+                          (#.r9-offset  'alloc-unsigned-bignum-in-r9)
+                          (#.r10-offset 'alloc-unsigned-bignum-in-r10)
+                          (#.r12-offset 'alloc-unsigned-bignum-in-r12)
+                          (#.r13-offset 'alloc-unsigned-bignum-in-r13)
+                          (#.r14-offset 'alloc-unsigned-bignum-in-r14)
+                          (#.r15-offset 'alloc-unsigned-bignum-in-r15))
+                        :assembly-routine))
       (inst call temp-reg-tn)
       (emit-label done))))
 (define-move-vop move-from-unsigned :move