The branch "master" has been updated in SBCL:
via 3a5eea238fd103af32a3d26082d1b9f7388ddf4b (commit)
from 1d8fbfadd235e156fbbf6e04f5274c748af8416b (commit)
- Log -----------------------------------------------------------------
commit 3a5eea238fd103af32a3d26082d1b9f7388ddf4b
Author: Paul Khuong <pvk@...>
Date: Tue Aug 23 14:57:06 2011 -0400
Ensure correct alignment for complex single-float literals
Only an issue on x86-64: literal complex single-float values used
directly as operands to SIMD instructions were not correctly aligned
and extended. Completion typo fixed.
Test added.
Remove misleading comments in negate/conjugate/abs float VOPs while
we're at it.
Reported by Eric Marsden on sbcl-devel.
Fixes lp#832005.
---
src/compiler/x86-64/float.lisp | 29 +++++++++++++++--------------
tests/compiler.pure.lisp | 7 +++++++
2 files changed, 22 insertions(+), 14 deletions(-)
diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index ec3fad0..c74c8c7 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -390,27 +390,31 @@
complex-double-float))
(macrolet ((generate (opinst commutative constant-sc load-inst)
- `(flet ((get-constant (tn)
- (register-inline-constant
- ,@(and (eq constant-sc 'fp-single-immediate)
- '(:aligned))
- (tn-value tn))))
+ `(flet ((get-constant (tn &optional maybe-aligned)
+ (declare (ignorable maybe-aligned))
+ (let ((value (tn-value tn)))
+ ,(if (eq constant-sc 'fp-complex-single-immediate)
+ `(if maybe-aligned
+ (register-inline-constant
+ :aligned value)
+ (register-inline-constant value))
+ `(register-inline-constant value)))))
(declare (ignorable #'get-constant))
(cond
((location= x r)
(when (sc-is y ,constant-sc)
- (setf y (get-constant y)))
+ (setf y (get-constant y t)))
(inst ,opinst x y))
((and ,commutative (location= y r))
(when (sc-is x ,constant-sc)
- (setf x (get-constant x)))
+ (setf x (get-constant x t)))
(inst ,opinst y x))
((not (location= r y))
(if (sc-is x ,constant-sc)
(inst ,load-inst r (get-constant x))
(move r x))
(when (sc-is y ,constant-sc)
- (setf y (get-constant y)))
+ (setf y (get-constant y t)))
(inst ,opinst r y))
(t
(if (sc-is x ,constant-sc)
@@ -809,12 +813,9 @@
(:vop-var vop)
(:save-p :compute-only)
(:generator 1
- (note-this-location vop :internal-error)
- ;; we should be able to do this better. what we
- ;; really would like to do is use the target as the
- ;; temp whenever it's not also the source
- (move y x)
- ,@body))))
+ (note-this-location vop :internal-error)
+ (move y x)
+ ,@body))))
(frob (%negate/double-float %negate double-reg double-float)
(inst xorpd y (register-inline-constant :oword (ash 1 63))))
(frob (%negate/complex-double-float %negate complex-double-reg complex-double-float)
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index fff0ec4..fbdd62b 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3994,3 +3994,10 @@
(foo))))
(assert (eql 42 (funcall fun)))
(assert (and warn (not fail)))))
+
+(with-test (:name :bug-832005)
+ (let ((fun (compile nil `(lambda (x)
+ (declare (type (complex single-float) x))
+ (+ #C(0.0 1.0) x)))))
+ (assert (= (funcall fun #C(1.0 2.0))
+ #C(1.0 3.0)))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|