X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86%2Ffloat.lisp;h=62d186ec7ab865091a63a28b1892912068ab92fa;hb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;hp=de098774261d4f48f433d0c952580bb4d3bbad15;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index de09877..62d186e 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -14,36 +14,37 @@ (macrolet ((ea-for-xf-desc (tn slot) `(make-ea :dword :base ,tn - :disp (- (* ,slot sb!vm:word-bytes) sb!vm:other-pointer-type)))) + :disp (- (* ,slot n-word-bytes) + other-pointer-lowtag)))) (defun ea-for-sf-desc (tn) - (ea-for-xf-desc tn sb!vm:single-float-value-slot)) + (ea-for-xf-desc tn single-float-value-slot)) (defun ea-for-df-desc (tn) - (ea-for-xf-desc tn sb!vm:double-float-value-slot)) + (ea-for-xf-desc tn double-float-value-slot)) #!+long-float (defun ea-for-lf-desc (tn) - (ea-for-xf-desc tn sb!vm:long-float-value-slot)) + (ea-for-xf-desc tn long-float-value-slot)) ;; complex floats (defun ea-for-csf-real-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-single-float-real-slot)) + (ea-for-xf-desc tn complex-single-float-real-slot)) (defun ea-for-csf-imag-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-single-float-imag-slot)) + (ea-for-xf-desc tn complex-single-float-imag-slot)) (defun ea-for-cdf-real-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-double-float-real-slot)) + (ea-for-xf-desc tn complex-double-float-real-slot)) (defun ea-for-cdf-imag-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-double-float-imag-slot)) + (ea-for-xf-desc tn complex-double-float-imag-slot)) #!+long-float (defun ea-for-clf-real-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-long-float-real-slot)) + (ea-for-xf-desc tn complex-long-float-real-slot)) #!+long-float (defun ea-for-clf-imag-desc (tn) - (ea-for-xf-desc tn sb!vm:complex-long-float-imag-slot))) + (ea-for-xf-desc tn complex-long-float-imag-slot))) (macrolet ((ea-for-xf-stack (tn kind) `(make-ea :dword :base ebp-tn :disp (- (* (+ (tn-offset ,tn) (ecase ,kind (:single 1) (:double 2) (:long 3))) - sb!vm:word-bytes))))) + n-word-bytes))))) (defun ea-for-sf-stack (tn) (ea-for-xf-stack tn :single)) (defun ea-for-df-stack (tn) @@ -77,7 +78,7 @@ (:double 2) (:long 3)) (ecase ,slot (:real 1) (:imag 2)))) - sb!vm:word-bytes))))) + n-word-bytes))))) (defun ea-for-csf-real-stack (tn &optional (base ebp-tn)) (ea-for-cxf-stack tn :single :real base)) (defun ea-for-csf-imag-stack (tn &optional (base ebp-tn)) @@ -387,8 +388,8 @@ (:note "float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:single-float-type - sb!vm:single-float-size node) + single-float-widetag + single-float-size node) (with-tn@fp-top(x) (inst fst (ea-for-sf-desc y)))))) (define-move-vop move-from-single :move @@ -401,8 +402,8 @@ (:note "float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:double-float-type - sb!vm:double-float-size + double-float-widetag + double-float-size node) (with-tn@fp-top(x) (inst fstd (ea-for-df-desc y)))))) @@ -417,8 +418,8 @@ (:note "float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:long-float-type - sb!vm:long-float-size + long-float-widetag + long-float-size node) (with-tn@fp-top(x) (store-long-float (ea-for-lf-desc y)))))) @@ -493,8 +494,9 @@ (:note "complex float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:complex-single-float-type - sb!vm:complex-single-float-size node) + 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)))) @@ -511,8 +513,8 @@ (:note "complex float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:complex-double-float-type - sb!vm:complex-double-float-size + complex-double-float-widetag + complex-double-float-size node) (let ((real-tn (complex-double-reg-real-tn x))) (with-tn@fp-top(real-tn) @@ -531,8 +533,8 @@ (:note "complex float to pointer coercion") (:generator 13 (with-fixed-allocation (y - sb!vm:complex-long-float-type - sb!vm:complex-long-float-size + complex-long-float-widetag + complex-long-float-size node) (let ((real-tn (complex-long-reg-real-tn x))) (with-tn@fp-top(real-tn) @@ -600,7 +602,7 @@ (inst fxch x))))) (,stack-sc (if (= (tn-offset fp) esp-offset) - (let* ((offset (* (tn-offset y) word-bytes)) + (let* ((offset (* (tn-offset y) n-word-bytes)) (ea (make-ea :dword :base fp :disp offset))) (with-tn@fp-top(x) ,@(ecase format @@ -615,7 +617,7 @@ (:single 1) (:double 2) (:long 3))) - sb!vm:word-bytes))))) + n-word-bytes))))) (with-tn@fp-top(x) ,@(ecase format (:single '((inst fst ea))) @@ -1849,7 +1851,7 @@ (storew lo-bits ebp-tn (- (1+ offset))) (with-empty-tn@fp-top(res) (inst fldd (make-ea :dword :base ebp-tn - :disp (- (* (1+ offset) word-bytes)))))))) + :disp (- (* (1+ offset) n-word-bytes)))))))) #!+long-float (define-vop (make-long-float) @@ -1870,7 +1872,7 @@ (storew lo-bits ebp-tn (- (+ offset 2))) (with-empty-tn@fp-top(res) (inst fldl (make-ea :dword :base ebp-tn - :disp (- (* (+ offset 2) word-bytes)))))))) + :disp (- (* (+ offset 2) n-word-bytes)))))))) (define-vop (single-float-bits) (:args (float :scs (single-reg descriptor-reg) @@ -1894,8 +1896,8 @@ (inst mov bits float)) (descriptor-reg (loadw - bits float sb!vm:single-float-value-slot - sb!vm:other-pointer-type)))) + bits float single-float-value-slot + other-pointer-lowtag)))) (signed-stack (sc-case float (single-reg @@ -1918,14 +1920,14 @@ (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn :disp (- (* (+ 2 (tn-offset temp)) - word-bytes))))) + n-word-bytes))))) (inst fstd where))) (loadw hi-bits ebp-tn (- (1+ (tn-offset temp))))) (double-stack (loadw hi-bits ebp-tn (- (1+ (tn-offset float))))) (descriptor-reg - (loadw hi-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-type))))) + (loadw hi-bits float (1+ double-float-value-slot) + other-pointer-lowtag))))) (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) @@ -1943,14 +1945,14 @@ (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn :disp (- (* (+ 2 (tn-offset temp)) - word-bytes))))) + n-word-bytes))))) (inst fstd where))) (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp))))) (double-stack (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) (descriptor-reg - (loadw lo-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-type))))) + (loadw lo-bits float double-float-value-slot + other-pointer-lowtag))))) #!+long-float (define-vop (long-float-exp-bits) @@ -1969,21 +1971,21 @@ (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn :disp (- (* (+ 3 (tn-offset temp)) - word-bytes))))) + n-word-bytes))))) (store-long-float where))) (inst movsx exp-bits (make-ea :word :base ebp-tn - :disp (* (- (1+ (tn-offset temp))) word-bytes)))) + :disp (* (- (1+ (tn-offset temp))) n-word-bytes)))) (long-stack (inst movsx exp-bits (make-ea :word :base ebp-tn - :disp (* (- (1+ (tn-offset float))) word-bytes)))) + :disp (* (- (1+ (tn-offset float))) n-word-bytes)))) (descriptor-reg (inst movsx exp-bits (make-ea :word :base float - :disp (- (* (+ 2 sb!vm:long-float-value-slot) - word-bytes) - sb!vm:other-pointer-type))))))) + :disp (- (* (+ 2 long-float-value-slot) + n-word-bytes) + other-pointer-lowtag))))))) #!+long-float (define-vop (long-float-high-bits) @@ -2002,14 +2004,14 @@ (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn :disp (- (* (+ 3 (tn-offset temp)) - word-bytes))))) + n-word-bytes))))) (store-long-float where))) (loadw hi-bits ebp-tn (- (+ (tn-offset temp) 2)))) (long-stack (loadw hi-bits ebp-tn (- (+ (tn-offset float) 2)))) (descriptor-reg - (loadw hi-bits float (1+ sb!vm:long-float-value-slot) - sb!vm:other-pointer-type))))) + (loadw hi-bits float (1+ long-float-value-slot) + other-pointer-lowtag))))) #!+long-float (define-vop (long-float-low-bits) @@ -2028,14 +2030,14 @@ (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn :disp (- (* (+ 3 (tn-offset temp)) - word-bytes))))) + n-word-bytes))))) (store-long-float where))) (loadw lo-bits ebp-tn (- (+ (tn-offset temp) 3)))) (long-stack (loadw lo-bits ebp-tn (- (+ (tn-offset float) 3)))) (descriptor-reg - (loadw lo-bits float sb!vm:long-float-value-slot - sb!vm:other-pointer-type))))) + (loadw lo-bits float long-float-value-slot + other-pointer-lowtag))))) ;;;; float mode hackery @@ -2044,7 +2046,7 @@ (defknown ((setf floating-point-modes)) (float-modes) float-modes) -(defconstant npx-env-size (* 7 sb!vm:word-bytes)) +(defconstant npx-env-size (* 7 n-word-bytes)) (defconstant npx-cw-offset 0) (defconstant npx-sw-offset 4) @@ -2928,12 +2930,6 @@ (:arg-types double-float) (:result-types double-float) (:policy :fast-safe) - ;; FIXME: PENTIUM isn't used on the *FEATURES* list of the CMU CL I based - ;; SBCL on, even when it is running on a Pentium. Find out what's going - ;; on here and see what the proper value should be. (Perhaps just use the - ;; apparently-conservative value of T always?) For more confusion, see also - ;; apparently-reversed-sense test for the FLOG1P-PENTIUM vop below. - (:guard #!+pentium nil #!-pentium t) (:note "inline log1p function") (:ignore temp) (:generator 5 @@ -2987,12 +2983,11 @@ (:arg-types double-float) (:result-types double-float) (:policy :fast-safe) - ;; FIXME: See comments on DEFINE-VOP FLOG1P :GUARD above. - (:guard #!+pentium t #!-pentium nil) + (:guard (member :pentium-style-fyl2xp1 *backend-subfeatures*)) (:note "inline log1p with limited x range function") (:vop-var vop) (:save-p :compute-only) - (:generator 5 + (:generator 4 (note-this-location vop :internal-error) (sc-case x (double-reg