X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Ffloat.lisp;h=dba65bd2d63123fa1f26fd5dd9f44fee7daff803;hb=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;hp=fd42addf01e223ebfb283913ed95d97d9b276243;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git diff --git a/src/compiler/alpha/float.lisp b/src/compiler/alpha/float.lisp index fd42add..dba65bd 100644 --- a/src/compiler/alpha/float.lisp +++ b/src/compiler/alpha/float.lisp @@ -13,30 +13,29 @@ ;;;; float move functions -(define-move-function (load-fp-zero 1) (vop x y) +(define-move-fun (load-fp-zero 1) (vop x y) ((fp-single-zero) (single-reg) (fp-double-zero) (double-reg)) (inst fmove x y)) -(define-move-function (load-single 1) (vop x y) +(define-move-fun (load-single 1) (vop x y) ((single-stack) (single-reg)) - (inst lds y (* (tn-offset x) word-bytes) (current-nfp-tn vop))) + (inst lds y (* (tn-offset x) n-word-bytes) (current-nfp-tn vop))) -(define-move-function (store-single 1) (vop x y) +(define-move-fun (store-single 1) (vop x y) ((single-reg) (single-stack)) - (inst sts x (* (tn-offset y) word-bytes) (current-nfp-tn vop))) + (inst sts x (* (tn-offset y) n-word-bytes) (current-nfp-tn vop))) - -(define-move-function (load-double 2) (vop x y) +(define-move-fun (load-double 2) (vop x y) ((double-stack) (double-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (inst ldt y offset nfp))) -(define-move-function (store-double 2) (vop x y) +(define-move-fun (store-double 2) (vop x y) ((double-reg) (double-stack)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (inst stt x offset nfp))) ;;;; float move VOPs @@ -67,8 +66,8 @@ (:generator 13 (with-fixed-allocation (y ndescr type size) (if double-p - (inst stt x (- (* data word-bytes) other-pointer-lowtag) y) - (inst sts x (- (* data word-bytes) other-pointer-lowtag) y))))) + (inst stt x (- (* data n-word-bytes) other-pointer-lowtag) y) + (inst sts x (- (* data n-word-bytes) other-pointer-lowtag) y))))) (macrolet ((frob (name sc &rest args) `(progn @@ -78,9 +77,9 @@ (:variant ,@args)) (define-move-vop ,name :move (,sc) (descriptor-reg))))) (frob move-from-single single-reg - nil single-float-size single-float-type single-float-value-slot) + nil single-float-size single-float-widetag single-float-value-slot) (frob move-from-double double-reg - t double-float-size double-float-type double-float-value-slot)) + t double-float-size double-float-widetag double-float-value-slot)) (macrolet ((frob (name sc double-p value) `(progn @@ -90,10 +89,10 @@ (:note "pointer to float coercion") (:generator 2 ,@(if double-p - `((inst ldt y (- (* ,value word-bytes) + `((inst ldt y (- (* ,value n-word-bytes) other-pointer-lowtag) x)) - `((inst lds y (- (* ,value word-bytes) + `((inst lds y (- (* ,value n-word-bytes) other-pointer-lowtag) x))))) (define-move-vop ,name :move (descriptor-reg) (,sc))))) @@ -115,14 +114,14 @@ (unless (location= x y) (inst fmove x y))) (,stack-sc - (let ((offset (* (tn-offset y) word-bytes))) + (let ((offset (* (tn-offset y) n-word-bytes))) ,@(if double-p '((inst stt x offset nfp)) '((inst sts x offset nfp)))))))) - (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 nil) - (frob move-double-float-argument double-reg double-stack t)) + (frob move-single-float-arg single-reg single-stack nil) + (frob move-double-float-arg double-reg double-stack t)) ;;;; complex float move functions @@ -141,42 +140,42 @@ :offset (1+ (tn-offset x)))) -(define-move-function (load-complex-single 2) (vop x y) +(define-move-fun (load-complex-single 2) (vop x y) ((complex-single-stack) (complex-single-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) sb!vm:word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (let ((real-tn (complex-single-reg-real-tn y))) (inst lds real-tn offset nfp)) (let ((imag-tn (complex-single-reg-imag-tn y))) - (inst lds imag-tn (+ offset sb!vm:word-bytes) nfp)))) + (inst lds imag-tn (+ offset n-word-bytes) nfp)))) -(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 ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) sb!vm:word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-single-reg-real-tn x))) (inst sts real-tn offset nfp)) (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst sts imag-tn (+ offset sb!vm:word-bytes) nfp)))) + (inst sts imag-tn (+ offset n-word-bytes) nfp)))) -(define-move-function (load-complex-double 4) (vop x y) +(define-move-fun (load-complex-double 4) (vop x y) ((complex-double-stack) (complex-double-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) sb!vm:word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (let ((real-tn (complex-double-reg-real-tn y))) (inst ldt real-tn offset nfp)) (let ((imag-tn (complex-double-reg-imag-tn y))) - (inst ldt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp)))) + (inst ldt imag-tn (+ offset (* 2 n-word-bytes)) nfp)))) -(define-move-function (store-complex-double 4) (vop x y) +(define-move-fun (store-complex-double 4) (vop x y) ((complex-double-reg) (complex-double-stack)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) sb!vm:word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-double-reg-real-tn x))) (inst stt real-tn offset nfp)) (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst stt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp)))) + (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp)))) ;;; ;;; complex float register to register moves. @@ -229,17 +228,17 @@ (:temporary (:scs (non-descriptor-reg)) ndescr) (:note "complex single float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr sb!vm:complex-single-float-type - sb!vm:complex-single-float-size) + (with-fixed-allocation (y ndescr complex-single-float-widetag + complex-single-float-size) (let ((real-tn (complex-single-reg-real-tn x))) - (inst sts real-tn (- (* sb!vm:complex-single-float-real-slot - sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst sts real-tn (- (* complex-single-float-real-slot + n-word-bytes) + other-pointer-lowtag) y)) (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst sts imag-tn (- (* sb!vm:complex-single-float-imag-slot - sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst sts imag-tn (- (* complex-single-float-imag-slot + n-word-bytes) + other-pointer-lowtag) y))))) ;;; (define-move-vop move-from-complex-single :move @@ -251,17 +250,17 @@ (:temporary (:scs (non-descriptor-reg)) ndescr) (:note "complex double float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr sb!vm:complex-double-float-type - sb!vm:complex-double-float-size) + (with-fixed-allocation (y ndescr complex-double-float-widetag + complex-double-float-size) (let ((real-tn (complex-double-reg-real-tn x))) - (inst stt real-tn (- (* sb!vm:complex-double-float-real-slot - sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst stt real-tn (- (* complex-double-float-real-slot + n-word-bytes) + other-pointer-lowtag) y)) (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst stt imag-tn (- (* sb!vm:complex-double-float-imag-slot - sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst stt imag-tn (- (* complex-double-float-imag-slot + n-word-bytes) + other-pointer-lowtag) y))))) ;;; (define-move-vop move-from-complex-double :move @@ -276,12 +275,14 @@ (:note "pointer to complex float coercion") (:generator 2 (let ((real-tn (complex-single-reg-real-tn y))) - (inst lds real-tn (- (* complex-single-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst lds real-tn (- (* complex-single-float-real-slot + n-word-bytes) + other-pointer-lowtag) x)) (let ((imag-tn (complex-single-reg-imag-tn y))) - (inst lds imag-tn (- (* complex-single-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst lds imag-tn (- (* complex-single-float-imag-slot + n-word-bytes) + other-pointer-lowtag) x)))) (define-move-vop move-to-complex-single :move (descriptor-reg) (complex-single-reg)) @@ -292,20 +293,22 @@ (:note "pointer to complex float coercion") (:generator 2 (let ((real-tn (complex-double-reg-real-tn y))) - (inst ldt real-tn (- (* complex-double-float-real-slot sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst ldt real-tn (- (* complex-double-float-real-slot + n-word-bytes) + other-pointer-lowtag) x)) (let ((imag-tn (complex-double-reg-imag-tn y))) - (inst ldt imag-tn (- (* complex-double-float-imag-slot sb!vm:word-bytes) - sb!vm:other-pointer-lowtag) + (inst ldt imag-tn (- (* complex-double-float-imag-slot + n-word-bytes) + other-pointer-lowtag) x)))) (define-move-vop move-to-complex-double :move (descriptor-reg) (complex-double-reg)) ;;; -;;; complex float move-argument vop +;;; complex float MOVE-ARG VOP ;;; -(define-vop (move-complex-single-float-argument) +(define-vop (move-complex-single-float-arg) (:args (x :scs (complex-single-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg)))) (:results (y)) @@ -321,15 +324,15 @@ (y-imag (complex-single-reg-imag-tn y))) (inst fmove x-imag y-imag)))) (complex-single-stack - (let ((offset (* (tn-offset y) sb!vm:word-bytes))) + (let ((offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-single-reg-real-tn x))) (inst sts real-tn offset nfp)) (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst sts imag-tn (+ offset word-bytes) nfp))))))) -(define-move-vop move-complex-single-float-argument :move-argument + (inst sts imag-tn (+ offset n-word-bytes) nfp))))))) +(define-move-vop move-complex-single-float-arg :move-arg (complex-single-reg descriptor-reg) (complex-single-reg)) -(define-vop (move-complex-double-float-argument) +(define-vop (move-complex-double-float-arg) (:args (x :scs (complex-double-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg)))) (:results (y)) @@ -345,16 +348,16 @@ (y-imag (complex-double-reg-imag-tn y))) (inst fmove x-imag y-imag)))) (complex-double-stack - (let ((offset (* (tn-offset y) sb!vm:word-bytes))) + (let ((offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-double-reg-real-tn x))) (inst stt real-tn offset nfp)) (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst stt imag-tn (+ offset (* 2 word-bytes)) nfp))))))) -(define-move-vop move-complex-double-float-argument :move-argument + (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))))) +(define-move-vop move-complex-double-float-arg :move-arg (complex-double-reg descriptor-reg) (complex-double-reg)) -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (single-reg double-reg complex-single-reg complex-double-reg) (descriptor-reg)) @@ -494,13 +497,14 @@ (sc-case x (signed-reg (inst stl x - (* (tn-offset temp) sb!vm:word-bytes) + (* (tn-offset temp) + n-word-bytes) (current-nfp-tn vop)) temp) (signed-stack x)))) (inst ,ld-inst y - (* (tn-offset stack-tn) sb!vm:word-bytes) + (* (tn-offset stack-tn) n-word-bytes) (current-nfp-tn vop)) (note-this-location vop :internal-error) ,@(when single @@ -550,15 +554,15 @@ (sc-case y (signed-stack (inst stt temp - (* (tn-offset y) sb!vm:word-bytes) + (* (tn-offset y) n-word-bytes) (current-nfp-tn vop))) (signed-reg (inst stt temp (* (tn-offset stack-temp) - sb!vm:word-bytes) + n-word-bytes) (current-nfp-tn vop)) (inst ldq y - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop)))))))) (frob %unary-truncate single-reg single-float cvttq/c t) (frob %unary-truncate double-reg double-float cvttq/c) @@ -583,28 +587,28 @@ (sc-case res (single-reg (inst stl bits - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop)) (inst lds res - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop))) (single-stack (inst stl bits - (* (tn-offset res) sb!vm:word-bytes) + (* (tn-offset res) n-word-bytes) (current-nfp-tn vop))))) (signed-stack (sc-case res (single-reg (inst lds res - (* (tn-offset bits) sb!vm:word-bytes) + (* (tn-offset bits) n-word-bytes) (current-nfp-tn vop))) (single-stack (unless (location= bits res) (inst ldl temp - (* (tn-offset bits) sb!vm:word-bytes) + (* (tn-offset bits) n-word-bytes) (current-nfp-tn vop)) (inst stl temp - (* (tn-offset res) sb!vm:word-bytes) + (* (tn-offset res) n-word-bytes) (current-nfp-tn vop))))))))) (define-vop (make-double-float) @@ -623,14 +627,14 @@ (double-stack res) (double-reg temp)))) (inst stl hi-bits - (* (1+ (tn-offset stack-tn)) sb!vm:word-bytes) + (* (1+ (tn-offset stack-tn)) n-word-bytes) (current-nfp-tn vop)) (inst stl lo-bits - (* (tn-offset stack-tn) sb!vm:word-bytes) + (* (tn-offset stack-tn) n-word-bytes) (current-nfp-tn vop))) (when (sc-is res double-reg) (inst ldt res - (* (tn-offset temp) sb!vm:word-bytes) + (* (tn-offset temp) n-word-bytes) (current-nfp-tn vop))))) (define-vop (single-float-bits) @@ -651,23 +655,23 @@ (sc-case float (single-reg (inst sts float - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop)) (inst ldl bits - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop))) (single-stack (inst ldl bits - (* (tn-offset float) sb!vm:word-bytes) + (* (tn-offset float) n-word-bytes) (current-nfp-tn vop))) (descriptor-reg - (loadw bits float sb!vm:single-float-value-slot - sb!vm:other-pointer-lowtag)))) + (loadw bits float single-float-value-slot + other-pointer-lowtag)))) (signed-stack (sc-case float (single-reg (inst sts float - (* (tn-offset bits) sb!vm:word-bytes) + (* (tn-offset bits) n-word-bytes) (current-nfp-tn vop)))))))) (define-vop (double-float-high-bits) @@ -684,18 +688,18 @@ (sc-case float (double-reg (inst stt float - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop)) (inst ldl hi-bits - (* (1+ (tn-offset stack-temp)) sb!vm:word-bytes) + (* (1+ (tn-offset stack-temp)) n-word-bytes) (current-nfp-tn vop))) (double-stack (inst ldl hi-bits - (* (1+ (tn-offset float)) sb!vm:word-bytes) + (* (1+ (tn-offset float)) n-word-bytes) (current-nfp-tn vop))) (descriptor-reg - (loadw hi-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-lowtag))))) + (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) @@ -711,18 +715,18 @@ (sc-case float (double-reg (inst stt float - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop)) (inst ldl lo-bits - (* (tn-offset stack-temp) sb!vm:word-bytes) + (* (tn-offset stack-temp) n-word-bytes) (current-nfp-tn vop))) (double-stack (inst ldl lo-bits - (* (tn-offset float) sb!vm:word-bytes) + (* (tn-offset float) n-word-bytes) (current-nfp-tn vop))) (descriptor-reg - (loadw lo-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-lowtag))) + (loadw lo-bits float double-float-value-slot + other-pointer-lowtag))) (inst mskll lo-bits 4 lo-bits))) @@ -747,8 +751,8 @@ (inst excb) (inst mf_fpcr temp1 temp1 temp1) (inst excb) - (inst stt temp1 (* word-bytes (tn-offset temp)) nfp) - (inst ldl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp) + (inst stt temp1 (* n-word-bytes (tn-offset temp)) nfp) + (inst ldl res (* (1+ (tn-offset temp)) n-word-bytes) nfp) (inst srl res 49 res)))) (define-vop (set-floating-point-modes) @@ -764,9 +768,9 @@ (:generator 8 (let ((nfp (current-nfp-tn vop))) (inst sll new 49 res) - (inst stl zero-tn (* (tn-offset temp) sb!vm:word-bytes) nfp) - (inst stl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp) - (inst ldt temp1 (* (tn-offset temp) sb!vm:word-bytes) nfp) + (inst stl zero-tn (* (tn-offset temp) n-word-bytes) nfp) + (inst stl res (* (1+ (tn-offset temp)) n-word-bytes) nfp) + (inst ldt temp1 (* (tn-offset temp) n-word-bytes) nfp) (inst excb) (inst mt_fpcr temp1 temp1 temp1) (inst excb) @@ -797,9 +801,9 @@ (inst fmove imag r-imag)))) (complex-single-stack (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset r) sb!vm:word-bytes))) + (offset (* (tn-offset r) n-word-bytes))) (inst sts real offset nfp) - (inst sts imag (+ offset sb!vm:word-bytes) nfp)))))) + (inst sts imag (+ offset n-word-bytes) nfp)))))) (define-vop (make-complex-double-float) (:translate complex) @@ -823,9 +827,9 @@ (inst fmove imag r-imag)))) (complex-double-stack (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset r) sb!vm:word-bytes))) + (offset (* (tn-offset r) n-word-bytes))) (inst stt real offset nfp) - (inst stt imag (+ offset (* 2 sb!vm:word-bytes)) nfp)))))) + (inst stt imag (+ offset (* 2 n-word-bytes)) nfp)))))) (define-vop (complex-single-float-value) (:args (x :scs (complex-single-reg) :target r @@ -846,7 +850,7 @@ (inst fmove value-tn r)))) (complex-single-stack (inst lds r (* (+ (ecase slot (:real 0) (:imag 1)) (tn-offset x)) - sb!vm:word-bytes) + n-word-bytes) (current-nfp-tn vop)))))) (define-vop (realpart/complex-single-float complex-single-float-value) @@ -878,7 +882,7 @@ (inst fmove value-tn r)))) (complex-double-stack (inst ldt r (* (+ (ecase slot (:real 0) (:imag 2)) (tn-offset x)) - sb!vm:word-bytes) + n-word-bytes) (current-nfp-tn vop)))))) (define-vop (realpart/complex-double-float complex-double-float-value)