From 25692c34027ea51a6b51057bf803f19fe3a575d7 Mon Sep 17 00:00:00 2001
From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 11 Jun 2011 11:24:53 -0400
Subject: [PATCH] Specialised constant MAKE-{SINGLE,DOUBLE}-FLOAT VOPs on x86
 as well

These only trigger when the float to construct is a NaN, so very
marginal, and it doesn't seem worth the trouble on all the other
platforms (that don't support inline constants yet).
---
 src/compiler/x86/float.lisp |   29 +++++++++++++++++++++++++++++
 src/compiler/x86/insts.lisp |    3 +++
 2 files changed, 32 insertions(+)

diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp
index 03963ce..0d20e7f 100644
--- a/src/compiler/x86/float.lisp
+++ b/src/compiler/x86/float.lisp
@@ -1821,6 +1821,22 @@
            (with-empty-tn@fp-top(res)
               (inst fld bits))))))))
 
+(define-vop (make-single-float-c)
+  (:results (res :scs (single-reg single-stack)))
+  (:arg-types (:constant (signed-byte 32)))
+  (:result-types single-float)
+  (:info bits)
+  (:translate make-single-float)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 2
+    (sc-case res
+      (single-stack
+       (inst mov res bits))
+      (single-reg
+       (with-empty-tn@fp-top (res)
+         (inst fld (register-inline-constant :dword bits)))))))
+
 (define-vop (make-double-float)
   (:args (hi-bits :scs (signed-reg))
          (lo-bits :scs (unsigned-reg)))
@@ -1839,6 +1855,19 @@
         (inst fldd (make-ea :dword :base ebp-tn
                             :disp (frame-byte-offset (1+ offset))))))))
 
+(define-vop (make-double-float-c)
+  (:results (res :scs (double-reg)))
+  (:arg-types (:constant (signed-byte 32)) (:constant (unsigned-byte 32)))
+  (:result-types double-float)
+  (:info hi lo)
+  (:translate make-double-float)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 1
+    (with-empty-tn@fp-top(res)
+      (inst fldd (register-inline-constant
+                  :double-float-bits (logior (ash hi 32) lo))))))
+
 #!+long-float
 (define-vop (make-long-float)
   (:args (exp-bits :scs (signed-reg))
diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index c7e3005..6850859 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -3028,6 +3028,9 @@
       ((:single-float)
          (aver (typep value 'single-float))
          (cons :dword (ldb (byte 32 0) (single-float-bits value))))
+      ((:double-float-bits)
+         (aver (integerp value))
+         (cons :double-float (ldb (byte 64 0) value)))
       ((:double-float)
          (aver (typep value 'double-float))
          (cons :double-float
-- 
1.7.10.4