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.

diff --git a/NEWS b/NEWS
index f2d24a2..4dc064d 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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.8.20.26"
+"0.8.20.27"