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