0.9.8.28:

        Oh, the embarrassment. x86-64 was using full calls to GENERIC-< and
        GENERIC-> for (UN)SIGNED-BYTE-64-P and CHECK-(UN)SIGNED-BYTE-64.
        Fix it.

        * Conditionalize type predicate, type predicate wrapper and
          typecheckfun creation on N-WORD-BITS. Add missing 64-bit
          cases.
        * Add missing SIGNED-BYTE-64 VOPs.
        * Nuke the now-unused 32-bit VOPs.

diff --git a/NEWS b/NEWS
index 9b03a93..289d8c3 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,7 @@ changes in sbcl-0.9.9 relative to sbcl-0.9.8:
   * optimization: faster implementation of EQUAL
   * optimization: emit more efficient opcodes for some common 
     immediate->register MOV instructions on x86-64.  (thanks to Lutz Euler)
+  * optimization: several other minor code-generation improvements on x86-64
   * fixed segfaults on x86 FreeBSD 7-current.  (thanks to NIIMI Satoshi)
 
 changes in sbcl-0.9.8 relative to sbcl-0.9.7:

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index f0bf985..93299dd 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -93,8 +93,14 @@
   (def-type-predicate-wrapper system-area-pointer-p)
   (def-type-predicate-wrapper weak-pointer-p)
   (def-type-predicate-wrapper vectorp)
+  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   (def-type-predicate-wrapper unsigned-byte-32-p)
+  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   (def-type-predicate-wrapper signed-byte-32-p)
+  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+  (def-type-predicate-wrapper unsigned-byte-64-p)
+  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+  (def-type-predicate-wrapper signed-byte-64-p)
   (def-type-predicate-wrapper simple-array-nil-p)
   (def-type-predicate-wrapper simple-array-unsigned-byte-2-p)
   (def-type-predicate-wrapper simple-array-unsigned-byte-4-p)

diff --git a/src/code/typecheckfuns.lisp b/src/code/typecheckfuns.lisp
index b602f64..8fe8217 100644 (file)
--- a/src/code/typecheckfuns.lisp
+++ b/src/code/typecheckfuns.lisp
@@ -46,7 +46,15 @@
            ;; lemme know. -- WHN 2001-10-15
            #(t
              character
-             bit fixnum (unsigned-byte 32) (signed-byte 32)
+             bit fixnum
+             #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+             (unsigned-byte 32)
+             #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+             (unsigned-byte 64)
+             #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+             (signed-byte 32)
+             #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+             (signed-byte 64)
              single-float double-float)))
       (coerce (remove-duplicates
                (mapcar (lambda (typespec)
@@ -77,7 +85,10 @@
                           symbol
                           unsigned-byte
                           (unsigned-byte 8)
-                          (unsigned-byte 32))
+                          #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+                          (unsigned-byte 32)
+                          #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                          (unsigned-byte 64))
                         ;; systematic names for array types
                         (map 'list
                              (lambda (element-type)

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index f8494cf..c214fe8 100644 (file)
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -191,10 +191,18 @@
     (numeric-type
      (cond ((type= type (specifier-type 'fixnum))
             'sb!c:check-fixnum)
+           #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
            ((type= type (specifier-type '(signed-byte 32)))
             'sb!c:check-signed-byte-32)
+           #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
            ((type= type (specifier-type '(unsigned-byte 32)))
             'sb!c:check-unsigned-byte-32)
+           #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+           ((type= type (specifier-type '(signed-byte 64)))
+            'sb!c:check-signed-byte-64)
+           #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+           ((type= type (specifier-type '(unsigned-byte 64)))
+            'sb!c:check-unsigned-byte-64)
            (t nil)))
     (fun-type
      'sb!c:check-fun)

diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp
index 8446c0e..05a08eb 100644 (file)
--- a/src/compiler/generic/vm-typetran.lisp
+++ b/src/compiler/generic/vm-typetran.lisp
@@ -96,8 +96,14 @@
 #!+sb-unicode (define-type-predicate simple-character-string-p
                   (simple-array character (*)))
 (define-type-predicate system-area-pointer-p system-area-pointer)
+#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
 (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
+#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
 (define-type-predicate signed-byte-32-p (signed-byte 32))
+#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+(define-type-predicate unsigned-byte-64-p (unsigned-byte 64))
+#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+(define-type-predicate signed-byte-64-p (signed-byte 64))
 (define-type-predicate vector-t-p (vector t))
 (define-type-predicate vector-nil-p (vector nil))
 (define-type-predicate weak-pointer-p weak-pointer)

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 09efe21..f3b540f 100644 (file)
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -193,62 +193,43 @@
     (inst shr tmp 61)
     (inst jmp (if not-p :nz :z) target)))
 
-(define-vop (signed-byte-32-p type-predicate)
-  (:translate signed-byte-32-p)
-  (:generator 7
-    ;; (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 sar rax-tn (+ 32 3 -1))
-    (if not-p
-        (progn
-          (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))
+;;; A (SIGNED-BYTE 64) can be represented with either fixnum or a bignum with
+;;; exactly one digit.
 
-(define-vop (check-signed-byte-32 check-type)
-  (:generator 8
-    (let ((nope (generate-error-code vop
-                                     object-not-signed-byte-32-error
-                                     value))
-          (ok (gen-label)))
+(define-vop (signed-byte-64-p type-predicate)
+  (:translate signed-byte-64-p)
+  (:generator 45
+    (multiple-value-bind (yep nope)
+        (if not-p
+            (values not-target target)
+            (values target not-target))
+      (generate-fixnum-test value)
+      (inst jmp :e yep)
       (move rax-tn value)
-      (inst test rax-tn 7)
+      (inst and al-tn lowtag-mask)
+      (inst cmp al-tn other-pointer-lowtag)
       (inst jmp :ne nope)
-      (inst sar rax-tn (+ 32 3 -1))
-      (inst jmp :z ok)
-      (inst cmp rax-tn -1)
-      (inst jmp :ne nope)
-      (emit-label ok)
-      (move result value))))
-
-
-(define-vop (unsigned-byte-32-p type-predicate)
-  (:translate unsigned-byte-32-p)
-  (:generator 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 shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
-    (inst jmp (if not-p :nz :z) target)
+      (loadw rax-tn value 0 other-pointer-lowtag)
+      (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+      (inst jmp (if not-p :ne :e) target))
     NOT-TARGET))
 
-(define-vop (check-unsigned-byte-32 check-type)
-  (:generator 8
-    (let ((nope
-           (generate-error-code vop object-not-unsigned-byte-32-error value)))
+(define-vop (check-signed-byte-64 check-type)
+  (:generator 45
+    (let ((nope (generate-error-code vop
+                                     object-not-signed-byte-64-error
+                                     value)))
+      (generate-fixnum-test value)
+      (inst jmp :e yep)
       (move rax-tn value)
-      (inst test rax-tn 7)
+      (inst and al-tn lowtag-mask)
+      (inst cmp al-tn other-pointer-lowtag)
       (inst jmp :ne nope)
-      (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
-      (inst jmp :nz nope)
-      (move result value))))
+      (loadw rax-tn value 0 other-pointer-lowtag)
+      (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+      (inst jmp :ne nope))
+    YEP
+    (move result value)))
 
 ;;; An (unsigned-byte 64) can be represented with either a positive
 ;;; fixnum, a bignum with exactly one positive digit, or a bignum with

diff --git a/version.lisp-expr b/version.lisp-expr
index f860a66..1de21b7 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.8.27"
+"0.9.8.28"