X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fx86%2Ffloat.lisp;h=bde111ae43f86bd92b6a31e59d3f729323b5c26e;hb=2230ea0c1765a95fd2aa0a8996b3555b93ba3745;hp=9e10b3c9cf422d5c0fe03949d323757d3c41d36e;hpb=d95f1e6476aa63695e018a7769a1ae9e002fca36;p=sbcl.git diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index 9e10b3c..bde111a 100644 --- 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)) @@ -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))