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

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 46d6bc2..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)
@@ -176,9 +203,10 @@
     (inst sar rax-tn (+ 32 3 -1))
     (if not-p
 	(progn
-	  (inst jmp :nz target)
+	  (inst jmp :nz maybe)
 	  (inst jmp not-target))
 	(inst jmp :z target))
+    MAYBE
     (inst cmp rax-tn -1)
     (inst jmp (if not-p :ne :eq) target)
     NOT-TARGET))