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

5
NEWS
View file

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

2
binary-distribution.sh
View file

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

2
html-distribution.sh
View file

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

2
install.sh
View file

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

60
src/compiler/seqtran.lisp
View file

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

9
tests/compiler.impure.lisp
View file

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

2
version.lisp-expr
View file

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