From: Juho Snellman Date: Mon, 2 May 2005 17:11:11 +0000 (+0000) Subject: 0.9.0.16: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3da8e4ca35e534942f7a5046490d169509170c85;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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"