1.0.29.1: fix FILL

 * Imaginary parts were messed up on 64 bit platforms when
   filling arrays of (COMPLEX SINGLE-FLOAT). Thanks to Paul Khuong.

 * Also delay the transform of FILL till constraint propagation has
   run, to get the constant argument form MAKE-ARRAY in properly.

 * ...and eradicate remaining references to the SUPPORT file.

diff --git a/INSTALL b/INSTALL
index 83f4368..018ef58 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -259,5 +259,9 @@ INSTALLING SBCL
     by e.g. testing during the monthly freeze periods, and most
     importantly by reporting any problems.
 
     by e.g. testing during the monthly freeze periods, and most
     importantly by reporting any problems.
 

-    If you need support beyond what is available on the mailing lists,
-    see "Consultants" in the "SUPPORT" file.
+    For further support, see Getting Support and Reporting Bugs
+    in the manual, or
+
+      http://www.sbcl.org/manual/Getting-Support-and-Reporting-Bugs.html
+
+    if you do not have the manual for some reason.

diff --git a/NEWS b/NEWS
index 42ccd73..3f3fe5f 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,9 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 ;;;; -*- coding: utf-8; fill-column: 78 -*-

+  * bug fix: on 64 bit platforms FILL worked incorrectly on arrays with
+    upgraded element type (COMPLEX SINGLE-FLOAT), regression from 1.0.28.55.
+    (thanks to Paul Khuong)
+
+changes in sbcl-1.0.29 relative to 1.0.28:

   * IMPORTANT: bug database has moved from the BUGS file to Launchpad
         https://bugs.launchpad.net/sbcl
     Bugs can be reported directly there, or by sending email to
   * IMPORTANT: bug database has moved from the BUGS file to Launchpad
         https://bugs.launchpad.net/sbcl
     Bugs can be reported directly there, or by sending email to

diff --git a/binary-distribution.sh b/binary-distribution.sh
index 2476edd..c6d3db9 100755 (executable)
--- a/binary-distribution.sh
+++ b/binary-distribution.sh
@@ -12,7 +12,7 @@ set -e
 b=${1:?"missing base directory name argument"}
 tar -cf $b-binary.tar \
     $b/output/sbcl.core $b/src/runtime/sbcl \
 b=${1:?"missing base directory name argument"}
 tar -cf $b-binary.tar \
     $b/output/sbcl.core $b/src/runtime/sbcl \

-    $b/BUGS $b/COPYING $b/CREDITS $b/INSTALL $b/NEWS $b/README $b/SUPPORT \
+    $b/BUGS $b/COPYING $b/CREDITS $b/INSTALL $b/NEWS $b/README \

     $b/install.sh $b/find-gnumake.sh $b/sbcl-pwd.sh $b/run-sbcl.sh \
     $b/doc/sbcl.1 \
     $b/pubring.pgp \
     $b/install.sh $b/find-gnumake.sh $b/sbcl-pwd.sh $b/run-sbcl.sh \
     $b/doc/sbcl.1 \
     $b/pubring.pgp \

diff --git a/html-distribution.sh b/html-distribution.sh
index 6a2bb58..c336a76 100644 (file)
--- a/html-distribution.sh
+++ b/html-distribution.sh
@@ -8,5 +8,5 @@ set -e
 b=${1:?missing base directory name argument}
 tar cf $b-documentation-html.tar \
     `find $b -name '*.htm*'` \
 b=${1:?missing base directory name argument}
 tar cf $b-documentation-html.tar \
     `find $b -name '*.htm*'` \

-    $b/COPYING $b/CREDITS $b/README $b/SUPPORT \
+    $b/COPYING $b/CREDITS $b/README \

     $b/pubring.pgp
     $b/pubring.pgp

diff --git a/install.sh b/install.sh
index 051e44b..35c985f 100644 (file)
--- a/install.sh
+++ b/install.sh
@@ -138,7 +138,7 @@ do
       && echo " html $BUILD_ROOT$DOC_DIR/html/`basename $html`/index.html"
 done
 
       && echo " html $BUILD_ROOT$DOC_DIR/html/`basename $html`/index.html"
 done
 

-for f in BUGS SUPPORT CREDITS COPYING NEWS
+for f in BUGS CREDITS COPYING NEWS

 do
   cp $f "$BUILD_ROOT$DOC_DIR"/
 done
 do
   cp $f "$BUILD_ROOT$DOC_DIR"/
 done

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 065674e..8f83892 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -569,40 +569,44 @@
                                         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
                                         (:complex-single-float
                                          (logior (ash (single-float-bits (imagpart tmp)) 32)
                                         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
                                         (:complex-single-float
                                          (logior (ash (single-float-bits (imagpart tmp)) 32)

-                                                 (single-float-bits (realpart tmp)))))))
+                                                 (ldb (byte 32 0)
+                                                      (single-float-bits (realpart tmp))))))))

                                 (res bits))
                            (loop for i of-type sb!vm:word from n-bits by n-bits
                                  until (= i sb!vm:n-word-bits)
                                  do (setf res (ldb (byte sb!vm:n-word-bits 0)
                                                    (logior res (ash bits i)))))
                            res))
                                 (res bits))
                            (loop for i of-type sb!vm:word from n-bits by n-bits
                                  until (= i sb!vm:n-word-bits)
                                  do (setf res (ldb (byte sb!vm:n-word-bits 0)
                                                    (logior res (ash bits i)))))
                            res))

-                       `(let* ((bits (ldb (byte ,n-bits 0)
-                                          ,(ecase kind
-                                                  (:tagged
-                                                   `(ash item ,sb!vm:n-fixnum-tag-bits))
-                                                  (:char
-                                                   `(char-code item))
-                                                  (:bits
-                                                   `item)
-                                                  (:single-float
-                                                   `(single-float-bits item))
-                                                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                                                  (:double-float
-                                                   `(logior (ash (double-float-high-bits item) 32)
-                                                            (double-float-low-bits item)))
-                                                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                                                  (:complex-single-float
-                                                   `(logior (ash (single-float-bits (imagpart item)) 32)
-                                                            (single-float-bits (realpart item)))))))
-                               (res bits))
-                          (declare (type sb!vm:word res))
-                          ,@(unless (= sb!vm:n-word-bits n-bits)
-                                    `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits
-                                            until (= i sb!vm:n-word-bits)
-                                            do (setf res
-                                                     (ldb (byte ,sb!vm:n-word-bits 0)
-                                                          (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i))))))))
-                          res))))
+                       (progn
+                         (delay-ir1-transform node :constraint)
+                        `(let* ((bits (ldb (byte ,n-bits 0)
+                                           ,(ecase kind
+                                                   (:tagged
+                                                    `(ash item ,sb!vm:n-fixnum-tag-bits))
+                                                   (:char
+                                                    `(char-code item))
+                                                   (:bits
+                                                    `item)
+                                                   (:single-float
+                                                    `(single-float-bits item))
+                                                   #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                                                   (:double-float
+                                                    `(logior (ash (double-float-high-bits item) 32)
+                                                             (double-float-low-bits item)))
+                                                   #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                                                   (:complex-single-float
+                                                    `(logior (ash (single-float-bits (imagpart item)) 32)
+                                                             (ldb (byte 32 0)
+                                                                  (single-float-bits (realpart item))))))))
+                                (res bits))
+                           (declare (type sb!vm:word res))
+                           ,@(unless (= sb!vm:n-word-bits n-bits)
+                                     `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits
+                                             until (= i sb!vm:n-word-bits)
+                                             do (setf res
+                                                      (ldb (byte ,sb!vm:n-word-bits 0)
+                                                           (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i))))))))
+                           res)))))

              (values
               `(with-array-data ((data seq)
                                  (start start)
              (values
               `(with-array-data ((data seq)
                                  (start start)

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 26b12ce..d5ec1ca 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1084,6 +1084,15 @@
   (assert (equal "GOOD!"
                  (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
                     *hairy-progv-var*))))
   (assert (equal "GOOD!"
                  (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
                     *hairy-progv-var*))))

+
+(with-test (:name :fill-complex-single-float)
+  (assert (eql #c(-1.0 2.0)
+               (aref (funcall
+                      (lambda ()
+                        (make-array 2
+                                    :element-type '(complex single-float)
+                                    :initial-element #c(-1.0 2.0))))
+                     0))))

 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

diff --git a/version.lisp-expr b/version.lisp-expr
index b1a6f89..ed25217 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".)
 ;;; 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".)

-"1.0.29"
+"1.0.29.1"