Skip to content

Commit

Permalink
1.0.29.1: fix FILL
Browse files Browse the repository at this point in the history 
 * 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.
  • Loading branch information
@nikodemus
nikodemus committed Jun 4, 2009
1 parent e834360 commit fd79e33
Show file tree
Hide file tree
Showing 8 changed files with 56 additions and 34 deletions.
8 changes: 6 additions & 2 deletions INSTALL
View file
Expand Up @@ -259,5 +259,9 @@ INSTALLING SBCL
by e.g. testing during the monthly freeze periods, and most by e.g. testing during the monthly freeze periods, and most
importantly by reporting any problems. importantly by reporting any problems.


If you need support beyond what is available on the mailing lists, For further support, see Getting Support and Reporting Bugs
see "Consultants" in the "SUPPORT" file. 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.
5 changes: 5 additions & 0 deletions NEWS
View file
@@ -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 * IMPORTANT: bug database has moved from the BUGS file to Launchpad
https://bugs.launchpad.net/sbcl https://bugs.launchpad.net/sbcl
Bugs can be reported directly there, or by sending email to Bugs can be reported directly there, or by sending email to
Expand Down
2 changes: 1 addition & 1 deletion binary-distribution.sh
View file
Expand Up @@ -12,7 +12,7 @@ set -e
b=${1:?"missing base directory name argument"} b=${1:?"missing base directory name argument"}
tar -cf $b-binary.tar \ tar -cf $b-binary.tar \
$b/output/sbcl.core $b/src/runtime/sbcl \ $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/install.sh $b/find-gnumake.sh $b/sbcl-pwd.sh $b/run-sbcl.sh \
$b/doc/sbcl.1 \ $b/doc/sbcl.1 \
$b/pubring.pgp \ $b/pubring.pgp \
Expand Down
2 changes: 1 addition & 1 deletion html-distribution.sh
View file
Expand Up @@ -8,5 +8,5 @@ set -e
b=${1:?missing base directory name argument} b=${1:?missing base directory name argument}
tar cf $b-documentation-html.tar \ tar cf $b-documentation-html.tar \
`find $b -name '*.htm*'` \ `find $b -name '*.htm*'` \
$b/COPYING $b/CREDITS $b/README $b/SUPPORT \ $b/COPYING $b/CREDITS $b/README \
$b/pubring.pgp $b/pubring.pgp
2 changes: 1 addition & 1 deletion install.sh
View file
Expand Up @@ -138,7 +138,7 @@ do
&& echo " html $BUILD_ROOT$DOC_DIR/html/`basename $html`/index.html" && echo " html $BUILD_ROOT$DOC_DIR/html/`basename $html`/index.html"
done done


for f in BUGS SUPPORT CREDITS COPYING NEWS for f in BUGS CREDITS COPYING NEWS
do do
cp $f "$BUILD_ROOT$DOC_DIR"/ cp $f "$BUILD_ROOT$DOC_DIR"/
done done
60 changes: 32 additions & 28 deletions src/compiler/seqtran.lisp
View file
Expand Up @@ -569,40 +569,44 @@
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
(:complex-single-float (:complex-single-float
(logior (ash (single-float-bits (imagpart tmp)) 32) (logior (ash (single-float-bits (imagpart tmp)) 32)
(single-float-bits (realpart tmp))))))) (ldb (byte 32 0)
(single-float-bits (realpart tmp))))))))
(res bits)) (res bits))
(loop for i of-type sb!vm:word from n-bits by n-bits (loop for i of-type sb!vm:word from n-bits by n-bits
until (= i sb!vm:n-word-bits) until (= i sb!vm:n-word-bits)
do (setf res (ldb (byte sb!vm:n-word-bits 0) do (setf res (ldb (byte sb!vm:n-word-bits 0)
(logior res (ash bits i))))) (logior res (ash bits i)))))
res)) res))
`(let* ((bits (ldb (byte ,n-bits 0) (progn
,(ecase kind (delay-ir1-transform node :constraint)
(:tagged `(let* ((bits (ldb (byte ,n-bits 0)
`(ash item ,sb!vm:n-fixnum-tag-bits)) ,(ecase kind
(:char (:tagged
`(char-code item)) `(ash item ,sb!vm:n-fixnum-tag-bits))
(:bits (:char
`item) `(char-code item))
(:single-float (:bits
`(single-float-bits item)) `item)
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) (:single-float
(:double-float `(single-float-bits item))
`(logior (ash (double-float-high-bits item) 32) #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
(double-float-low-bits item))) (:double-float
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) `(logior (ash (double-float-high-bits item) 32)
(:complex-single-float (double-float-low-bits item)))
`(logior (ash (single-float-bits (imagpart item)) 32) #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
(single-float-bits (realpart item))))))) (:complex-single-float
(res bits)) `(logior (ash (single-float-bits (imagpart item)) 32)
(declare (type sb!vm:word res)) (ldb (byte 32 0)
,@(unless (= sb!vm:n-word-bits n-bits) (single-float-bits (realpart item))))))))
`((loop for i of-type sb!vm:word from ,n-bits by ,n-bits (res bits))
until (= i sb!vm:n-word-bits) (declare (type sb!vm:word res))
do (setf res ,@(unless (= sb!vm:n-word-bits n-bits)
(ldb (byte ,sb!vm:n-word-bits 0) `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits
(logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i)))))))) until (= i sb!vm:n-word-bits)
res)))) 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 (values
`(with-array-data ((data seq) `(with-array-data ((data seq)
(start start) (start start)
Expand Down
9 changes: 9 additions & 0 deletions tests/compiler.impure.lisp
View file
Expand Up @@ -1084,6 +1084,15 @@
(assert (equal "GOOD!" (assert (equal "GOOD!"
(progv '(*hairy-progv-var*) (list (eval "GOOD!")) (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
*hairy-progv-var*)))) *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 ;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself ;;;; compiler machinery itself
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
View file
Expand Up @@ -17,4 +17,4 @@
;;; checkins which aren't released. (And occasionally for internal ;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS ;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
"1.0.29" "1.0.29.1"

0 comments on commit fd79e33

Please sign in to comment.