From: Paul Khuong <pvk@pvk.ca>
Date: Tue, 23 Aug 2011 18:57:06 +0000 (-0400)
Subject: Ensure correct alignment for complex single-float literals
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3a5eea238fd103af32a3d26082d1b9f7388ddf4b;p=sbcl.git

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

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