0.9.2.7:

[sbcl.git] / src / compiler / x86-64 / type-vops.lisp

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 6dbaaab..9d96702 100644 (file)
--- 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)
@@ -172,12 +199,12 @@
     ;; (and (fixnum) (or (no bits set >31) (all bits set >31))
     (move rax-tn value)
     (inst test rax-tn 7)
-    (inst jmp :ne (if not-p target not-target))
+    (inst jmp :ne (if not-p target NOT-TARGET))
     (inst sar rax-tn (+ 32 3 -1))
     (if not-p
        (progn
-         (inst jmp :nz maybe)
-         (inst jmp not-target))
+         (inst jmp :nz MAYBE)
+         (inst jmp NOT-TARGET))
        (inst jmp :z target))
     MAYBE
     (inst cmp rax-tn -1)
@@ -197,7 +224,7 @@
       (inst jmp :z ok)
       (inst cmp rax-tn -1)
       (inst jmp :ne nope)
-      (emit-label OK)
+      (emit-label ok)
       (move result value))))
 
 
@@ -207,7 +234,7 @@
     ;; (and (fixnum) (no bits set >31))
     (move rax-tn value)
     (inst test rax-tn 7)
-    (inst jmp :ne (if not-p target not-target))
+    (inst jmp :ne (if not-p target NOT-TARGET))
     (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
     (inst jmp (if not-p :nz :z) target)
     NOT-TARGET))
@@ -238,35 +265,35 @@
              (values target not-target))
        ;; Is it a fixnum?
        (generate-fixnum-test value)
-       (move eax-tn value)
+       (move rax-tn value)
        (inst jmp :e fixnum)
 
        ;; If not, is it an other pointer?
-       (inst and eax-tn lowtag-mask)
-       (inst cmp eax-tn other-pointer-lowtag)
+       (inst and rax-tn lowtag-mask)
+       (inst cmp rax-tn other-pointer-lowtag)
        (inst jmp :ne nope)
        ;; Get the header.
-       (loadw eax-tn value 0 other-pointer-lowtag)
+       (loadw rax-tn value 0 other-pointer-lowtag)
        ;; Is it one?
-       (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+       (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
        (inst jmp :e single-word)
        ;; If it's other than two, we can't be an (unsigned-byte 64)
-       (inst cmp eax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
+       (inst cmp rax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
        (inst jmp :ne nope)
        ;; Get the second digit.
-       (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
+       (loadw rax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
        ;; All zeros, its an (unsigned-byte 64).
-       (inst or eax-tn eax-tn)
+       (inst or rax-tn rax-tn)
        (inst jmp :z yep)
        (inst jmp nope)
        
        (emit-label single-word)
        ;; Get the single digit.
-       (loadw eax-tn value bignum-digits-offset other-pointer-lowtag)
+       (loadw rax-tn value bignum-digits-offset other-pointer-lowtag)
 
        ;; positive implies (unsigned-byte 64).
        (emit-label fixnum)
-       (inst or eax-tn eax-tn)
+       (inst or rax-tn rax-tn)
        (inst jmp (if not-p :s :ns) target)
 
        (emit-label not-target)))))
@@ -281,35 +308,35 @@
 
       ;; Is it a fixnum?
       (generate-fixnum-test value)
-      (move eax-tn value)
+      (move rax-tn value)
       (inst jmp :e fixnum)
 
       ;; If not, is it an other pointer?
-      (inst and eax-tn lowtag-mask)
-      (inst cmp eax-tn other-pointer-lowtag)
+      (inst and rax-tn lowtag-mask)
+      (inst cmp rax-tn other-pointer-lowtag)
       (inst jmp :ne nope)
       ;; Get the header.
-      (loadw eax-tn value 0 other-pointer-lowtag)
+      (loadw rax-tn value 0 other-pointer-lowtag)
       ;; Is it one?
-      (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+      (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
       (inst jmp :e single-word)
       ;; If it's other than two, we can't be an (unsigned-byte 64)
-      (inst cmp eax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
+      (inst cmp rax-tn (+ (ash 2 n-widetag-bits) bignum-widetag))
       (inst jmp :ne nope)
       ;; Get the second digit.
-      (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
+      (loadw rax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
       ;; All zeros, its an (unsigned-byte 64).
-      (inst or eax-tn eax-tn)
+      (inst or rax-tn rax-tn)
       (inst jmp :z yep)
       (inst jmp nope)
        
       (emit-label single-word)
       ;; Get the single digit.
-      (loadw eax-tn value bignum-digits-offset other-pointer-lowtag)
+      (loadw rax-tn value bignum-digits-offset other-pointer-lowtag)
 
       ;; positive implies (unsigned-byte 64).
       (emit-label fixnum)
-      (inst or eax-tn eax-tn)
+      (inst or rax-tn rax-tn)
       (inst jmp :s nope)
 
       (emit-label yep)
@@ -323,7 +350,7 @@
 (define-vop (symbolp type-predicate)
   (:translate symbolp)
   (:generator 12
-    (let ((is-symbol-label (if not-p drop-thru target)))
+    (let ((is-symbol-label (if not-p DROP-THRU target)))
       (inst cmp value nil-value)
       (inst jmp :e is-symbol-label)
       (test-type value target not-p (symbol-header-widetag)))
@@ -333,7 +360,7 @@
   (:generator 12
     (let ((error (generate-error-code vop object-not-symbol-error value)))
       (inst cmp value nil-value)
-      (inst jmp :e drop-thru)
+      (inst jmp :e DROP-THRU)
       (test-type value error t (symbol-header-widetag)))
     DROP-THRU
     (move result value)))
@@ -341,7 +368,7 @@
 (define-vop (consp type-predicate)
   (:translate consp)
   (:generator 8
-    (let ((is-not-cons-label (if not-p target drop-thru)))
+    (let ((is-not-cons-label (if not-p target DROP-THRU)))
       (inst cmp value nil-value)
       (inst jmp :e is-not-cons-label)
       (test-type value target not-p (list-pointer-lowtag)))