From 20954a1e7add5779b855d9d6e6444314e77df3f5 Mon Sep 17 00:00:00 2001
From: Nathan Froyd <froydnj@cs.rice.edu>
Date: Wed, 27 Jan 2010 00:45:11 +0000
Subject: [PATCH] 1.0.34.12: slightly better code generation for x86-64 float
 conversions

%{SINGLE,DOUBLE}-FLOAT required an unnecessary temporary stack slot.
Float->integer and float->float conversions also suffered from not being
able to take arguments in stack SCs.
---
 NEWS                           |    2 ++
 src/compiler/x86-64/float.lisp |   59 ++++++++++++++++++----------------------
 version.lisp-expr              |    2 +-
 3 files changed, 30 insertions(+), 33 deletions(-)

diff --git a/NEWS b/NEWS
index 01a7863..be09eae 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.0.34:
+  * optimization: Slightly better code is generated for integer<->float
+    conversions and for single-float<->double-float conversions on x86-64.
   * optimization: SB-ROTATE-BYTE:ROTATE-BYTE now generates more efficient
     code for 32-bit and 64-bit rotations on x86-64.
   * bug fix: TRUNCATE with a single single-float or double-float argument is
diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index 5b21175..6943574 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -1039,8 +1039,7 @@
 
 (macrolet ((frob (name translate inst to-sc to-type)
              `(define-vop (,name)
-                (:args (x :scs (signed-stack signed-reg) :target temp))
-                (:temporary (:sc signed-stack) temp)
+                (:args (x :scs (signed-stack signed-reg)))
                 (:results (y :scs (,to-sc)))
                 (:arg-types signed-num)
                 (:result-types ,to-type)
@@ -1050,20 +1049,14 @@
                 (:vop-var vop)
                 (:save-p :compute-only)
                 (:generator 5
-                  (sc-case x
-                    (signed-reg
-                     (inst mov temp x)
-                     (note-this-location vop :internal-error)
-                     (inst ,inst y temp))
-                    (signed-stack
-                     (note-this-location vop :internal-error)
-                     (inst ,inst y x)))))))
+                  (note-this-location vop :internal-error)
+                  (inst ,inst y x)))))
   (frob %single-float/signed %single-float cvtsi2ss single-reg single-float)
   (frob %double-float/signed %double-float cvtsi2sd double-reg double-float))
 
-(macrolet ((frob (name translate inst from-sc from-type to-sc to-type)
+(macrolet ((frob (name translate inst from-scs from-type ea-func to-sc to-type)
              `(define-vop (,name)
-               (:args (x :scs (,from-sc) :target y))
+               (:args (x :scs ,from-scs :target y))
                (:results (y :scs (,to-sc)))
                (:arg-types ,from-type)
                (:result-types ,to-type)
@@ -1074,18 +1067,20 @@
                (:save-p :compute-only)
                (:generator 2
                 (note-this-location vop :internal-error)
-                (inst ,inst y x)))))
-  (frob %single-float/double-float %single-float cvtsd2ss double-reg
-        double-float single-reg single-float)
+                (inst ,inst y (sc-case x
+                                (,(first from-scs) x)
+                                (,(second from-scs) (,ea-func x))))))))
+  (frob %single-float/double-float %single-float cvtsd2ss
+        (double-reg double-stack) double-float ea-for-df-stack
+        single-reg single-float)
 
   (frob %double-float/single-float %double-float cvtss2sd
-        single-reg single-float double-reg double-float))
+        (single-reg single-stack) single-float ea-for-sf-stack
+        double-reg double-float))
 
-(macrolet ((frob (trans inst from-sc from-type round-p)
-             (declare (ignore round-p))
+(macrolet ((frob (trans inst from-scs from-type ea-func)
              `(define-vop (,(symbolicate trans "/" from-type))
-               (:args (x :scs (,from-sc)))
-               (:temporary (:sc any-reg) temp-reg)
+               (:args (x :scs ,from-scs))
                (:results (y :scs (signed-reg)))
                (:arg-types ,from-type)
                (:result-types signed-num)
@@ -1095,18 +1090,18 @@
                (:vop-var vop)
                (:save-p :compute-only)
                (:generator 5
-                 (sc-case y
-                          (signed-stack
-                           (inst ,inst temp-reg x)
-                           (move y temp-reg))
-                          (signed-reg
-                           (inst ,inst y x)
-                           ))))))
-  (frob %unary-truncate/single-float cvttss2si single-reg single-float nil)
-  (frob %unary-truncate/double-float cvttsd2si double-reg double-float nil)
-
-  (frob %unary-round cvtss2si single-reg single-float t)
-  (frob %unary-round cvtsd2si double-reg double-float t))
+                 (inst ,inst y (sc-case x
+                                 (,(first from-scs) x)
+                                 (,(second from-scs) (,ea-func x))))))))
+  (frob %unary-truncate/single-float cvttss2si
+        (single-reg single-stack) single-float ea-for-sf-stack)
+  (frob %unary-truncate/double-float cvttsd2si
+        (double-reg double-stack) double-float ea-for-df-stack)
+
+  (frob %unary-round cvtss2si
+        (single-reg single-stack) single-float ea-for-sf-stack)
+  (frob %unary-round cvtsd2si
+        (double-reg double-stack) double-float ea-for-df-stack))
 
 (define-vop (make-single-float)
   (:args (bits :scs (signed-reg) :target res
diff --git a/version.lisp-expr b/version.lisp-expr
index 7f48f79..29fb8a8 100644
--- 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.34.11"
+"1.0.34.12"
-- 
1.7.10.4