From: Nikodemus Siivola Date: Thu, 4 Jun 2009 18:01:31 +0000 (+0000) Subject: 1.0.29.1: fix FILL X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fd79e33e6b6dacdc52cf6668a5bb7adf75aad6c1;p=sbcl.git 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 --- 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. - 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 --- a/NEWS +++ b/NEWS @@ -1,4 +1,9 @@ ;;;; -*- 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 diff --git a/binary-distribution.sh b/binary-distribution.sh index 2476edd..c6d3db9 100755 --- 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/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 \ diff --git a/html-distribution.sh b/html-distribution.sh index 6a2bb58..c336a76 100644 --- 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/COPYING $b/CREDITS $b/README $b/SUPPORT \ + $b/COPYING $b/CREDITS $b/README \ $b/pubring.pgp diff --git a/install.sh b/install.sh index 051e44b..35c985f 100644 --- a/install.sh +++ b/install.sh @@ -138,7 +138,7 @@ do && 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 diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 065674e..8f83892 100644 --- 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) - (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)) - `(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) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 26b12ce..d5ec1ca 100644 --- 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*)))) + +(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)))) ;;;; 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 --- 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".) -"1.0.29" +"1.0.29.1"