Skip to content
Snippets Groups Projects
Commit 5f50b48d authored by dtc's avatar dtc
Browse files

Adjust the complex-single-reg SC which for now only uses the even

single registers as the instruction scheduler in not informed about
the usage of the odd FP registers.

Enhancements for the complex-float VOPs:
1. Better coding of the creation of complex floats with a destination
   on the stack.
2. Realpart and imagpart part can now load directly from the stack
   saving an unnecessary load.
parent 41a279db
Branches
Tags
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -145,7 +145,7 @@
:offset (tn-offset x))) :offset (tn-offset x)))
(defun complex-single-reg-imag-tn (x) (defun complex-single-reg-imag-tn (x)
(make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*) (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) (defun complex-double-reg-real-tn (x)
(make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*) (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*)
...@@ -157,19 +157,21 @@ ...@@ -157,19 +157,21 @@
(define-move-function (load-complex-single 2) (vop x y) (define-move-function (load-complex-single 2) (vop x y)
((complex-single-stack) (complex-single-reg)) ((complex-single-stack) (complex-single-reg))
(let ((real-tn (complex-single-reg-real-tn y))) (let ((nfp (current-nfp-tn vop))
(inst ldf real-tn (current-nfp-tn vop) (* (tn-offset x) vm:word-bytes))) (offset (* (tn-offset x) vm:word-bytes)))
(let ((imag-tn (complex-single-reg-imag-tn y))) (let ((real-tn (complex-single-reg-real-tn y)))
(inst ldf imag-tn (current-nfp-tn vop) (* (1+ (tn-offset x)) (inst ldf real-tn nfp offset))
vm:word-bytes)))) (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) (define-move-function (store-complex-single 2) (vop x y)
((complex-single-reg) (complex-single-stack)) ((complex-single-reg) (complex-single-stack))
(let ((real-tn (complex-single-reg-real-tn x))) (let ((nfp (current-nfp-tn vop))
(inst stf real-tn (current-nfp-tn vop) (* (tn-offset y) vm:word-bytes))) (offset (* (tn-offset y) vm:word-bytes)))
(let ((imag-tn (complex-single-reg-imag-tn x))) (let ((real-tn (complex-single-reg-real-tn x)))
(inst stf imag-tn (current-nfp-tn vop) (* (1+ (tn-offset y)) (inst stf real-tn nfp offset))
vm:word-bytes)))) (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) (define-move-function (load-complex-double 4) (vop x y)
...@@ -780,85 +782,118 @@ ...@@ -780,85 +782,118 @@
(define-vop (make-complex-single-float) (define-vop (make-complex-single-float)
(:translate complex) (:translate complex)
(:args (x :scs (single-reg) :target r) (:args (real :scs (single-reg) :target r)
(y :scs (single-reg) :to :save)) (imag :scs (single-reg) :to :save))
(:arg-types single-float single-float) (: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) (:result-types complex-single-float)
(:note "inline complex single-float creation") (:note "inline complex single-float creation")
(:policy :fast-safe) (:policy :fast-safe)
(:vop-var vop)
(:generator 5 (:generator 5
(let ((r-real (complex-single-reg-real-tn r))) (sc-case r
(unless (location= x r-real) (complex-single-reg
(inst fmovs r-real x))) (let ((r-real (complex-single-reg-real-tn r)))
(let ((r-imag (complex-single-reg-imag-tn r))) (unless (location= real r-real)
(unless (location= y r-imag) (inst fmovs r-real real)))
(inst fmovs r-imag y))))) (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) (define-vop (make-complex-double-float)
(:translate complex) (:translate complex)
(:args (x :scs (double-reg) :target r) (:args (real :scs (double-reg) :target r)
(y :scs (double-reg) :to :save)) (imag :scs (double-reg) :to :save))
(:arg-types double-float double-float) (: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) (:result-types complex-double-float)
(:note "inline complex double-float creation") (:note "inline complex double-float creation")
(:policy :fast-safe) (:policy :fast-safe)
(:vop-var vop)
(:generator 5 (:generator 5
(let ((r-real (complex-double-reg-real-tn r))) (sc-case r
(unless (location= x r-real) (complex-double-reg
(move-double-reg r-real x))) (let ((r-real (complex-double-reg-real-tn r)))
(let ((r-imag (complex-double-reg-imag-tn r))) (unless (location= real r-real)
(unless (location= y r-imag) (move-double-reg r-real real)))
(move-double-reg r-imag y))))) (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) (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) (:arg-types complex-single-float)
(:results (r :scs (single-reg))) (:results (r :scs (single-reg)))
(:result-types single-float) (:result-types single-float)
(:variant-vars offset) (:variant-vars slot)
(:policy :fast-safe) (:policy :fast-safe)
(:vop-var vop)
(:generator 3 (:generator 3
(let ((value-tn (make-random-tn :kind :normal (sc-case x
:sc (sc-or-lose 'single-reg *backend*) (complex-single-reg
:offset (+ offset (tn-offset x))))) (let ((value-tn (ecase slot
(unless (location= value-tn r) (:real (complex-single-reg-real-tn x))
(inst fmovs r value-tn))))) (: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) (define-vop (realpart/complex-single-float complex-single-float-value)
(:translate realpart) (:translate realpart)
(:note "complex single float realpart") (:note "complex single float realpart")
(:variant 0)) (:variant :real))
(define-vop (imagpart/complex-single-float complex-single-float-value) (define-vop (imagpart/complex-single-float complex-single-float-value)
(:translate imagpart) (:translate imagpart)
(:note "complex single float imagpart") (:note "complex single float imagpart")
(:variant 1)) (:variant :imag))
(define-vop (complex-double-float-value) (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) (:arg-types complex-double-float)
(:results (r :scs (double-reg))) (:results (r :scs (double-reg)))
(:result-types double-float) (:result-types double-float)
(:variant-vars offset) (:variant-vars slot)
(:policy :fast-safe) (:policy :fast-safe)
(:vop-var vop)
(:generator 3 (:generator 3
(let ((value-tn (make-random-tn :kind :normal (sc-case x
:sc (sc-or-lose 'double-reg *backend*) (complex-double-reg
:offset (+ offset (tn-offset x))))) (let ((value-tn (ecase slot
(unless (location= value-tn r) (:real (complex-double-reg-real-tn x))
(move-double-reg r value-tn))))) (: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) (define-vop (realpart/complex-double-float complex-double-float-value)
(:translate realpart) (:translate realpart)
(:note "complex double float realpart") (:note "complex double float realpart")
(:variant 0)) (:variant :real))
(define-vop (imagpart/complex-double-float complex-double-float-value) (define-vop (imagpart/complex-double-float complex-double-float-value)
(:translate imagpart) (:translate imagpart)
(:note "complex double float imagpart") (:note "complex double float imagpart")
(:variant 2)) (:variant :imag))
) ; progn complex-float ) ; progn complex-float
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -214,8 +214,6 @@
;; Non-Descriptor single-floats. ;; Non-Descriptor single-floats.
(single-reg float-registers (single-reg float-registers
:locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) :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 () :constant-scs ()
:save-p t :save-p t
:alternate-scs (single-stack)) :alternate-scs (single-stack))
...@@ -223,16 +221,15 @@ ...@@ -223,16 +221,15 @@
;; Non-Descriptor double-floats. ;; Non-Descriptor double-floats.
(double-reg float-registers (double-reg float-registers
:locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) :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 () :constant-scs ()
:save-p t :save-p t
:alternate-scs (double-stack)) :alternate-scs (double-stack))
#+complex-float #+complex-float
(complex-single-reg float-registers (complex-single-reg float-registers
:locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30) :locations (0 4 8 12 16 20 24 28)
:element-size 2 :element-size 4
:constant-scs () :constant-scs ()
:save-p t :save-p t
:alternate-scs (complex-single-stack)) :alternate-scs (complex-single-stack))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment