1.0.29.54: Inline unboxed constants on x86[-64]

[sbcl.git] / src / compiler / x86 / float.lisp

diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp
index 9e10b3c..bde111a 100644 (file)
--- a/src/compiler/x86/float.lisp
+++ b/src/compiler/x86/float.lisp
@@ -187,23 +187,39 @@
         #!+long-float 'long-float #!-long-float 'double-float))
 (define-move-fun (load-fp-constant 2) (vop x y)
   ((fp-constant) (single-reg double-reg #!+long-float long-reg))
-  (let ((value (sb!c::constant-value (sb!c::tn-leaf x))))
+  (let ((value (tn-value x)))
     (with-empty-tn@fp-top(y)
-      (cond ((zerop value)
+      (cond ((or (eql value 0f0) (eql value 0d0) #!+long-float (eql value 0l0))
              (inst fldz))
             ((= value 1e0)
              (inst fld1))
+            #!+long-float
             ((= value (coerce pi *read-default-float-format*))
              (inst fldpi))
+            #!+long-float
             ((= value (log 10e0 2e0))
              (inst fldl2t))
+            #!+long-float
             ((= value (log 2.718281828459045235360287471352662e0 2e0))
              (inst fldl2e))
+            #!+long-float
             ((= value (log 2e0 10e0))
              (inst fldlg2))
+            #!+long-float
             ((= value (log 2e0 2.718281828459045235360287471352662e0))
              (inst fldln2))
             (t (warn "ignoring bogus i387 constant ~A" value))))))
+
+(define-move-fun (load-fp-immediate 2) (vop x y)
+  ((fp-single-immediate) (single-reg)
+   (fp-double-immediate) (double-reg))
+  (let ((value (register-inline-constant (tn-value x))))
+    (with-empty-tn@fp-top(y)
+      (sc-case y
+        (single-reg
+         (inst fld value))
+        (double-reg
+         (inst fldd value))))))
 (eval-when (:compile-toplevel :execute)
   (setf *read-default-float-format* 'single-float))
 \f
@@ -502,16 +518,16 @@
   (:node-var node)
   (:note "complex float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y
-                             complex-single-float-widetag
-                             complex-single-float-size
-                             node)
-       (let ((real-tn (complex-single-reg-real-tn x)))
-         (with-tn@fp-top(real-tn)
-           (inst fst (ea-for-csf-real-desc y))))
-       (let ((imag-tn (complex-single-reg-imag-tn x)))
-         (with-tn@fp-top(imag-tn)
-           (inst fst (ea-for-csf-imag-desc y)))))))
+    (with-fixed-allocation (y
+                            complex-single-float-widetag
+                            complex-single-float-size
+                            node)
+      (let ((real-tn (complex-single-reg-real-tn x)))
+        (with-tn@fp-top(real-tn)
+          (inst fst (ea-for-csf-real-desc y))))
+      (let ((imag-tn (complex-single-reg-imag-tn x)))
+        (with-tn@fp-top(imag-tn)
+          (inst fst (ea-for-csf-imag-desc y)))))))
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))