Make CONTAINING-INTEGER-TYPE take N-WORD-BITS into account.

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

diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 9d48e29..1413f40 100644 (file)
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -1012,9 +1012,7 @@ constant shift greater than word length")))
   (:result-types unsigned-num)
   (:generator 28
     (move res arg)
-    (if (sc-is res unsigned-reg)
-        (inst test res res)
-        (inst cmp res 0))
+    (inst test res res)
     (inst jmp :ge POS)
     (inst not res)
     POS
@@ -1043,6 +1041,52 @@ constant shift greater than word length")))
     (zeroize res)
     DONE))
 
+;; INTEGER-LENGTH is implemented by using the BSR instruction, which
+;; returns the position of the first 1-bit from the right. And that needs
+;; to be incremented to get the width of the integer, and BSR doesn't
+;; work on 0, so it needs a branch to handle 0.
+
+;; But fixnums are tagged by being shifted left n-fixnum-tag-bits times,
+;; untagging by shifting right n-fixnum-tag-bits-1 times (and if
+;; n-fixnum-tag-bits = 1, no shifting is required), will make the
+;; resulting integer one bit wider, making the increment unnecessary.
+;; Then, to avoid calling BSR on 0, OR the result with 1. That sets the
+;; first bit to 1, and if all other bits are 0, BSR will return 0,
+;; which is the correct value for INTEGER-LENGTH.
+(define-vop (positive-fixnum-len)
+  (:translate integer-length)
+  (:note "inline positive fixnum integer-length")
+  (:policy :fast-safe)
+  (:args (arg :scs (any-reg)))
+  (:arg-types positive-fixnum)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 24
+    (move res arg)
+    (when (> n-fixnum-tag-bits 1)
+      (inst shr res (1- n-fixnum-tag-bits)))
+    (inst or res 1)
+    (inst bsr res res)))
+
+(define-vop (fixnum-len)
+  (:translate integer-length)
+  (:note "inline fixnum integer-length")
+  (:policy :fast-safe)
+  (:args (arg :scs (any-reg) :target res))
+  (:arg-types tagged-num)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 25
+    (move res arg)
+    (when (> n-fixnum-tag-bits 1)
+      (inst sar res (1- n-fixnum-tag-bits)))
+    (inst test res res)
+    (inst jmp :ge POS)
+    (inst not res)
+    POS
+    (inst or res 1)
+    (inst bsr res res)))
+\f
 (define-vop (unsigned-byte-64-count)
   (:translate logcount)
   (:note "inline (unsigned-byte 64) logcount")
@@ -1155,6 +1199,79 @@ constant shift greater than word length")))
   (:arg-types unsigned-num (:constant (unsigned-byte 64)))
   (:info y))
 
+;; Stolen liberally from the x86 32-bit implementation.
+(macrolet ((define-logtest-vops ()
+             `(progn
+               ,@(loop for suffix in '(/fixnum -c/fixnum
+                                       /signed -c/signed
+                                       /unsigned -c/unsigned)
+                       for cost in '(4 3 6 5 6 5)
+                       collect
+                       `(define-vop (,(symbolicate "FAST-LOGTEST" suffix)
+                                     ,(symbolicate "FAST-CONDITIONAL" suffix))
+                         (:translate logtest)
+                         (:conditional :ne)
+                         (:generator ,cost
+                          (emit-optimized-test-inst x
+                           ,(if (eq suffix '-c/fixnum)
+                                ;; See whether (fixnumize y) fits in signed 32
+                                ;; to avoid chip's sign-extension of imm32 val.
+                                `(if (typep y 'short-tagged-num)
+                                     (fixnumize y)
+                                     (register-inline-constant :qword (fixnumize y)))
+                                `(cond ((typep y '(signed-byte 32)) ; same
+                                        y)
+                                       ((typep y '(or (unsigned-byte 64) (signed-byte 64)))
+                                        (register-inline-constant :qword y))
+                                       (t
+                                        y))))))))))
+  (define-logtest-vops))
+
+(defknown %logbitp (integer unsigned-byte) boolean
+  (movable foldable flushable always-translatable))
+
+;;; only for constant folding within the compiler
+(defun %logbitp (integer index)
+  (logbitp index integer))
+
+;;; too much work to do the non-constant case (maybe?)
+(define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum)
+  (:translate %logbitp)
+  (:conditional :c)
+  (:arg-types tagged-num (:constant (integer 0 #.(- 63 n-fixnum-tag-bits))))
+  (:generator 4
+    (inst bt x (+ y n-fixnum-tag-bits))))
+
+(define-vop (fast-logbitp/signed fast-conditional/signed)
+  (:args (x :scs (signed-reg signed-stack))
+         (y :scs (signed-reg)))
+  (:translate %logbitp)
+  (:conditional :c)
+  (:generator 6
+    (inst bt x y)))
+
+(define-vop (fast-logbitp-c/signed fast-conditional-c/signed)
+  (:translate %logbitp)
+  (:conditional :c)
+  (:arg-types signed-num (:constant (integer 0 63)))
+  (:generator 5
+    (inst bt x y)))
+
+(define-vop (fast-logbitp/unsigned fast-conditional/unsigned)
+  (:args (x :scs (unsigned-reg unsigned-stack))
+         (y :scs (unsigned-reg)))
+  (:translate %logbitp)
+  (:conditional :c)
+  (:generator 6
+    (inst bt x y)))
+
+(define-vop (fast-logbitp-c/unsigned fast-conditional-c/unsigned)
+  (:translate %logbitp)
+  (:conditional :c)
+  (:arg-types unsigned-num (:constant (integer 0 63)))
+  (:generator 5
+    (inst bt x y)))
+
 (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned)
              `(progn
                 ,@(mapcar