X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ftype-vops.lisp;h=0727ca69052e43f5c706c6aa4f0225565d1bcf75;hb=aa7b669779e8e88349938ca962229f31ead08af2;hp=04fa7457d14852b69569950a082d33d5b749a0af;hpb=3031b264496451e796282d7309c2221d89ee62c1;p=sbcl.git

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 04fa745..0727ca6 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -80,10 +80,9 @@
   (%test-headers value target not-p nil headers drop-through))
 
 (defun %test-lowtag (value target not-p lowtag)
-  (move-qword-to-eax value)
-  (inst and al-tn lowtag-mask)
-  (inst cmp al-tn lowtag)
-  (inst jmp (if not-p :ne :e) target))
+  (inst lea eax-tn (make-ea :dword :base value :disp (- lowtag)))
+  (inst test al-tn lowtag-mask)
+  (inst jmp (if not-p :nz :z) target))
 
 (defun %test-headers (value target not-p function-p headers
                             &optional (drop-through (gen-label)))
@@ -265,9 +264,10 @@
         (if not-p
             (values not-target target)
             (values target not-target))
-      (generate-fixnum-test value)
-      (inst jmp :e yep)
       (move-qword-to-eax value)
+      (inst test al-tn fixnum-tag-mask)
+      (inst jmp :e yep)
+
       (inst and al-tn lowtag-mask)
       (inst cmp al-tn other-pointer-lowtag)
       (inst jmp :ne nope)
@@ -307,8 +307,8 @@
               (values not-target target)
               (values target not-target))
         ;; Is it a fixnum?
-        (generate-fixnum-test value)
         (move rax-tn value)
+        (inst test al-tn fixnum-tag-mask)
         (inst jmp :e fixnum)
 
         ;; If not, is it an other pointer?
@@ -384,6 +384,63 @@
 
       (emit-label yep)
       (move result value))))
+
+(defun power-of-two-limit-p (x)
+  (and (fixnump x)
+       (= (logcount (1+ x)) 1)))
+
+(define-vop (test-fixnum-mod-power-of-two)
+  (:args (value :scs (any-reg descriptor-reg
+                              unsigned-reg signed-reg
+                              immediate)))
+  (:arg-types *
+              (:constant (satisfies power-of-two-limit-p)))
+  (:translate fixnum-mod-p)
+  (:conditional :e)
+  (:info hi)
+  (:save-p :compute-only)
+  (:policy :fast-safe)
+  (:generator 4
+     (aver (not (sc-is value immediate)))
+     (let* ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
+                           hi
+                           (fixnumize hi))))
+       (inst test value (constantize (lognot fixnum-hi))))))
+
+(define-vop (test-fixnum-mod-tagged-unsigned)
+  (:args (value :scs (any-reg descriptor-reg
+                              unsigned-reg signed-reg
+                              immediate)))
+  (:arg-types (:or tagged-num unsigned-num signed-num)
+              (:constant fixnum))
+  (:translate fixnum-mod-p)
+  (:conditional :be)
+  (:info hi)
+  (:save-p :compute-only)
+  (:policy :fast-safe)
+  (:generator 5
+     (aver (not (sc-is value immediate)))
+     (let ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
+                          hi
+                          (fixnumize hi))))
+       (inst cmp value (constantize fixnum-hi)))))
+
+(define-vop (test-fixnum-mod-*)
+  (:args (value :scs (any-reg descriptor-reg)))
+  (:arg-types * (:constant fixnum))
+  (:translate fixnum-mod-p)
+  (:conditional)
+  (:info target not-p hi)
+  (:save-p :compute-only)
+  (:policy :fast-safe)
+  (:generator 6
+     (let* ((fixnum-hi (fixnumize hi))
+            (skip (gen-label)))
+       (generate-fixnum-test value)
+       (inst jmp :ne (if not-p target skip))
+       (inst cmp value (constantize fixnum-hi))
+       (inst jmp (if not-p :a :be) target)
+       (emit-label skip))))
 
 ;;;; list/symbol types
 ;;;
@@ -429,7 +486,6 @@
 (progn
   (!define-type-vops simd-pack-p nil nil nil (simd-pack-widetag))
 
-  #!+x86-64
   (define-vop (check-simd-pack check-type)
     (:args (value :target result
                   :scs (any-reg descriptor-reg