don't consider an interpreted->compiled function change interesting
[sbcl.git] / src / compiler / x86 / type-vops.lisp
index 38d6adc..fd4b9d0 100644 (file)
@@ -14,7 +14,7 @@
 ;;;; test generation utilities
 
 (defun generate-fixnum-test (value)
-  (emit-optimized-test-inst value 3))
+  (emit-optimized-test-inst value fixnum-tag-mask))
 
 (defun %test-fixnum (value target not-p)
   (generate-fixnum-test value)
               (values not-target target)
               (values target not-target))
         ;; Is it a fixnum?
-        (generate-fixnum-test value)
         (move eax-tn value)
+        (inst test al-tn fixnum-tag-mask)
         (inst jmp :e fixnum)
 
         ;; If not, is it an other pointer?
 
       (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 sb!c::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 (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 sb!c::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 fixnum-hi))))
+
+(define-vop (test-fixnum-mod-*)
+  (:args (value :scs (any-reg descriptor-reg)))
+  (:arg-types * (:constant fixnum))
+  (:translate sb!c::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 fixnum-hi)
+       (inst jmp (if not-p :a :be) target)
+       (emit-label skip))))
+
 \f
 ;;;; list/symbol types
 ;;;