From 5cc68148d1a5f9bacf4eb12e396b680d992fc2c2 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 17 Mar 2005 22:51:31 +0000 Subject: [PATCH] 0.8.20.27: Fix x86-64 backend bugs found using Paul Dietz's random tester. * Sign-extension in constant LOGAND, + and TRUNCATE VOPs. * Sign-extension of literal (unsigned-byte 32) passed as arguments on the stack. Fix handling of :START1 and :START2 in the string comparison deftransforms on simple-base-strings (ansi-tests MISC.572/573/574). Minor cleanup: Use the already defined *cache-expand-threshold* instead of magic numbers in pcl/cache.lisp. --- NEWS | 3 +++ src/compiler/seqtran.lisp | 12 +++++++----- src/compiler/x86-64/arith.lisp | 7 +++---- src/compiler/x86-64/macros.lisp | 3 +-- src/pcl/cache.lisp | 2 +- tests/arith.pure.lisp | 6 ++++++ tests/string.pure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 8 files changed, 33 insertions(+), 13 deletions(-) diff --git a/NEWS b/NEWS index f2d24a2..4dc064d 100644 --- a/NEWS +++ b/NEWS @@ -51,6 +51,9 @@ changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20: ** MISC.564: defined out-of-line version of %ATAN2 on x86. ** attempting to create a package with a colliding nickname causes correctable errors to be signalled. + ** MISC.572-574: :START1 and :START2 broken for simple-base-strings. + ** several x86-64 backend bugs related to sign-extension of immediate + operands. changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19: * fixed inspection of specialized arrays. (thanks to Simon Alexander) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 58585aa..b20f4db 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -624,14 +624,16 @@ ;;; must be SIMPLE-BASE-STRINGs. (macrolet ((def (name lessp equalp) `(deftransform ,name ((string1 string2 start1 end1 start2 end2) - (simple-base-string simple-base-string t t t t) *) + (simple-base-string simple-base-string t t t t) *) `(let* ((end1 (if (not end1) (length string1) end1)) (end2 (if (not end2) (length string2) end2)) (index (sb!impl::%sp-string-compare string1 start1 end1 string2 start2 end2))) (if index - (cond ((= index ,(if ',lessp 'end1 'end2)) index) - ((= index ,(if ',lessp 'end2 'end1)) nil) + (cond ((= index end1) + ,(if ',lessp 'index nil)) + ((= (+ index (- start2 start1)) end2) + ,(if ',lessp nil 'index)) ((,(if ',lessp 'char< 'char>) (schar string1 index) (schar string2 @@ -639,9 +641,9 @@ (+ index (truly-the fixnum (- start2 - start1)))))) + start1)))))) index) - (t nil)) + (t nil)) ,(if ',equalp 'end1 nil)))))) (def string<* t nil) (def string<=* t t) diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index c4fd46e..be2b9e6 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -128,7 +128,6 @@ (:result-types unsigned-num) (:note "inline (unsigned-byte 32) arithmetic")) -;; 32 not 64 because it's hard work loading 64 bit constants (define-vop (fast-signed-binop-c fast-safe-arith-op) (:args (x :target r :scs (signed-reg signed-stack))) (:info y) @@ -268,7 +267,7 @@ (define-vop (fast-logand-c/signed-unsigned=>unsigned fast-logand-c/unsigned=>unsigned) (:args (x :target r :scs (signed-reg signed-stack))) - (:arg-types signed-num (:constant (unsigned-byte 32)))) + (:arg-types signed-num (:constant (unsigned-byte 31)))) (define-vop (fast-logand/unsigned-signed=>unsigned fast-logand/unsigned=>unsigned) @@ -328,7 +327,7 @@ (:translate +) (:args (x :target r :scs (unsigned-reg unsigned-stack))) (:info y) - (:arg-types unsigned-num (:constant (unsigned-byte 32))) + (:arg-types unsigned-num (:constant (unsigned-byte 31))) (:results (r :scs (unsigned-reg) :load-if (not (location= x r)))) (:result-types unsigned-num) @@ -503,7 +502,7 @@ (:translate truncate) (:args (x :scs (unsigned-reg) :target eax)) (:info y) - (:arg-types unsigned-num (:constant (unsigned-byte 32))) + (:arg-types unsigned-num (:constant (unsigned-byte 31))) (:temporary (:sc unsigned-reg :offset eax-offset :target quo :from :argument :to (:result 0)) eax) (:temporary (:sc unsigned-reg :offset edx-offset :target rem diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 933b11c..62d00c9 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -57,8 +57,7 @@ (defmacro storew (value ptr &optional (slot 0) (lowtag 0)) (once-only ((value value)) `(cond ((and (integerp ,value) - (not (typep ,value - '(or (signed-byte 32) (unsigned-byte 32))))) + (not (typep ,value '(signed-byte 32)))) (multiple-value-bind (lo hi) (dwords-for-quad ,value) (inst mov (make-ea-for-object-slot-half ,ptr ,slot ,lowtag) lo) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index b3e44d3..7536f2a 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -941,7 +941,7 @@ (assert wrappers) (or (fill-cache-p nil cache wrappers value) - (and (< (ceiling (* (cache-count cache) 1.25)) + (and (< (ceiling (* (cache-count cache) *cache-expand-threshold*)) (if (= (cache-nkeys cache) 1) (1- (cache-nlines cache)) (cache-nlines cache))) diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index 25981fc..3cc17fa 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -258,3 +258,9 @@ (test 32 double-float positive) (test 32 single-float negative) (test 32 single-float positive)) + +;; x86-64 sign-extension bug found using pfdietz's random tester. +(assert (= 286142502 + (funcall (lambda () + (declare (notinline logxor)) + (min (logxor 0 0 0 286142502)))))) diff --git a/tests/string.pure.lisp b/tests/string.pure.lisp index 702dfee..1b659fd 100644 --- a/tests/string.pure.lisp +++ b/tests/string.pure.lisp @@ -76,3 +76,14 @@ (assert (raises-error? (make-string 5 :element-type t))) (assert (raises-error? (let () (make-string 5 :element-type t)))) + +;; MISC.574 +(assert (= (funcall (lambda (a) + (declare (optimize (speed 3) (safety 1) + (debug 1) (space 2)) + (fixnum a)) + (string<= (coerce "e99mo7yAJ6oU4" 'base-string) + (coerce "aaABAAbaa" 'base-string) + :start1 a)) + 9) + 9)) diff --git a/version.lisp-expr b/version.lisp-expr index 58c0a3d..50ff475 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.8.20.26" +"0.8.20.27" -- 1.7.10.4