From: Paul Khuong <pvk@pvk.ca>
Date: Wed, 22 May 2013 04:18:26 +0000 (-0400)
Subject: More efficient move-from-signed on x86-64 with 63-bit fixnums
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1ac6167d26eb60a2b7e46bc39f4b091e39b5e03d;p=sbcl.git

More efficient move-from-signed on x86-64 with 63-bit fixnums

We can SHL instead of IMUL to check for overflow, and only have to
RCR the sign bit back in to recover the original value.
---

diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index 423a0b9..7544b8b 100644
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -327,35 +327,44 @@
 ;;; 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 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)
+     DONE))
 (define-move-vop move-from-signed :move
   (signed-reg) (descriptor-reg))