Skip to content
Snippets Groups Projects
Commit 64fe62c4 authored by rtoy's avatar rtoy
Browse files

Allow descriptors for COMPLEX-DOUBLE-DOUBLE-FLOAT-VALUE. This gets

rid of quite a few uneeded loads from memory because we'd the whole
complex double-double into registers and select just the real or
imaginary part.  Now we just load the 2 double-floats we want.
parent 973806d8
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.10 2007/03/27 11:33:21 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.11 2007/04/12 17:41:35 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1320,7 +1320,7 @@ ...@@ -1320,7 +1320,7 @@
(inst stfd r-imag nfp (+ offset (* 6 vm:word-bytes))))))))) (inst stfd r-imag nfp (+ offset (* 6 vm:word-bytes)))))))))
(define-vop (complex-double-double-float-value) (define-vop (complex-double-double-float-value)
(:args (x :scs (complex-double-double-reg) :target r (:args (x :scs (complex-double-double-reg descriptor-reg) :target r
:load-if (not (sc-is x complex-double-double-stack)))) :load-if (not (sc-is x complex-double-double-stack))))
(:arg-types complex-double-double-float) (:arg-types complex-double-double-float)
(:results (r :scs (double-double-reg))) (:results (r :scs (double-double-reg)))
...@@ -1351,7 +1351,20 @@ ...@@ -1351,7 +1351,20 @@
(let ((r-lo (double-double-reg-lo-tn r))) (let ((r-lo (double-double-reg-lo-tn r)))
(inst lfd r-lo (current-nfp-tn vop) (* (+ (ecase slot (:real 2) (:imag 6)) (inst lfd r-lo (current-nfp-tn vop) (* (+ (ecase slot (:real 2) (:imag 6))
(tn-offset x)) (tn-offset x))
vm:word-bytes))))))) vm:word-bytes))))
(descriptor-reg
(let ((r-hi (double-double-reg-hi-tn r)))
(inst lfd r-hi x (- (* (ecase slot
(:real vm::complex-double-double-float-real-hi-slot)
(:imag vm::complex-double-double-float-imag-hi-slot))
vm:word-bytes)
other-pointer-type)))
(let ((r-lo (double-double-reg-lo-tn r)))
(inst lfd r-lo x (- (* (ecase slot
(:real vm::complex-double-double-float-real-lo-slot)
(:imag vm::complex-double-double-float-imag-lo-slot))
vm:word-bytes)
other-pointer-type)))))))
(define-vop (realpart/complex-double-double-float complex-double-double-float-value) (define-vop (realpart/complex-double-double-float complex-double-double-float-value)
(:translate realpart) (:translate realpart)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment