X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Ffloat.lisp;h=e5b194249d1884ed75b43de6dcbeb8bc5c902c31;hb=02b6f6dfb38d99bcc3181035eb0681e6bb96b939;hp=3cc9def028352f85c8f682f937f82fceb890b0dc;hpb=98a76d4426660876dec6649b1e228d2e5b47f579;p=sbcl.git

diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp
index 3cc9def..e5b1942 100644
--- a/src/compiler/x86/float.lisp
+++ b/src/compiler/x86/float.lisp
@@ -177,26 +177,30 @@
 ;;; stored in a more precise form on chip. Anyhow, might as well use
 ;;; the feature. It can be turned off by hacking the
 ;;; "immediate-constant-sc" in vm.lisp.
+(eval-when (:compile-toplevel :execute)
+  (setf *read-default-float-format*
+	#!+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))))
     (with-empty-tn@fp-top(y)
       (cond ((zerop value)
 	     (inst fldz))
-	    ((= value 1l0)
+	    ((= value 1e0)
 	     (inst fld1))
-	    ((= value pi)
+	    ((= value (coerce pi *read-default-float-format*))
 	     (inst fldpi))
-	    ((= value (log 10l0 2l0))
+	    ((= value (log 10e0 2e0))
 	     (inst fldl2t))
-	    ((= value (log 2.718281828459045235360287471352662L0 2l0))
+	    ((= value (log 2.718281828459045235360287471352662e0 2e0))
 	     (inst fldl2e))
-	    ((= value (log 2l0 10l0))
+	    ((= value (log 2e0 10e0))
 	     (inst fldlg2))
-	    ((= value (log 2l0 2.718281828459045235360287471352662L0))
+	    ((= value (log 2e0 2.718281828459045235360287471352662e0))
 	     (inst fldln2))
 	    (t (warn "ignoring bogus i387 constant ~A" value))))))
-
+(eval-when (:compile-toplevel :execute)
+  (setf *read-default-float-format* 'single-float))
 
 ;;;; complex float move functions
 
@@ -3122,6 +3126,10 @@
 	  (descriptor-reg
 	   (inst fstp fr0)
 	   (inst fldd (ea-for-df-desc y)))))
+      ((and (sc-is x double-reg) (zerop (tn-offset x))
+	    (sc-is y double-reg) (zerop (tn-offset x)))
+       ;; copy x to fr1
+       (inst fst fr1))
       ;; y in fr0; x not in fr1
       ((and (sc-is y double-reg) (zerop (tn-offset y)))
        (inst fxch fr1)