0.9.0.16:

	* "A fix for a FIXME in generic subtraction on x86-64/x86",
          Lutz Euler, sbcl-devel/2005-05-01
        * MAKE-VALID-LISP-OBJ now also works on immediate single floats.
        * The x86-65 UNSIGNED-BYTE-64-P and CHECK-UNSIGNED-BYTE-64 VOPs can
          actually be compiled.

diff --git a/NEWS b/NEWS
index d29f717..380cac8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2,10 +2,14 @@ changes in sbcl-0.9.1 relative to sbcl-0.9.0:
   * fixed cross-compiler leakages that prevented building a 32-bit
     target with a 64-bit host compiler.
   * contrib improvement: implement SB-POSIX:MKSTEMP (Yannick Gingras)
+  * optimization: There's now a fast-path for fixnum arguments in the
+    generic subtraction routines on x86/x86-64. (Thanks to Lutz Euler)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** the type-error signalled from WARN has a filled-in DATUM slot.
     ** the type-error required when a stream is not associated with
        a file has the stream as its datum.
+    ** type-errors on single-floats on x86-64 no longer have 
+       :INVALID-OBJECT as the datum
 
 changes in sbcl-0.9.0 relative to sbcl-0.8.21:
   * incompatible change: the --noprogrammer option, deprecated since

diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp
index c84c661..a6f4d5e 100644 (file)
--- a/src/assembly/x86-64/arith.lisp
+++ b/src/assembly/x86-64/arith.lisp
@@ -71,15 +71,10 @@
     OKAY)
 
   (define-generic-arith-routine (- 10)
-    ;; FIXME: This is screwed up.
-      ;;; I can't figure out the flags on subtract. Overflow never gets
-      ;;; set and carry always does. (- 0 most-negative-fixnum) can't be
-      ;;; easily detected so just let the upper level stuff do it.
-    (inst jmp DO-STATIC-FUN)
-
     (move res x)
     (inst sub res y)
     (inst jmp :no OKAY)
+    (inst cmc)                        ; carry has correct sign now
     (inst rcr res 1)
     (inst sar res 2)                 ; remove type bits
 

diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp
index 392f67c..dbc752c 100644 (file)
--- a/src/assembly/x86/arith.lisp
+++ b/src/assembly/x86/arith.lisp
@@ -71,15 +71,10 @@
     OKAY)
 
   (define-generic-arith-routine (- 10)
-    ;; FIXME: This is screwed up.
-      ;;; I can't figure out the flags on subtract. Overflow never gets
-      ;;; set and carry always does. (- 0 most-negative-fixnum) can't be
-      ;;; easily detected so just let the upper level stuff do it.
-    (inst jmp DO-STATIC-FUN)
-
     (move res x)
     (inst sub res y)
     (inst jmp :no OKAY)
+    (inst cmc)                        ; carry has correct sign now
     (inst rcr res 1)
     (inst sar res 1)                 ; remove type bits
 

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 2d960c7..f1cd357 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -1993,6 +1993,9 @@ register."
   (if (or
        ;; fixnum
        (zerop (logand val sb!vm:fixnum-tag-mask))
+       ;; immediate single float, 64-bit only
+       #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+       (= (logand val #xff) sb!vm:single-float-widetag)
        ;; character
        (and (zerop (logandc2 val #x1fffffff)) ; Top bits zero
            (= (logand val #xff) sb!vm:character-widetag)) ; char tag

diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 2ba4b7e..9d96702 100644 (file)
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -265,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)))))
@@ -308,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)

diff --git a/version.lisp-expr b/version.lisp-expr
index 390300f..986d4f2 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.0.15"
+"0.9.0.16"