0.9.12.28:

	Micro-optimize type testing on x86 by doing a direct comparison
	  with memory in the common case, which is slightly smaller.

diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp
index 949af27..6c9e10b 100644 (file)
--- a/src/compiler/x86/type-vops.lisp
+++ b/src/compiler/x86/type-vops.lisp
@@ -85,65 +85,77 @@
             (values :ne :a :b drop-through target)
             (values :e :na :nb target drop-through))
       (%test-lowtag value when-false t lowtag al-loaded)
-      (inst mov al-tn (make-ea :byte :base value :disp (- lowtag)))
-      (do ((remaining headers (cdr remaining)))
-          ((null remaining))
-        (let ((header (car remaining))
-              (last (null (cdr remaining))))
-          (cond
-           ((atom header)
-            (cond
-              ((and (not last) (null (cddr remaining))
-                    (atom (cadr remaining))
-                    (= (logcount (logxor header (cadr remaining))) 1))
-               ;; BASE-STRING, (VECTOR NIL), BIT-VECTOR, (VECTOR T)
-               (inst and al-tn (ldb (byte 8 0) (logeqv header (cadr remaining))))
-               (inst cmp al-tn (ldb (byte 8 0) (logand header (cadr remaining))))
-               (inst jmp equal target)
-               (return))
-              (t
-               (inst cmp al-tn header)
-               (if last
+      (cond
+        ((and (null (cdr headers))
+              (numberp (car headers)))
+         ;; Optimize the common case: referencing the value from memory
+         ;; is slightly smaller than loading it and then doing the
+         ;; comparison.  Doing this for other cases (e.g. range of
+         ;; [BIGNUM-WIDETAG..FOO-WIDETAG]) is also possible, but such
+         ;; opportunities don't come up very often and the code would
+         ;; get pretty hairy...
+         (inst cmp (make-ea :byte :base value :disp (- lowtag)) (car headers))
+         (inst jmp equal target))
+        (t
+         (inst mov al-tn (make-ea :byte :base value :disp (- lowtag)))
+         (do ((remaining headers (cdr remaining)))
+             ((null remaining))
+           (let ((header (car remaining))
+                 (last (null (cdr remaining))))
+             (cond
+               ((atom header)
+                (cond
+                  ((and (not last) (null (cddr remaining))
+                        (atom (cadr remaining))
+                        (= (logcount (logxor header (cadr remaining))) 1))
+                   ;; BASE-STRING, (VECTOR NIL), BIT-VECTOR, (VECTOR T)
+                   (inst and al-tn (ldb (byte 8 0) (logeqv header (cadr remaining))))
+                   (inst cmp al-tn (ldb (byte 8 0) (logand header (cadr remaining))))
                    (inst jmp equal target)
-                   (inst jmp :e when-true)))))
-           (t
-             (let ((start (car header))
-                   (end (cdr header)))
-               (cond
-                 ;; LAST = don't need al-tn later
-                 ((and last (not (= start bignum-widetag))
-                       (= (+ start 4) end) (= (logcount (logxor start end)) 1))
-                  ;; SIMPLE-STRING
-                  (inst and al-tn (ldb (byte 8 0) (logeqv start end)))
-                  (inst cmp al-tn (ldb (byte 8 0) (logand start end)))
-                  (inst jmp equal target))
-                 ((and (not last) (null (cddr remaining))
-                       (= (+ start 4) end) (= (logcount (logxor start end)) 1)
-                       (listp (cadr remaining))
-                       (= (+ (caadr remaining) 4) (cdadr remaining))
-                       (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1)
-                       (= (logcount (logxor (caadr remaining) start)) 1))
-                  ;; STRING
-                  (inst and al-tn (ldb (byte 8 0) (logeqv start (cdadr remaining))))
-                  (inst cmp al-tn (ldb (byte 8 0) (logand start (cdadr remaining))))
-                  (inst jmp equal target)
-                  ;; we've shortcircuited the DO, so we must return.
-                  ;; It's OK to do so, because (NULL (CDDR REMAINING))
-                  ;; was true.
-                  (return))
-                 (t
-                  (unless (= start bignum-widetag)
-                    (inst cmp al-tn start)
-                    (if (= end complex-array-widetag)
-                        (progn
-                          (aver last)
-                          (inst jmp greater-or-equal target))
-                        (inst jmp :b when-false))) ; was :l
-                  (unless (= end complex-array-widetag)
-                    (inst cmp al-tn end)
-                    (if last
-                        (inst jmp less-or-equal target)
-                        (inst jmp :be when-true)))))))))) ; was :le
+                   (return))
+                  (t
+                   (inst cmp al-tn header)
+                   (if last
+                       (inst jmp equal target)
+                       (inst jmp :e when-true)))))
+               (t
+                (let ((start (car header))
+                      (end (cdr header)))
+                  (cond
+                    ;; LAST = don't need al-tn later
+                    ((and last (not (= start bignum-widetag))
+                          (= (+ start 4) end) (= (logcount (logxor start end)) 1))
+                     ;; SIMPLE-STRING
+                     (inst and al-tn (ldb (byte 8 0) (logeqv start end)))
+                     (inst cmp al-tn (ldb (byte 8 0) (logand start end)))
+                     (inst jmp equal target))
+                    ((and (not last) (null (cddr remaining))
+                          (= (+ start 4) end) (= (logcount (logxor start end)) 1)
+                          (listp (cadr remaining))
+                          (= (+ (caadr remaining) 4) (cdadr remaining))
+                          (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1)
+                          (= (logcount (logxor (caadr remaining) start)) 1))
+                     ;; STRING
+                     (inst and al-tn (ldb (byte 8 0) (logeqv start (cdadr remaining))))
+                     (inst cmp al-tn (ldb (byte 8 0) (logand start (cdadr remaining))))
+                     (inst jmp equal target)
+                     ;; we've shortcircuited the DO, so we must return.
+                     ;; It's OK to do so, because (NULL (CDDR REMAINING))
+                     ;; was true.
+                     (return))
+                    (t
+                     (unless (= start bignum-widetag)
+                       (inst cmp al-tn start)
+                       (if (= end complex-array-widetag)
+                           (progn
+                             (aver last)
+                             (inst jmp greater-or-equal target))
+                           (inst jmp :b when-false))) ; was :l
+                     (unless (= end complex-array-widetag)
+                       (inst cmp al-tn end)
+                       (if last
+                           (inst jmp less-or-equal target)
+                           (inst jmp :be when-true)))))))))))) ; was :le
       (emit-label drop-through))))
 \f
 ;;;; type checking and testing

diff --git a/version.lisp-expr b/version.lisp-expr
index f875bba..f20a958 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.12.27"
+"0.9.12.28"