From 6794373d588cef4333fbbb9d04b931ae0a414a7f Mon Sep 17 00:00:00 2001
From: Paul Khuong <pvk@pvk.ca>
Date: Mon, 20 May 2013 17:38:19 -0400
Subject: [PATCH] More efficient integer=>word conversion and fixnump tests on
 x86-64

 * Special-case on 63-bit fixnums to detect non-zero fixnum tag bits
   with a shift right when converting fixnum-or-bignum to ub64.

 * In fixnump/unsigned-byte-64, use MOVE to avoid useless mov x, x.

 * In fixnump/signed-byte-64, use the conversion's left shift to
   detect overflows.

 * Based on a patch by Douglas Katzman.
---
 src/compiler/x86-64/move.lisp      |   40 ++++++++++++++++++++++++++++--------
 src/compiler/x86-64/type-vops.lisp |   26 +++++++++++++++++------
 2 files changed, 52 insertions(+), 14 deletions(-)

diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index cc0a777..423a0b9 100644
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -256,26 +256,50 @@
 
 
 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
+#-#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or))
 (define-vop (move-to-word/integer)
-  (:args (x :scs (descriptor-reg) :target eax))
+  (:args (x :scs (descriptor-reg) :target rax))
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "integer to untagged word coercion")
-  (:temporary (:sc unsigned-reg :offset eax-offset
-                   :from (:argument 0) :to (:result 0) :target y) eax)
+  ;; I'm not convinced that increasing the demand for rAX is
+  ;; better than adding 1 byte to some instruction encodings.
+  ;; I'll leave it alone though.
+  (:temporary (:sc unsigned-reg :offset rax-offset
+               :from (:argument 0) :to (:result 0) :target y) rax)
   (:generator 4
-    (move eax x)
+    (move rax x)
     (inst test al-tn fixnum-tag-mask)
     (inst jmp :z FIXNUM)
-    (loadw y eax bignum-digits-offset other-pointer-lowtag)
+    (loadw y rax bignum-digits-offset other-pointer-lowtag)
     (inst jmp DONE)
     FIXNUM
-    (inst sar eax n-fixnum-tag-bits)
-    (move y eax)
+    (inst sar rax n-fixnum-tag-bits)
+    (move y rax)
     DONE))
+
+#+#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or))
+(define-vop (move-to-word/integer)
+  (:args (x :scs (descriptor-reg) :target y))
+  (:results (y :scs (signed-reg unsigned-reg)))
+  (:note "integer to untagged word coercion")
+  (:temporary (:sc unsigned-reg) backup)
+  (:generator 4
+    (move y x)
+    (if (location= x y)
+        ;; It would be great if a principled way existed to advise GC of
+        ;; algebraic transforms such as 2*R being a conservative root.
+        ;; Until that is possible, emit straightforward code that uses
+        ;; a copy of the potential reference.
+        (move backup x)
+        (setf backup x))
+    (inst sar y 1)      ; optimistically assume it's a fixnum
+    (inst jmp :nc DONE) ; no carry implies tag was 0
+    (loadw y backup bignum-digits-offset other-pointer-lowtag)
+    DONE))
+
 (define-move-vop move-to-word/integer :move
   (descriptor-reg) (signed-reg unsigned-reg))
 
-
 ;;; Result is a fixnum, so we can just shift. We need the result type
 ;;; restriction because of the control-stack ambiguity noted above.
 (define-vop (move-from-word/fixnum)
diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 8e99ec1..bc246c5 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -219,17 +219,19 @@
   (:args (value :scs (unsigned-reg)))
   (:arg-types unsigned-num)
   (:translate fixnump)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:temporary (:sc unsigned-reg :from (:argument 0)) tmp)
   (:info)
   (:conditional :z)
   (:generator 5
-    (inst mov tmp value)
+    (move tmp value)
     (inst shr tmp n-positive-fixnum-bits)))
 
-(define-vop (fixnump/signed-byte-64 type-predicate)
+#-#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or))
+(define-vop (fixnump/signed-byte-64 simple-type-predicate)
   (:args (value :scs (signed-reg)))
   (:info)
-  (:conditional #.(if (= sb!vm:n-fixnum-tag-bits 1) :ns :z))
+  (:conditional :z)
+  (:temporary (:sc unsigned-reg :offset eax-offset) eax)
   (:arg-types signed-num)
   (:translate fixnump)
   (:generator 5
@@ -239,8 +241,20 @@
     ;;    ((x-a) >> n) = 0
     (inst mov rax-tn #.(- sb!xc:most-negative-fixnum))
     (inst add rax-tn value)
-    (unless (= n-fixnum-tag-bits 1)
-      (inst shr rax-tn n-fixnum-bits))))
+    (inst shr rax-tn n-fixnum-bits)))
+
+#+#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or))
+(define-vop (fixnump/signed-byte-64 simple-type-predicate)
+  (:args (value :scs (signed-reg) :target temp))
+  (:info)
+  (:conditional :no)
+  (:temporary (:sc unsigned-reg :from (:argument 0)) temp)
+  (:arg-types signed-num)
+  (:translate fixnump)
+  (:generator 5
+    (move temp value)
+    ;; The overflow flag will be set if the reg's sign bit changes.
+    (inst shl temp 1)))
 
 ;;; A (SIGNED-BYTE 64) can be represented with either fixnum or a bignum with
 ;;; exactly one digit.
-- 
1.7.10.4