X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ftype-vops.lisp;h=e77d167109b50745c47a16a11a98c80406cc85ce;hb=5ecef987f3847ed5de8c03f66ef9d8ab468af993;hp=6dbaaab23066befed58bfb2bfb1d51b3608f6823;hpb=460003761254b8f06a88868301f597a5cb0cca94;p=sbcl.git

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 6dbaaab..e77d167 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -42,14 +42,41 @@
     (inst jmp :z (if not-p drop-through target))
     (%test-headers value target not-p nil headers drop-through)))
 
-(defun %test-immediate (value target not-p immediate)
+(defun %test-fixnum-and-immediate (value target not-p immediate)
+  (let ((drop-through (gen-label)))
+    (generate-fixnum-test value)
+    (inst jmp :z (if not-p drop-through target))
+    (%test-immediate value target not-p immediate drop-through)))
+
+(defun %test-fixnum-immediate-and-headers (value target not-p immediate
+					   headers)
+  (let ((drop-through (gen-label)))
+    (generate-fixnum-test value)
+    (inst jmp :z (if not-p drop-through target))
+    (%test-immediate-and-headers value target not-p immediate headers
+				 drop-through)))
+
+(defun %test-immediate (value target not-p immediate
+			&optional (drop-through (gen-label)))
   ;; Code a single instruction byte test if possible.
   (cond ((sc-is value any-reg descriptor-reg)
 	 (inst cmp (make-byte-tn value) immediate))
 	(t
 	 (move rax-tn value)
 	 (inst cmp al-tn immediate)))
-  (inst jmp (if not-p :ne :e) target))
+  (inst jmp (if not-p :ne :e) target)  
+  (emit-label drop-through))  
+
+(defun %test-immediate-and-headers (value target not-p immediate headers
+				    &optional (drop-through (gen-label)))
+  ;; Code a single instruction byte test if possible.
+  (cond ((sc-is value any-reg descriptor-reg)
+	 (inst cmp (make-byte-tn value) immediate))
+	(t
+	 (move rax-tn value)
+	 (inst cmp al-tn immediate)))
+  (inst jmp :e (if not-p drop-through target))
+  (%test-headers value target not-p nil headers drop-through))
 
 (defun %test-lowtag (value target not-p lowtag)
   (move rax-tn value)