X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Ftype-vops.lisp;h=fd4b9d0a83489a75e1bec65076937d682efd894f;hb=b2ed34b667665e52609cf431c00179b136be450d;hp=4ad6d5d8d30f0a80f880cac04302603375f454b8;hpb=cd5a858174d892f876699373dc3ea389cf2c4d40;p=sbcl.git

diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp
index 4ad6d5d..fd4b9d0 100644
--- a/src/compiler/x86/type-vops.lisp
+++ b/src/compiler/x86/type-vops.lisp
@@ -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)
@@ -293,8 +293,8 @@
               (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?
@@ -371,33 +371,62 @@
       (emit-label yep)
       (move result value))))
 
-(define-vop (check-mod-fixnum check-type)
-  (:info type)
-  (:temporary (:sc any-reg) temp)
-  (:generator 30
-     (let* ((low (numeric-type-low type))
-            (hi (fixnumize (numeric-type-high type)))
-            (error (gen-label)))
-       ;; FIXME: abstract
-       (assemble (*elsewhere*)
-         (emit-label error)
-         (inst mov temp hi)
-         (emit-error-break vop error-trap
-                           (error-number-or-lose 'object-not-mod-error)
-                           (list value temp)))
-       (aver (zerop low))
-       (cond
-         ;; Handle powers of two specially
-         ;; The higher bits and the fixnum tag can be tested in one go
-         ((= (logcount (1+ hi)) 1)
-          (inst test value (lognot hi))
-          (inst jmp :ne error))
-         (t
-          (generate-fixnum-test value)
-          (inst jmp :ne error)
-          (inst cmp value hi)
-          (inst jmp :a error)))
-       (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))))
 
 
 ;;;; list/symbol types