[Sbcl-commits] master: Implement ash-right-vops on ARM.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  d5605ebefbec87ad4b9b5d58a65fddd59665caa7 (commit)
      from  3ade1d8336dcb869329b908faad5d8acadccb634 (commit)

- Log -----------------------------------------------------------------
commit d5605ebefbec87ad4b9b5d58a65fddd59665caa7
Author: Stas Boukarev <sta...@gm...>
Date:   Mon May 12 04:05:29 2014 +0400

    Implement ash-right-vops on ARM.
---
 make-config.sh              |    1 +
 src/compiler/arm/arith.lisp |   64 +++++++++++++++++++++++++++++++++++++++----
 src/compiler/fndb.lisp      |    4 +-
 3 files changed, 61 insertions(+), 8 deletions(-)

diff --git a/make-config.sh b/make-config.sh
index 9b998fe..5de750e 100755
--- a/make-config.sh
+++ b/make-config.sh
@@ -680,6 +680,7 @@ elif [ "$sbcl_arch" = "arm" ]; then
     # possibly VFPv2 and higher only), but we'll leave the obvious
     # hooks in for someone to add the support later.
     printf ' :arm-vfp :arm-vfpv2' >> $ltf
+    printf ' :ash-right-vops' >> $ltf
 else
     # Nothing need be done in this case, but sh syntax wants a placeholder.
     echo > /dev/null
diff --git a/src/compiler/arm/arith.lisp b/src/compiler/arm/arith.lisp
index 4f99dc0..70a0406 100644
--- a/src/compiler/arm/arith.lisp
+++ b/src/compiler/arm/arith.lisp
@@ -236,6 +236,20 @@
         (inst mov result (lsl number amount))
         (inst mov result 0))))
 
+(define-vop (fast-ash-right-c/fixnum=>fixnum)
+  (:translate ash)
+  (:policy :fast-safe)
+  (:args (number :scs (any-reg) :target result))
+  (:info amount)
+  (:arg-types tagged-num (:constant (integer * -1)))
+  (:results (result :scs (any-reg)))
+  (:result-types tagged-num)
+  (:temporary (:sc unsigned-reg :target result) temp)
+  (:note "inline ASH")
+  (:generator 1
+    (inst mov temp (asr number (min (- amount) 31)))
+    (inst bic result temp fixnum-tag-mask)))
+
 (define-vop (fast-ash-left-modfx-c/fixnum=>fixnum
              fast-ash-left-c/fixnum=>fixnum)
   (:translate ash-left-modfx))
@@ -254,12 +268,12 @@
   (:result-types unsigned-num)
   (:note "inline ASH")
   (:generator 3
-     (cond ((< -32 amount 32)
-            (if (plusp amount)
-                (inst mov result (lsl number amount))
-                (inst mov result (asr number (- amount)))))
-           (t
-            (inst mov result 0)))))
+    (cond ((< -32 amount 32)
+           (if (plusp amount)
+               (inst mov result (lsl number amount))
+               (inst mov result (asr number (- amount)))))
+          (t
+           (inst mov result 0)))))
 
 (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
              fast-ash-c/unsigned=>unsigned)
@@ -335,6 +349,44 @@
              fast-ash-left/unsigned=>unsigned)
   (:translate ash-left-mod32))
 
+#!+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)))
+  (:arg-types unsigned-num unsigned-num)
+  (:results (result :scs (unsigned-reg) :from (:argument 0)))
+  (:result-types unsigned-num)
+  (:generator 4
+    (inst mov result (lsr number amount))))
+
+#!+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)))
+  (:arg-types signed-num unsigned-num)
+  (:results (result :scs (signed-reg) :from (:argument 0)))
+  (:result-types signed-num)
+  (:generator 4
+    (inst mov result (asr number amount))))
+
+#!+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 temp))
+  (:arg-types tagged-num unsigned-num)
+  (:results (result :scs (any-reg) :from (:argument 0)))
+  (:result-types tagged-num)
+  (:temporary (:sc unsigned-reg :target result) temp)
+  (:generator 3
+    (inst mov temp (asr number amount))
+    (inst bic result temp fixnum-tag-mask)))
+
 ;;; Only the lower 5 bits of the shift amount are significant.
 (define-vop (shift-towards-someplace)
   (:policy :fast-safe)
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 36be119..ff48071 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -375,8 +375,8 @@
   (movable foldable flushable explicit-check))
 #!+ash-right-vops
 (defknown %ash/right ((or word sb!vm:signed-word) (mod #.sb!vm:n-word-bits))
-    (or word sb!vm:signed-word)
-    (movable foldable flushable always-translatable))
+  (or word sb!vm:signed-word)
+  (movable foldable flushable always-translatable))
 (defknown (logcount integer-length) (integer) bit-index
   (movable foldable flushable explicit-check))
 ;;; FIXME: According to the ANSI spec, it's legal to use any

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL