X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Ffloat.lisp;h=3de73736d8eb0da394face08366957791b5bb4c2;hb=d2e48d5a1805e3fb98268473a71aff38d8fd9d0b;hp=62d186ec7ab865091a63a28b1892912068ab92fa;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index 62d186e..3de7373 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -123,13 +123,13 @@ ;;;; move functions -;;; x is source, y is destination -(define-move-function (load-single 2) (vop x y) +;;; X is source, Y is destination. +(define-move-fun (load-single 2) (vop x y) ((single-stack) (single-reg)) (with-empty-tn@fp-top(y) (inst fld (ea-for-sf-stack x)))) -(define-move-function (store-single 2) (vop x y) +(define-move-fun (store-single 2) (vop x y) ((single-reg) (single-stack)) (cond ((zerop (tn-offset x)) (inst fst (ea-for-sf-stack y))) @@ -139,12 +139,12 @@ ;; This may not be necessary as ST0 is likely invalid now. (inst fxch x)))) -(define-move-function (load-double 2) (vop x y) +(define-move-fun (load-double 2) (vop x y) ((double-stack) (double-reg)) (with-empty-tn@fp-top(y) (inst fldd (ea-for-df-stack x)))) -(define-move-function (store-double 2) (vop x y) +(define-move-fun (store-double 2) (vop x y) ((double-reg) (double-stack)) (cond ((zerop (tn-offset x)) (inst fstd (ea-for-df-stack y))) @@ -155,13 +155,13 @@ (inst fxch x)))) #!+long-float -(define-move-function (load-long 2) (vop x y) +(define-move-fun (load-long 2) (vop x y) ((long-stack) (long-reg)) (with-empty-tn@fp-top(y) (inst fldl (ea-for-lf-stack x)))) #!+long-float -(define-move-function (store-long 2) (vop x y) +(define-move-fun (store-long 2) (vop x y) ((long-reg) (long-stack)) (cond ((zerop (tn-offset x)) (store-long-float (ea-for-lf-stack y))) @@ -177,7 +177,7 @@ ;;; 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. -(define-move-function (load-fp-constant 2) (vop x y) +(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) @@ -223,8 +223,8 @@ (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg) :offset (1+ (tn-offset x)))) -;;; x is source, y is destination. -(define-move-function (load-complex-single 2) (vop x y) +;;; X is source, Y is destination. +(define-move-fun (load-complex-single 2) (vop x y) ((complex-single-stack) (complex-single-reg)) (let ((real-tn (complex-single-reg-real-tn y))) (with-empty-tn@fp-top (real-tn) @@ -233,7 +233,7 @@ (with-empty-tn@fp-top (imag-tn) (inst fld (ea-for-csf-imag-stack x))))) -(define-move-function (store-complex-single 2) (vop x y) +(define-move-fun (store-complex-single 2) (vop x y) ((complex-single-reg) (complex-single-stack)) (let ((real-tn (complex-single-reg-real-tn x))) (cond ((zerop (tn-offset real-tn)) @@ -247,7 +247,7 @@ (inst fst (ea-for-csf-imag-stack y)) (inst fxch imag-tn))) -(define-move-function (load-complex-double 2) (vop x y) +(define-move-fun (load-complex-double 2) (vop x y) ((complex-double-stack) (complex-double-reg)) (let ((real-tn (complex-double-reg-real-tn y))) (with-empty-tn@fp-top(real-tn) @@ -256,7 +256,7 @@ (with-empty-tn@fp-top(imag-tn) (inst fldd (ea-for-cdf-imag-stack x))))) -(define-move-function (store-complex-double 2) (vop x y) +(define-move-fun (store-complex-double 2) (vop x y) ((complex-double-reg) (complex-double-stack)) (let ((real-tn (complex-double-reg-real-tn x))) (cond ((zerop (tn-offset real-tn)) @@ -271,7 +271,7 @@ (inst fxch imag-tn))) #!+long-float -(define-move-function (load-complex-long 2) (vop x y) +(define-move-fun (load-complex-long 2) (vop x y) ((complex-long-stack) (complex-long-reg)) (let ((real-tn (complex-long-reg-real-tn y))) (with-empty-tn@fp-top(real-tn) @@ -281,7 +281,7 @@ (inst fldl (ea-for-clf-imag-stack x))))) #!+long-float -(define-move-function (store-complex-long 2) (vop x y) +(define-move-fun (store-complex-long 2) (vop x y) ((complex-long-reg) (complex-long-stack)) (let ((real-tn (complex-long-reg-real-tn x))) (cond ((zerop (tn-offset real-tn)) @@ -432,8 +432,8 @@ (:results (y :scs (descriptor-reg))) (:generator 2 (ecase (sb!c::constant-value (sb!c::tn-leaf x)) - (0f0 (load-symbol-value y *fp-constant-0s0*)) - (1f0 (load-symbol-value y *fp-constant-1s0*)) + (0f0 (load-symbol-value y *fp-constant-0f0*)) + (1f0 (load-symbol-value y *fp-constant-1f0*)) (0d0 (load-symbol-value y *fp-constant-0d0*)) (1d0 (load-symbol-value y *fp-constant-1d0*)) #!+long-float @@ -579,7 +579,7 @@ ;;;; Note these are also used to stuff fp numbers onto the c-call ;;;; stack so the order is different than the lisp-stack. -;;; the general move-argument vop +;;; the general MOVE-ARG VOP (macrolet ((frob (name sc stack-sc format) `(progn (define-vop (,name) @@ -624,14 +624,14 @@ (:double '((inst fstd ea))) #!+long-float (:long '((store-long-float ea))))))))))) - (define-move-vop ,name :move-argument + (define-move-vop ,name :move-arg (,sc descriptor-reg) (,sc))))) - (frob move-single-float-argument single-reg single-stack :single) - (frob move-double-float-argument double-reg double-stack :double) + (frob move-single-float-arg single-reg single-stack :single) + (frob move-double-float-arg double-reg double-stack :double) #!+long-float - (frob move-long-float-argument long-reg long-stack :long)) + (frob move-long-float-arg long-reg long-stack :long)) -;;;; complex float move-argument vop +;;;; complex float MOVE-ARG VOP (macrolet ((frob (name sc stack-sc format) `(progn (define-vop (,name) @@ -699,17 +699,17 @@ '((store-long-float (ea-for-clf-imag-stack y fp))))) (inst fxch imag-tn)))))) - (define-move-vop ,name :move-argument + (define-move-vop ,name :move-arg (,sc descriptor-reg) (,sc))))) - (frob move-complex-single-float-argument + (frob move-complex-single-float-arg complex-single-reg complex-single-stack :single) - (frob move-complex-double-float-argument + (frob move-complex-double-float-arg complex-double-reg complex-double-stack :double) #!+long-float - (frob move-complex-long-float-argument + (frob move-complex-long-float-arg complex-long-reg complex-long-stack :long)) -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (single-reg double-reg #!+long-float long-reg complex-single-reg complex-double-reg #!+long-float complex-long-reg) (descriptor-reg)) @@ -2046,9 +2046,9 @@ (defknown ((setf floating-point-modes)) (float-modes) float-modes) -(defconstant npx-env-size (* 7 n-word-bytes)) -(defconstant npx-cw-offset 0) -(defconstant npx-sw-offset 4) +(def!constant npx-env-size (* 7 n-word-bytes)) +(def!constant npx-cw-offset 0) +(def!constant npx-sw-offset 4) (define-vop (floating-point-modes) (:results (res :scs (unsigned-reg))) @@ -4013,8 +4013,6 @@ ;; Perhaps this is OK because of the #!+LONG-FLOAT wrapped around ;; an enormous PROGN above. Still, it would be probably be good to ;; add some code to warn about redefining VOPs. - ;; FIXME 2: See comments on DEFINE-VOP FLOG1P :GUARD above. - (:guard #!+pentium nil #!-pentium t) (:note "inline log1p function") (:ignore temp) (:generator 5 @@ -4068,8 +4066,7 @@ (:arg-types long-float) (:result-types long-float) (:policy :fast-safe) - ;; FIXME: See comments on DEFINE-VOP FLOG1P :GUARD above. - (:guard #!+pentium t #!-pentium) + (:guard (member :pentium-style-fyl2xp1 *backend-subfeatures*)) (:note "inline log1p function") (:generator 5 (sc-case x