diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index 1fdbfe3b4a350b098bd77d4602afbbf6eef5b864..cebddb00a63d42d864fe353e68ac670a2918c973 100644 --- a/compiler/sparc/float.lisp +++ b/compiler/sparc/float.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.21 1998/03/10 21:53:11 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.22 1998/03/11 17:11:35 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -145,7 +145,7 @@ :offset (tn-offset x))) (defun complex-single-reg-imag-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*) - :offset (1+ (tn-offset x)))) + :offset (+ (tn-offset x) 2))) (defun complex-double-reg-real-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*) @@ -157,19 +157,21 @@ (define-move-function (load-complex-single 2) (vop x y) ((complex-single-stack) (complex-single-reg)) - (let ((real-tn (complex-single-reg-real-tn y))) - (inst ldf real-tn (current-nfp-tn vop) (* (tn-offset x) vm:word-bytes))) - (let ((imag-tn (complex-single-reg-imag-tn y))) - (inst ldf imag-tn (current-nfp-tn vop) (* (1+ (tn-offset x)) - vm:word-bytes)))) + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset x) vm:word-bytes))) + (let ((real-tn (complex-single-reg-real-tn y))) + (inst ldf real-tn nfp offset)) + (let ((imag-tn (complex-single-reg-imag-tn y))) + (inst ldf imag-tn nfp (+ offset vm:word-bytes))))) (define-move-function (store-complex-single 2) (vop x y) ((complex-single-reg) (complex-single-stack)) - (let ((real-tn (complex-single-reg-real-tn x))) - (inst stf real-tn (current-nfp-tn vop) (* (tn-offset y) vm:word-bytes))) - (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst stf imag-tn (current-nfp-tn vop) (* (1+ (tn-offset y)) - vm:word-bytes)))) + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset y) vm:word-bytes))) + (let ((real-tn (complex-single-reg-real-tn x))) + (inst stf real-tn nfp offset)) + (let ((imag-tn (complex-single-reg-imag-tn x))) + (inst stf imag-tn nfp (+ offset vm:word-bytes))))) (define-move-function (load-complex-double 4) (vop x y) @@ -780,85 +782,118 @@ (define-vop (make-complex-single-float) (:translate complex) - (:args (x :scs (single-reg) :target r) - (y :scs (single-reg) :to :save)) + (:args (real :scs (single-reg) :target r) + (imag :scs (single-reg) :to :save)) (:arg-types single-float single-float) - (:results (r :scs (complex-single-reg) :from (:argument 0))) + (:results (r :scs (complex-single-reg) :from (:argument 0) + :load-if (not (sc-is r complex-single-stack)))) (:result-types complex-single-float) (:note "inline complex single-float creation") (:policy :fast-safe) + (:vop-var vop) (:generator 5 - (let ((r-real (complex-single-reg-real-tn r))) - (unless (location= x r-real) - (inst fmovs r-real x))) - (let ((r-imag (complex-single-reg-imag-tn r))) - (unless (location= y r-imag) - (inst fmovs r-imag y))))) + (sc-case r + (complex-single-reg + (let ((r-real (complex-single-reg-real-tn r))) + (unless (location= real r-real) + (inst fmovs r-real real))) + (let ((r-imag (complex-single-reg-imag-tn r))) + (unless (location= imag r-imag) + (inst fmovs r-imag imag)))) + (complex-single-stack + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset r) vm:word-bytes))) + (inst stf real nfp offset) + (inst stf imag nfp (+ offset vm:word-bytes))))))) (define-vop (make-complex-double-float) (:translate complex) - (:args (x :scs (double-reg) :target r) - (y :scs (double-reg) :to :save)) + (:args (real :scs (double-reg) :target r) + (imag :scs (double-reg) :to :save)) (:arg-types double-float double-float) - (:results (r :scs (complex-double-reg) :from (:argument 0))) + (:results (r :scs (complex-double-reg) :from (:argument 0) + :load-if (not (sc-is r complex-double-stack)))) (:result-types complex-double-float) (:note "inline complex double-float creation") (:policy :fast-safe) + (:vop-var vop) (:generator 5 - (let ((r-real (complex-double-reg-real-tn r))) - (unless (location= x r-real) - (move-double-reg r-real x))) - (let ((r-imag (complex-double-reg-imag-tn r))) - (unless (location= y r-imag) - (move-double-reg r-imag y))))) - + (sc-case r + (complex-double-reg + (let ((r-real (complex-double-reg-real-tn r))) + (unless (location= real r-real) + (move-double-reg r-real real))) + (let ((r-imag (complex-double-reg-imag-tn r))) + (unless (location= imag r-imag) + (move-double-reg r-imag imag)))) + (complex-double-stack + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset r) vm:word-bytes))) + (inst stdf real nfp offset) + (inst stdf imag nfp (+ offset (* 2 vm:word-bytes)))))))) (define-vop (complex-single-float-value) - (:args (x :scs (complex-single-reg) :target r)) + (:args (x :scs (complex-single-reg) :target r + :load-if (not (sc-is x complex-single-stack)))) (:arg-types complex-single-float) (:results (r :scs (single-reg))) (:result-types single-float) - (:variant-vars offset) + (:variant-vars slot) (:policy :fast-safe) + (:vop-var vop) (:generator 3 - (let ((value-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'single-reg *backend*) - :offset (+ offset (tn-offset x))))) - (unless (location= value-tn r) - (inst fmovs r value-tn))))) + (sc-case x + (complex-single-reg + (let ((value-tn (ecase slot + (:real (complex-single-reg-real-tn x)) + (:imag (complex-single-reg-imag-tn x))))) + (unless (location= value-tn r) + (inst fmovs r value-tn)))) + (complex-single-stack + (inst ldf r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 1)) + (tn-offset x)) + vm:word-bytes)))))) (define-vop (realpart/complex-single-float complex-single-float-value) (:translate realpart) (:note "complex single float realpart") - (:variant 0)) + (:variant :real)) (define-vop (imagpart/complex-single-float complex-single-float-value) (:translate imagpart) (:note "complex single float imagpart") - (:variant 1)) + (:variant :imag)) (define-vop (complex-double-float-value) - (:args (x :scs (complex-double-reg) :target r)) + (:args (x :scs (complex-double-reg) :target r + :load-if (not (sc-is x complex-double-stack)))) (:arg-types complex-double-float) (:results (r :scs (double-reg))) (:result-types double-float) - (:variant-vars offset) + (:variant-vars slot) (:policy :fast-safe) + (:vop-var vop) (:generator 3 - (let ((value-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg *backend*) - :offset (+ offset (tn-offset x))))) - (unless (location= value-tn r) - (move-double-reg r value-tn))))) + (sc-case x + (complex-double-reg + (let ((value-tn (ecase slot + (:real (complex-double-reg-real-tn x)) + (:imag (complex-double-reg-imag-tn x))))) + (unless (location= value-tn r) + (move-double-reg r value-tn)))) + (complex-double-stack + (inst lddf r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 2)) + (tn-offset x)) + vm:word-bytes)))))) (define-vop (realpart/complex-double-float complex-double-float-value) (:translate realpart) (:note "complex double float realpart") - (:variant 0)) + (:variant :real)) (define-vop (imagpart/complex-double-float complex-double-float-value) (:translate imagpart) (:note "complex double float imagpart") - (:variant 2)) + (:variant :imag)) ) ; progn complex-float diff --git a/compiler/sparc/vm.lisp b/compiler/sparc/vm.lisp index 8ecd0a77009476709ff56811b39821a21b9d5f51..cd232b981171a57949b008d5eaa290c44eee1e3d 100644 --- a/compiler/sparc/vm.lisp +++ b/compiler/sparc/vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.10 1998/03/11 17:00:24 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.11 1998/03/11 17:11:37 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -214,8 +214,6 @@ ;; Non-Descriptor single-floats. (single-reg float-registers :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) - ;; ### Note: We really should have every location listed, but then we - ;; would have to make load-tns work with element-sizes other than 1. :constant-scs () :save-p t :alternate-scs (single-stack)) @@ -223,16 +221,15 @@ ;; Non-Descriptor double-floats. (double-reg float-registers :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) - ;; ### Note: load-tns don't work with an element-size other than 1. - ;; :element-size 2 :alignment 2 + :element-size 2 :alignment 2 :constant-scs () :save-p t :alternate-scs (double-stack)) #+complex-float (complex-single-reg float-registers - :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) - :element-size 2 + :locations (0 4 8 12 16 20 24 28) + :element-size 4 :constant-scs () :save-p t :alternate-scs (complex-single-stack))