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

diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp
index a8efea6..4ad6d5d 100644
--- a/src/compiler/x86/type-vops.lisp
+++ b/src/compiler/x86/type-vops.lisp
@@ -257,8 +257,8 @@
                                 :disp (- other-pointer-lowtag)))
       (inst test al-tn lowtag-mask)
       (inst jmp :ne nope)
-      (loadw eax-tn value 0 other-pointer-lowtag)
-      (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+      (inst cmp (make-ea-for-object-slot value 0 other-pointer-lowtag)
+            (+ (ash 1 n-widetag-bits) bignum-widetag))
       (inst jmp (if not-p :ne :e) target))
     NOT-TARGET))
 
@@ -273,8 +273,8 @@
                                 :disp (- other-pointer-lowtag)))
       (inst test al-tn lowtag-mask)
       (inst jmp :ne nope)
-      (loadw eax-tn value 0 other-pointer-lowtag)
-      (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+      (inst cmp (make-ea-for-object-slot value 0 other-pointer-lowtag)
+            (+ (ash 1 n-widetag-bits) bignum-widetag))
       (inst jmp :ne nope))
     YEP
     (move result value)))
@@ -312,7 +312,7 @@
         ;; Get the second digit.
         (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
         ;; All zeros, its an (unsigned-byte 32).
-        (inst or eax-tn eax-tn)
+        (inst test eax-tn eax-tn)
         (inst jmp :z yep)
         (inst jmp nope)
 
@@ -322,7 +322,7 @@
 
         ;; positive implies (unsigned-byte 32).
         (emit-label fixnum)
-        (inst or eax-tn eax-tn)
+        (inst test eax-tn eax-tn)
         (inst jmp (if not-p :s :ns) target)
 
         (emit-label not-target)))))
@@ -355,7 +355,7 @@
       ;; Get the second digit.
       (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
       ;; All zeros, its an (unsigned-byte 32).
-      (inst or eax-tn eax-tn)
+      (inst test eax-tn eax-tn)
       (inst jmp :z yep)
       (inst jmp nope)
 
@@ -365,11 +365,40 @@
 
       ;; positive implies (unsigned-byte 32).
       (emit-label fixnum)
-      (inst or eax-tn eax-tn)
+      (inst test eax-tn eax-tn)
       (inst jmp :s nope)
 
       (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))))
+
 
 ;;;; list/symbol types
 ;;;