common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

1.0.29.1: fix FILL

Browse source 
* 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.
This commit is contained in:
Nikodemus Siivola 2009-06-04 18:01:31 +00:00
parent e834360df9
commit fd79e33e6b
8 changed files with 56 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
INSTALL
View file

@ -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
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

2
binary-distribution.sh
View file

@ -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 \

2
html-distribution.sh
View file

@ -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
install.sh
View file

@ -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
src/compiler/seqtran.lisp
View file

@ -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)

9
tests/compiler.impure.lisp
View file

@ -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

2
version.lisp-expr
View file

@ -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"