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.

diff --git a/NEWS b/NEWS
index d6c9c73..5642bc6 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,8 @@ changes relative to sbcl-1.0.36:
     for accessing such arrays.
   * optimization: passing NIL as the environment argument to TYPEP no longer
     inhibits optimizing it. (lp#309788)
+  * optimization: more efficient register usage when handling single-float
+    arguments on x86-64. (thanks to Lutz Euler)
   * optimization: ADJUST-ARRAY and STABLE-SORT on vectors no longer use
     pre-allocated temporary vectors. (lp#496249)
   * bug fix: Fix compiler error involving MAKE-ARRAY and IF forms

diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index 6f0a27f..227e1f9 100644 (file)
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -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)))

diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index b141f85..78ee46b 100644 (file)
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -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)

diff --git a/version.lisp-expr b/version.lisp-expr
index 0e107de..c7ed064 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.36.30"
+"1.0.36.31"