CMUCL commit: src/compiler/x86 (3 files)
Raymond Toy
rtoy at common-lisp.net
Thu Jul 1 05:03:27 CEST 2010
Date: Wednesday, June 30, 2010 @ 23:03:27
Author: rtoy
Path: /project/cmucl/cvsroot/src/compiler/x86
Modified: float-sse2.lisp sse2-c-call.lisp vm.lisp
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.)
------------------+
float-sse2.lisp | 47 ++++++++++++++++++++++++++++++++++++++++++++---
sse2-c-call.lisp | 25 +++++++++++--------------
vm.lisp | 4 ++--
3 files changed, 57 insertions(+), 19 deletions(-)
Index: src/compiler/x86/float-sse2.lisp
diff -u src/compiler/x86/float-sse2.lisp:1.13 src/compiler/x86/float-sse2.lisp:1.14
--- src/compiler/x86/float-sse2.lisp:1.13 Tue Apr 20 13:57:47 2010
+++ src/compiler/x86/float-sse2.lisp Wed Jun 30 23:03:27 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.13 2010-04-20 17:57:47 rtoy Exp $")
+ "$Header: /project/cmucl/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))
Index: src/compiler/x86/sse2-c-call.lisp
diff -u src/compiler/x86/sse2-c-call.lisp:1.4 src/compiler/x86/sse2-c-call.lisp:1.5
--- src/compiler/x86/sse2-c-call.lisp:1.4 Tue Jun 22 11:35:23 2010
+++ src/compiler/x86/sse2-c-call.lisp Wed Jun 30 23:03:27 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.4 2010-06-22 15:35:23 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.5 2010-07-01 03:03:27 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -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)))))))
Index: src/compiler/x86/vm.lisp
diff -u src/compiler/x86/vm.lisp:1.17 src/compiler/x86/vm.lisp:1.18
--- src/compiler/x86/vm.lisp:1.17 Tue Jun 22 12:55:16 2010
+++ src/compiler/x86/vm.lisp Wed Jun 30 23:03:27 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/vm.lisp,v 1.17 2010-06-22 16:55:16 rtoy Exp $")
+ "$Header: /project/cmucl/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")
More information about the cmucl-commit
mailing list