Simpler word-sized variable right shifts on x86 and x86-64

[sbcl.git] / src / compiler / x86 / arith.lisp

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index ab11950..79064d0 100644 (file)
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -810,6 +810,52 @@ constant shift greater than word length")))
 
     DONE))
 
+#!+ash-right-vops
+(define-vop (fast-%ash/right/unsigned)
+  (:translate %ash/right)
+  (:policy :fast-safe)
+  (:args (number :scs (unsigned-reg) :target result)
+         (amount :scs (unsigned-reg) :target ecx))
+  (:arg-types unsigned-num unsigned-num)
+  (:results (result :scs (unsigned-reg) :from (:argument 0)))
+  (:result-types unsigned-num)
+  (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
+  (:generator 4
+    (move result number)
+    (move ecx amount)
+    (inst shr result :cl)))
+
+#!+ash-right-vops
+(define-vop (fast-%ash/right/signed)
+  (:translate %ash/right)
+  (:policy :fast-safe)
+  (:args (number :scs (signed-reg) :target result)
+         (amount :scs (unsigned-reg) :target ecx))
+  (:arg-types signed-num unsigned-num)
+  (:results (result :scs (signed-reg) :from (:argument 0)))
+  (:result-types signed-num)
+  (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
+  (:generator 4
+    (move result number)
+    (move ecx amount)
+    (inst sar result :cl)))
+
+#!+ash-right-vops
+(define-vop (fast-%ash/right/fixnum)
+  (:translate %ash/right)
+  (:policy :fast-safe)
+  (:args (number :scs (any-reg) :target result)
+         (amount :scs (unsigned-reg) :target ecx))
+  (:arg-types tagged-num unsigned-num)
+  (:results (result :scs (any-reg) :from (:argument 0)))
+  (:result-types tagged-num)
+  (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
+  (:generator 3
+    (move result number)
+    (move ecx amount)
+    (inst sar result :cl)
+    (inst and result (lognot fixnum-tag-mask))))
+
 (in-package "SB!C")
 
 (defknown %lea (integer integer (member 1 2 4 8) (signed-byte 32))