From 4578fb4510680891c9893f9d99ab138d7c03dcaa Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Thu, 1 Jul 2010 03:03:27 +0000
Subject: [PATCH] Fix critical bug introduced in previous changes.  Incorrect
 results were returned when calling out to a C function returning a float.

float-sse2.lisp:
o Remove the FLOAT-MOVE vop and add a FLOAT-MOVE/SINGLE and
  FLOAT-MOVE/DOUBLE that can handle moving from FR0 or any XMM
  register to any XMM register.
o Update the move vops appropriately.

sse2-c-call.lisp:
o Don't need to move FR0 to XMM0 anymore.  This was one source of the
  problem.  The compiler knows now to ask for a move from FR0 to some
  XMM register.
o Update comments.

vm.lisp:
o Correct printing of XMM registers.  Previously printed them as
  XMM8-15 but should have been XMM0-7.  (Mostly in trace files.)
---
 compiler/x86/float-sse2.lisp  | 47 ++++++++++++++++++++++++++++++++---
 compiler/x86/sse2-c-call.lisp | 25 ++++++++-----------
 compiler/x86/vm.lisp          |  4 +--
 3 files changed, 57 insertions(+), 19 deletions(-)

diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp
index c8a4da9be..8262e6738 100644
--- a/compiler/x86/float-sse2.lisp
+++ b/compiler/x86/float-sse2.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.13 2010/04/20 17:57:47 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.14 2010/07/01 03:03:27 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -301,6 +301,7 @@
 ;;;
 ;;; Float register to register moves.
 ;;;
+#+nil
 (define-vop (float-move)
   (:args (x))
   (:results (y))
@@ -309,13 +310,53 @@
      (unless (location= x y)
        (inst movq y x))))
 
-(define-vop (single-move float-move)
+(define-vop (float-move/single)
+  (:args (x))
+  (:results (y))
+  (:note _N"float move")
+  (:temporary (:sc single-stack) temp)
+  (:generator 0
+    (unless (location= x y)
+      (let ((x-offset (tn-offset x))
+	    (y-offset (tn-offset y)))
+	(cond ((and (zerop x-offset)
+		    (>= y-offset 8))
+	       ;; Move fr0 to xmm
+	       (inst fst (ea-for-sf-stack temp))
+	       (inst movss y (ea-for-sf-stack temp)))
+	      ((and (>= x-offset 8)
+		    (>= y-offset 8))
+	       (inst movq y x))
+	      (t
+	       (error "Don't know how to move ~S to ~S" x y)))))))
+
+(define-vop (float-move/double)
+  (:args (x))
+  (:results (y))
+  (:note _N"float move")
+  (:temporary (:sc double-stack) temp)
+  (:generator 0
+    (unless (location= x y)
+      (let ((x-offset (tn-offset x))
+	    (y-offset (tn-offset y)))
+	(cond ((and (zerop x-offset)
+		    (>= y-offset 8))
+	       ;; Move fr0 to xmm
+	       (inst fstd (ea-for-df-stack temp))
+	       (inst movsd y (ea-for-df-stack temp)))
+	      ((and (>= x-offset 8)
+		    (>= y-offset 8))
+	       (inst movq y x))
+	      (t
+	       (error "Don't know how to move ~S to ~S" x y)))))))
+
+(define-vop (single-move float-move/single)
   (:args (x :scs (single-reg) :target y :load-if (not (location= x y))))
   (:results (y :scs (single-reg) :load-if (not (location= x y)))))
 
 (define-move-vop single-move :move (single-reg) (single-reg))
 
-(define-vop (double-move float-move)
+(define-vop (double-move float-move/double)
   (:args (x :scs (double-reg) :target y :load-if (not (location= x y))))
   (:results (y :scs (double-reg) :load-if (not (location= x y)))))
 (define-move-vop double-move :move (double-reg) (double-reg))
diff --git a/compiler/x86/sse2-c-call.lisp b/compiler/x86/sse2-c-call.lisp
index 7bfaded3f..02e155ca8 100644
--- a/compiler/x86/sse2-c-call.lisp
+++ b/compiler/x86/sse2-c-call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.4 2010/06/22 15:35:23 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.5 2010/07/01 03:03:27 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -43,13 +43,10 @@
   (:generator 0 
     (cond ((policy node (> space speed))
 	   (move eax function)
-	   (inst call (make-fixup (extern-alien-name "call_into_c") :foreign))
-	   (when (and results
-		      (location= (tn-ref-tn results) fr0-tn))
-	     ;; call_into_c as arranged for ST(0) to contain the result.
-	     ;; Move it to XMM0.
-	     (inst fstd (ea-for-df-stack temp))
-	     (inst movsd xmm0-tn (ea-for-df-stack temp))))
+	   ;; call_into_c has arranged for the result to be in ST(0)
+	   ;; (aka fr0), so there's nothing we need to do now.  The
+	   ;; compiler will move fr0 to the appropriate XMM register.
+	   (inst call (make-fixup (extern-alien-name "call_into_c") :foreign)))
 	  (t
 	   ;; Setup the NPX for C; all the FP registers need to be
 	   ;; empty; pop them all.
@@ -67,12 +64,12 @@
 	   
 	   (cond ((and results
 		       (location= (tn-ref-tn results) fr0-tn))
-		  ;; If there's a float result, it would have been returned
-		  ;; in fr0, which is now in fr7, thanks to the fldz's above.
-		  (inst fxch fr7-tn)	; move the result back to fr0
-		  ;; Move the result into xmm0.
-		  (inst fstd (ea-for-df-stack temp))
-		  (inst movsd xmm0-tn (ea-for-df-stack temp)))
+		  ;; If there's a float result, it would have been
+		  ;; returned in fr0, which is now in fr7, thanks to
+		  ;; the fldz's above.  Swap fr7 with fr0.  The
+		  ;; compiler will arrange to move fr0 to the
+		  ;; appropriate XMM register.
+		  (inst fxch fr7-tn))
 		 (t
 		  ;; Fill up the last x87 register
 		  (inst fldz)))))))
diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp
index d5db72e90..f6bf48186 100644
--- a/compiler/x86/vm.lisp
+++ b/compiler/x86/vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.17 2010/06/22 16:55:16 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.18 2010/07/01 03:03:27 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -485,7 +485,7 @@
        (format nil (if (< offset 8)
 		       "FR~D"
 		       "XMM~D")
-	       offset))
+	       (mod offset 8)))
       (stack (format nil "S~D" offset))
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed")
-- 
GitLab