From c8336f4f5d6db53ade50804632414608e6adbd3f Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 1 May 2014 22:41:33 +0400
Subject: [PATCH] Optimize LOGBITP on ARM.

Using the TST instruction.
---
 src/compiler/arm/arith.lisp | 28 ++++++++++++++++++++++++++++
 src/compiler/arm/vm.lisp    |  8 ++++++++
 2 files changed, 36 insertions(+)

diff --git a/src/compiler/arm/arith.lisp b/src/compiler/arm/arith.lisp
index 707059328..f791c5181 100644
--- a/src/compiler/arm/arith.lisp
+++ b/src/compiler/arm/arith.lisp
@@ -529,6 +529,34 @@
 (define-source-transform lognand (x y)
   `(lognot (logand ,x ,y)))
 
+(defknown %logbitp (integer unsigned-byte) boolean
+  (movable foldable flushable always-translatable))
+
+;;; For constant folding
+(defun %logbitp (integer index)
+  (logbitp index integer))
+
+(define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum)
+  (:translate %logbitp)
+  (:conditional :ne)
+  (:arg-types tagged-num (:constant (integer 0 29)))
+  (:generator 4
+    (inst tst x (ash 1 (+ y n-fixnum-tag-bits)))))
+
+(define-vop (fast-logbitp-c/signed fast-conditional-c/signed)
+  (:translate %logbitp)
+  (:conditional :ne)
+  (:arg-types signed-num (:constant (integer 0 31)))
+  (:generator 5
+    (inst tst x (ash 1 y))))
+
+(define-vop (fast-logbitp-c/unsigned fast-conditional-c/unsigned)
+  (:translate %logbitp)
+  (:conditional :ne)
+  (:arg-types unsigned-num (:constant (integer 0 31)))
+  (:generator 5
+    (inst tst x (ash 1 y))))
+
 ;;;; Bignum stuff.
 
 (define-vop (bignum-length get-header-data)
diff --git a/src/compiler/arm/vm.lisp b/src/compiler/arm/vm.lisp
index 9f9690d28..a14200957 100644
--- a/src/compiler/arm/vm.lisp
+++ b/src/compiler/arm/vm.lisp
@@ -315,6 +315,14 @@
          ((valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*)
           (values :direct nil))
          (t (values :default nil))))
+      (logbitp
+       (cond
+         ((or (valid-funtype '((constant-arg (integer 0 29)) fixnum) '*)
+              (valid-funtype '((constant-arg (integer 0 31)) (signed-byte 32)) '*)
+              (valid-funtype '((constant-arg (integer 0 31)) (unsigned-byte 32)) '*))
+          (values :transform '(lambda (index integer)
+                               (%logbitp integer index))))
+         (t (values :default nil))))
       (t (values :default nil)))))
 
 (defun primitive-type-indirect-cell-type (ptype)
-- 
2.11.4.GIT