X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Ffloat.lisp;h=4f33837f5e610acc2a49e3c3c5ac167265db971f;hb=f9ef8b045b60ae064c7bd40af599b46707ea4d8a;hp=67eff15f7b35219abb9491292f2fed34e66af983;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git diff --git a/src/compiler/alpha/float.lisp b/src/compiler/alpha/float.lisp index 67eff15..4f33837 100644 --- a/src/compiler/alpha/float.lisp +++ b/src/compiler/alpha/float.lisp @@ -13,27 +13,26 @@ ;;;; 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) 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) 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) 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) n-word-bytes))) @@ -119,10 +118,10 @@ ,@(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,7 +140,7 @@ :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) n-word-bytes))) @@ -150,7 +149,7 @@ (let ((imag-tn (complex-single-reg-imag-tn y))) (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) n-word-bytes))) @@ -160,7 +159,7 @@ (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) n-word-bytes))) @@ -169,7 +168,7 @@ (let ((imag-tn (complex-double-reg-imag-tn y))) (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) n-word-bytes))) @@ -307,9 +306,9 @@ (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)) @@ -330,10 +329,10 @@ (inst sts real-tn offset nfp)) (let ((imag-tn (complex-single-reg-imag-tn x))) (inst sts imag-tn (+ offset n-word-bytes) nfp))))))) -(define-move-vop move-complex-single-float-argument :move-argument +(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)) @@ -354,11 +353,11 @@ (inst stt real-tn offset nfp)) (let ((imag-tn (complex-double-reg-imag-tn x))) (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))))) -(define-move-vop move-complex-double-float-argument :move-argument +(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)) @@ -479,13 +478,15 @@ ;;;; float conversion (macrolet - ((frob (name translate inst ld-inst to-sc to-type &optional single) - (declare (ignorable single)) + ((frob (name translate inst ld-inst to-sc to-type) `(define-vop (,name) (:args (x :scs (signed-reg) :target temp :load-if (not (sc-is x signed-stack)))) - (:temporary (:scs (single-stack)) temp) - (:results (y :scs (,to-sc))) + (:temporary (:scs (,to-sc)) freg1) + (:temporary (:scs (,to-sc)) freg2) + (:temporary (:scs (single-stack)) temp) + + (:results (y :scs (,to-sc))) (:arg-types signed-num) (:result-types ,to-type) (:policy :fast-safe) @@ -504,71 +505,78 @@ temp) (signed-stack x)))) - (inst ,ld-inst y + (inst ,ld-inst freg1 (* (tn-offset stack-tn) n-word-bytes) (current-nfp-tn vop)) (note-this-location vop :internal-error) - ,@(when single - `((inst cvtlq y y))) - (inst ,inst y y)))))) - (frob %single-float/signed %single-float cvtqs lds single-reg single-float t) - (frob %double-float/signed %double-float cvtqt lds double-reg double-float t)) - + (inst cvtlq freg1 freg2) + (inst ,inst freg2 y) + (inst excb) + ))))) + (frob %single-float/signed %single-float cvtqs_sui lds single-reg single-float) + (frob %double-float/signed %double-float cvtqt_sui lds double-reg double-float)) + +;;; see previous comment about software trap handlers: also applies here (macrolet ((frob (name translate inst from-sc from-type to-sc to-type) `(define-vop (,name) - (:args (x :scs (,from-sc))) - (:results (y :scs (,to-sc))) - (:arg-types ,from-type) - (:result-types ,to-type) - (:policy :fast-safe) - (:note "inline float coercion") - (:translate ,translate) - (:vop-var vop) - (:save-p :compute-only) - (:generator 2 - (note-this-location vop :internal-error) - (inst ,inst x y))))) - (frob %single-float/double-float %single-float cvtts - double-reg double-float single-reg single-float) + (:args (x :scs (,from-sc))) + (:results (y :scs (,to-sc) :from :load)) + (:arg-types ,from-type) + (:result-types ,to-type) + (:policy :fast-safe) + (:note "inline float coercion") + (:translate ,translate) + (:vop-var vop) + (:save-p :compute-only) + (:generator 2 + (note-this-location vop :internal-error) + (inst ,inst x y) + (inst excb) + )))) + (frob %single-float/double-float %single-float cvtts_su + double-reg double-float single-reg single-float) (frob %double-float/single-float %double-float fmove - single-reg single-float double-reg double-float)) + single-reg single-float double-reg double-float)) (macrolet ((frob (trans from-sc from-type inst &optional single) - (declare (ignorable single)) - `(define-vop (,(symbolicate trans "/" from-type)) - (:args (x :scs (,from-sc) :target temp)) - (:temporary (:from (:argument 0) :sc single-reg) temp) - (:temporary (:scs (signed-stack)) stack-temp) - (:results (y :scs (signed-reg) - :load-if (not (sc-is y signed-stack)))) - (:arg-types ,from-type) - (:result-types signed-num) - (:translate ,trans) - (:policy :fast-safe) - (:note "inline float truncate") - (:vop-var vop) - (:save-p :compute-only) - (:generator 5 - (note-this-location vop :internal-error) - (inst ,inst x temp) - (sc-case y - (signed-stack - (inst stt temp - (* (tn-offset y) n-word-bytes) - (current-nfp-tn vop))) - (signed-reg - (inst stt temp - (* (tn-offset stack-temp) - n-word-bytes) - (current-nfp-tn vop)) - (inst ldq y - (* (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) - (frob %unary-round single-reg single-float cvttq t) - (frob %unary-round double-reg double-float cvttq)) + (declare (ignorable single)) + `(define-vop (,(symbolicate trans "/" from-type)) + (:args (x :scs (,from-sc) :target temp)) + (:temporary (:from :load ;(:argument 0) + :sc single-reg) temp) + (:temporary (:scs (signed-stack)) stack-temp) + (:results (y :scs (signed-reg) + :load-if (not (sc-is y signed-stack)))) + (:arg-types ,from-type) + (:result-types signed-num) + (:translate ,trans) + (:policy :fast-safe) + (:note "inline float truncate") + (:vop-var vop) + (:save-p :compute-only) + (:generator 5 + (note-this-location vop :internal-error) + (inst ,inst x temp) + (sc-case y + (signed-stack + (inst stt temp + (* (tn-offset y) n-word-bytes) + (current-nfp-tn vop))) + (signed-reg + (inst stt temp + (* (tn-offset stack-temp) + n-word-bytes) + (current-nfp-tn vop)) + (inst ldq y + (* (tn-offset stack-temp) n-word-bytes) + (current-nfp-tn vop)))) + (inst excb) + )))) + (frob %unary-truncate single-reg single-float cvttq/c_sv t) + (frob %unary-truncate double-reg double-float cvttq/c_sv) + (frob %unary-round single-reg single-float cvttq_sv t) + (frob %unary-round double-reg double-float cvttq_sv)) (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res @@ -731,51 +739,7 @@ (inst mskll lo-bits 4 lo-bits))) -;;;; float mode hackery - -(sb!xc:deftype float-modes () '(unsigned-byte 32)) ;actually 24 -dan -(defknown floating-point-modes () float-modes (flushable)) -(defknown ((setf floating-point-modes)) (float-modes) - float-modes) - -;;; Modes bits are (byte 12 52) of fpcr. Grab and return in low bits. -(define-vop (floating-point-modes) - (:results (res :scs (unsigned-reg))) - (:result-types unsigned-num) - (:translate floating-point-modes) - (:policy :fast-safe) - (:vop-var vop) - (:temporary (:sc double-stack) temp) - (:temporary (:sc double-reg) temp1) - (:generator 5 - (let ((nfp (current-nfp-tn vop))) - (inst excb) - (inst mf_fpcr temp1 temp1 temp1) - (inst excb) - (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) - (:args (new :scs (unsigned-reg) :target res)) - (:results (res :scs (unsigned-reg))) - (:arg-types unsigned-num) - (:result-types unsigned-num) - (:translate (setf floating-point-modes)) - (:policy :fast-safe) - (:temporary (:sc double-stack) temp) - (:temporary (:sc double-reg) temp1) - (:vop-var vop) - (:generator 8 - (let ((nfp (current-nfp-tn vop))) - (inst sll new 49 res) - (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) - (move res new)))) +;;;; float mode hackery has moved to alpha-vm.lisp ;;;; complex float VOPs @@ -895,3 +859,4 @@ (:translate imagpart) (:note "complex double float imagpart") (:variant :imag)) +