Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv12811/src/compiler/x86-64
Modified Files:
float.lisp insts.lisp
Log Message:
1.0.36.30: on x86-64 split MOVE-TO-SINGLE into -REG and -STACK versions
* More accurate lifetime for the temporary in both, to avoid spurious
moves, as per patch.
* When moving from control stack to reg, untag in the XMM register
instead of a GP register, as per patch.
* Missing commas in SSE shuffle instruction printers.
Adapted from patch by Lutz Euler on sbcl-devel 2009-10-12.
Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/float.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- float.lisp 16 Feb 2010 04:45:25 -0000 1.23
+++ float.lisp 18 Mar 2010 11:17:01 -0000 1.24
@@ -191,23 +191,39 @@
(double-reg) (descriptor-reg))
;;; Move from a descriptor to a float register.
-(define-vop (move-to-single)
+(define-vop (move-to-single-reg)
+ (:args (x :scs (descriptor-reg) :target tmp
+ :load-if (not (sc-is x control-stack))))
+ (:temporary (:sc unsigned-reg :from :argument :to :result) tmp)
+ (:results (y :scs (single-reg)))
+ (:note "pointer to float coercion")
+ (:generator 2
+ (sc-case x
+ (descriptor-reg
+ (move tmp x)
+ (inst shr tmp 32)
+ (inst movd y tmp))
+ (control-stack
+ ;; When the single-float descriptor is in memory, the untagging
+ ;; is done in the target XMM register. This is faster than going
+ ;; through a general-purpose register and the code is smaller.
+ (inst movq y x)
+ (inst shufps y y #4r3331)))))
+(define-move-vop move-to-single-reg :move (descriptor-reg) (single-reg))
+
+;;; Move from a descriptor to a float stack.
+(define-vop (move-to-single-stack)
(:args (x :scs (descriptor-reg) :target tmp))
- (:temporary (:sc unsigned-reg) tmp)
- (:results (y :scs (single-reg single-stack)))
+ (:temporary (:sc unsigned-reg :from :argument :to :result) tmp)
+ (:results (y :scs (single-stack)))
(:note "pointer to float coercion")
(:generator 2
(move tmp x)
(inst shr tmp 32)
- (sc-case y
- (single-reg
- (inst movd y tmp))
- (single-stack
- (let ((slot (make-ea :dword :base rbp-tn
- :disp (frame-byte-offset (tn-offset y)))))
- (inst mov slot (reg-in-size tmp :dword)))))))
-
-(define-move-vop move-to-single :move (descriptor-reg) (single-reg single-stack))
+ (let ((slot (make-ea :dword :base rbp-tn
+ :disp (frame-byte-offset (tn-offset y)))))
+ (inst mov slot (reg-in-size tmp :dword)))))
+(define-move-vop move-to-single-stack :move (descriptor-reg) (single-stack))
(define-vop (move-to-double)
(:args (x :scs (descriptor-reg)))
Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/insts.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- insts.lisp 1 Mar 2010 13:09:00 -0000 1.37
+++ insts.lisp 18 Mar 2010 11:17:02 -0000 1.38
@@ -1124,7 +1124,8 @@
(sb!disassem:define-instruction-format (xmm-xmm/mem-imm 24
:default-printer
- '(:name :tab reg ", " reg/mem " " imm))
+ '(:name
+ :tab reg ", " reg/mem ", " imm))
(x0f :field (byte 8 0) :value #x0f)
(op :field (byte 8 8))
(reg/mem :fields (list (byte 2 22) (byte 3 16))
@@ -1134,7 +1135,8 @@
(sb!disassem:define-instruction-format (rex-xmm-xmm/mem-imm 32
:default-printer
- '(:name :tab reg ", " reg/mem " " imm))
+ '(:name
+ :tab reg ", " reg/mem ", " imm))
(rex :field (byte 4 4) :value #b0100)
(wrxb :field (byte 4 0) :type 'wrxb)
(x0f :field (byte 8 8) :value #x0f)
@@ -1146,7 +1148,8 @@
(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-imm 32
:default-printer
- '(:name :tab reg ", " reg/mem " " imm))
+ '(:name
+ :tab reg ", " reg/mem ", " imm))
(prefix :field (byte 8 0))
(x0f :field (byte 8 8) :value #x0f)
(op :field (byte 8 16))
@@ -1157,7 +1160,8 @@
(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem-imm 40
:default-printer
- '(:name :tab reg ", " reg/mem " " imm))
+ '(:name
+ :tab reg ", " reg/mem ", " imm))
(prefix :field (byte 8 0))
(rex :field (byte 4 12) :value #b0100)
(wrxb :field (byte 4 8) :type 'wrxb)
|