From a12698c0f29580259e45aa0a3577b65ca785d301 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Sun, 2 Apr 2000 18:44:24 +0000 Subject: [PATCH] From Raymond Toy: o Add complex FP vops, enabled by the feature :complex-fp-vop. o Add VOPS for max/min of floats using conditional moves for the Sparc V9. --- compiler/sparc/float.lisp | 935 +++++++++++++++++++++++++++++++++++++- 1 file changed, 934 insertions(+), 1 deletion(-) diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index 3e8028002..499f3d973 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.28 2000/02/24 14:40:34 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.29 2000/04/02 18:44:24 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1564,3 +1564,936 @@ (:translate imagpart) (:note "complex long float imagpart") (:variant :imag)) + + + +;;;; Complex float arithmetic + +#+complex-fp-vops +(progn + +;; Negate a complex +(macrolet + ((frob (float-type fneg cost) + (let* ((vop-name (symbolicate "%NEGATE/COMPLEX-" float-type)) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-tn (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-tn (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg))) + (:arg-types ,c-type) + (:results (r :scs (,complex-reg))) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float arithmetic") + (:translate %negate) + (:generator ,cost + (let ((xr (,real-tn x)) + (xi (,imag-tn x)) + (rr (,real-tn r)) + (ri (,imag-tn r))) + (,@fneg rr xr) + (,@fneg ri xi))))))) + (frob single (inst fnegs) 4) + (frob double (negate-double-reg) 4)) + +;; Add and subtract for two complex arguments +(macrolet + ((frob (op inst float-type cost) + (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float arithmetic") + (:translate ,op) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r))) + (inst ,inst rr xr yr) + (inst ,inst ri xi yi))))))) + (frob + fadds single 4) + (frob + faddd double 4) + (frob - fsubs single 4) + (frob - fsubd double 4)) + +;; Add and subtract a complex and a float + +(macrolet + ((frob (size op fop fmov cost) + (let ((vop-name (symbolicate "COMPLEX-" size "-FLOAT-" + op + "-" size "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" size "-REG")) + (real-reg (symbolicate size "-REG")) + (c-type (symbolicate "COMPLEX-" size "-FLOAT")) + (r-type (symbolicate size "-FLOAT")) + (real-part (symbolicate "COMPLEX-" size "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,real-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,r-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float/float arithmetic") + (:translate ,op) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (inst ,fop rr xr y) + (unless (location= ri xi) + (,@fmov ri xi)))))))) + + (frob single + fadds (inst fmovs) 2) + (frob single - fsubs (inst fmovs) 2) + (frob double + faddd (move-double-reg) 4) + (frob double - fsubd (move-double-reg) 4)) + +;; Add a float and a complex +(macrolet + ((frob (size fop fmov cost) + (let ((vop-name + (symbolicate size "-FLOAT-+-COMPLEX-" size "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" size "-REG")) + (real-reg (symbolicate size "-REG")) + (c-type (symbolicate "COMPLEX-" size "-FLOAT")) + (r-type (symbolicate size "-FLOAT")) + (real-part (symbolicate "COMPLEX-" size "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (y :scs (,real-reg)) + (x :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,r-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float/float arithmetic") + (:translate +) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (inst ,fop rr xr y) + (unless (location= ri xi) + (,@fmov ri xi)))))))) + (frob single fadds (inst fmovs) 1) + (frob double faddd (move-double-reg) 2)) + +;; Subtract a complex from a float + +(macrolet + ((frob (size fop fneg cost) + (let ((vop-name (symbolicate size "-FLOAT---COMPLEX-" size "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" size "-REG")) + (real-reg (symbolicate size "-REG")) + (c-type (symbolicate "COMPLEX-" size "-FLOAT")) + (r-type (symbolicate size "-FLOAT")) + (real-part (symbolicate "COMPLEX-" size "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))) + `(define-vop (single-float---complex-single-float) + (:args (x :scs (,real-reg)) (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,r-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float/float arithmetic") + (:translate -) + (:generator ,cost + (let ((yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r))) + (inst ,fop rr x yr) + (,@fneg ri yi)))) + )) + + (frob single fsubs (inst fnegs) 2) + (frob double fsubd (negate-double-reg) 2))) + +;; Multiply two complex numbers + +#+nil +(macrolet + ((frob (size fmul fadd fsub cost) + (let ((vop-name (symbolicate "*/COMPLEX-" size "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" size "-REG")) + (real-reg (symbolicate size "-REG")) + (c-type (symbolicate "COMPLEX-" size "-FLOAT")) + (real-part (symbolicate "COMPLEX-" size "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float multiplication") + (:translate *) + (:temporary (:scs (,real-reg)) prod-1 prod-2 prod-3 prod-4) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r))) + ;; All of the temps are needed in case the result TN happens to + ;; be the same as one of the arg TN's + (inst ,fmul prod-1 xr yr) + (inst ,fmul prod-2 xi yi) + (inst ,fmul prod-3 xr yi) + (inst ,fmul prod-4 xi yr) + (inst ,fsub rr prod-1 prod-2) + (inst ,fadd ri prod-3 prod-4))))))) + + (frob single fmuls fadds fsubs 6) + (frob double fmuld faddd fsubd 6)) + +(macrolet + ((frob (size fmul fadd fsub cost) + (let ((vop-name (symbolicate "*/COMPLEX-" size "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" size "-REG")) + (real-reg (symbolicate size "-REG")) + (c-type (symbolicate "COMPLEX-" size "-FLOAT")) + (real-part (symbolicate "COMPLEX-" size "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float multiplication") + (:translate *) + (:temporary (:scs (,real-reg)) p1 p2) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r))) + (cond ((location= r x) + (inst ,fmul p1 xr yr) + (inst ,fmul p2 xr yi) + (inst ,fmul rr xi yi) + (inst ,fsub rr p1 xr) + (inst ,fmul p1 xi yr) + (inst ,fadd ri p2 p1)) + ((location= r y) + (inst ,fmul p1 yr xr) + (inst ,fmul p2 yr xi) + (inst ,fmul rr yi xi) + (inst ,fsub rr p1 rr) + (inst ,fmul p1 yi xr) + (inst ,fadd ri p2 p1)) + (t + (inst ,fmul rr yr xr) + (inst ,fmul ri xi yi) + (inst ,fsub rr rr ri) + (inst ,fmul p1 xr yi) + (inst ,fmul ri xi yr) + (inst ,fadd ri ri p1))))))))) + + (frob single fmuls fadds fsubs 6) + (frob double fmuld faddd fsubd 6)) + +;; Multiply a complex by a float. The case of float * complex is +;; handled by a deftransform to convert it to the complex*float case. +(macrolet + ((frob (float-type fmul mov cost) + (let* ((vop-name (symbolicate "COMPLEX-" + float-type + "-FLOAT-*-" + float-type + "-FLOAT")) + (vop-name-r (symbolicate float-type + "-FLOAT-*-COMPLEX-" + float-type + "-FLOAT")) + (complex-sc-type (symbolicate "COMPLEX-" float-type "-REG")) + (real-sc-type (symbolicate float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (r-type (symbolicate float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(progn + ;; Complex * float + (define-vop (,vop-name) + (:args (x :scs (,complex-sc-type)) + (y :scs (,real-sc-type))) + (:results (r :scs (,complex-sc-type))) + (:arg-types ,c-type ,r-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float arithmetic") + (:translate *) + (:temporary (:scs (,real-sc-type)) temp) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (cond ((location= y rr) + (inst ,fmul temp xr y) ; xr * y + (inst ,fmul ri xi y) ; xi * yi + (,@mov rr temp)) + (t + (inst ,fmul rr xr y) + (inst ,fmul ri xi y)))))) + ;; Float * complex + (define-vop (,vop-name-r) + (:args (y :scs (,real-sc-type)) + (x :scs (,complex-sc-type))) + (:results (r :scs (,complex-sc-type))) + (:arg-types ,r-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float arithmetic") + (:translate *) + (:temporary (:scs (,real-sc-type)) temp) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (cond ((location= y rr) + (inst ,fmul temp xr y) ; xr * y + (inst ,fmul ri xi y) ; xi * yi + (,@mov rr temp)) + (t + (inst ,fmul rr xr y) + (inst ,fmul ri xi y)))))))))) + (frob single fmuls (inst fmovs) 4) + (frob double fmuld (move-double-reg) 4)) + + +;; Divide a complex by a complex + +;; Here's how we do a complex division +;; +;; Compute (xr + i*xi)/(yr + i*yi) +;; +;; Assume |yi| < |yr|. Then +;; +;; (xr + i*xi) (xr + i*xi) +;; ----------- = ----------------- +;; (yr + i*yi) yr*(1 + i*(yi/yr)) +;; +;; (xr + i*xi)*(1 - i*(yi/yr)) +;; = --------------------------- +;; yr*(1 + (yi/yr)^2) +;; +;; (xr + (yi/yr)*xi) + i*(xi - (yi/yr)*xr) +;; = -------------------------------------- +;; yr + (yi/yr)*yi +;; +;; +;; We do the similar thing when |yi| > |yr|. The result is +;; +;; +;; (xr + i*xi) (xr + i*xi) +;; ----------- = ----------------- +;; (yr + i*yi) yi*((yr/yi) + i) +;; +;; (xr + i*xi)*((yr/yi) - i) +;; = ------------------------- +;; yi*((yr/yi)^2 + 1) +;; +;; (xr*(yr/yi) + xi) + i*(xi*(yr/yi) - xr) +;; = --------------------------------------- +;; yi + (yr/yi)*yr +;; + +#+nil +(macrolet + ((frob (float-type fcmp fadd fsub fmul fdiv fabs fmov cost) + (let ((vop-name (symbolicate "//COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-reg (symbolicate float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float division") + (:translate /) + (:temporary (:sc ,real-reg) ratio) + (:temporary (:sc ,real-reg) den) + (:temporary (:sc ,real-reg) temp-r) + (:temporary (:sc ,real-reg) temp-i) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r)) + (bigger (gen-label)) + (done (gen-label))) + (,@fabs ratio yr) + (,@fabs den yi) + (inst ,fcmp ratio den) + (unless (backend-featurep :sparc-v9) + (inst nop)) + (inst fb :ge bigger) + (inst nop) + ;; The case of |yi| <= |yr| + (inst ,fdiv ratio yi yr) ; ratio = yi/yr + (inst ,fmul den ratio yi) + (inst ,fadd den den yr) ; den = yr + (yi/yr)*yi + + (inst ,fmul temp-r ratio xi) + (inst ,fadd temp-r temp-r xr) ; temp-r = xr + (yi/yr)*xi + (inst ,fdiv temp-r temp-r den) + + (inst ,fmul temp-i ratio xr) + (inst ,fsub temp-i xi temp-i) ; temp-i = xi - (yi/yr)*xr + (inst b done) + (inst ,fdiv temp-i temp-i den) + + (emit-label bigger) + ;; The case of |yi| > |yr| + (inst ,fdiv ratio yr yi) ; ratio = yr/yi + (inst ,fmul den ratio yr) + (inst ,fadd den den yi) ; den = yi + (yr/yi)*yr + + (inst ,fmul temp-r ratio xr) + (inst ,fadd temp-r temp-r xi) ; temp-r = xi + xr*(yr/yi) + (inst ,fdiv temp-r temp-r den) + + (inst ,fmul temp-i ratio xi) + (inst ,fsub temp-i temp-i xr) ; temp-i = xi*(yr/yi) - xr + (inst ,fdiv temp-i temp-i den) + + (emit-label done) + (unless (location= temp-r rr) + (,@fmov rr temp-r)) + (unless (location= temp-i ri) + (,@fmov ri temp-i)) + )))))) + + (frob single fcmps fadds fsubs fmuls fdivs (inst fabss) (inst fmovs) 15) + (frob double fcmpd faddd fsubd fmuld fdivd (abs-double-reg) (move-double-reg) 15)) + +(macrolet + ((frob (float-type fcmp fadd fsub fmul fdiv fabs cost) + (let ((vop-name (symbolicate "//COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-reg (symbolicate float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float division") + (:translate /) + (:temporary (:sc ,real-reg) ratio) + (:temporary (:sc ,real-reg) den) + (:temporary (:sc ,real-reg) temp-r) + (:temporary (:sc ,real-reg) temp-i) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y)) + (rr (,real-part r)) + (ri (,imag-part r)) + (bigger (gen-label)) + (done (gen-label))) + (,@fabs ratio yr) + (,@fabs den yi) + (inst ,fcmp ratio den) + (unless (backend-featurep :sparc-v9) + (inst nop)) + (inst fb :ge bigger) + (inst nop) + ;; The case of |yi| <= |yr| + (inst ,fdiv ratio yi yr) ; ratio = yi/yr + (inst ,fmul den ratio yi) + (inst ,fmul temp-r ratio xi) + (inst ,fmul temp-i ratio xr) + + (inst ,fadd den den yr) ; den = yr + (yi/yr)*yi + (inst ,fadd temp-r temp-r xr) ; temp-r = xr + (yi/yr)*xi + (inst b done) + (inst ,fsub temp-i xi temp-i) ; temp-i = xi - (yi/yr)*xr + + + (emit-label bigger) + ;; The case of |yi| > |yr| + (inst ,fdiv ratio yr yi) ; ratio = yr/yi + (inst ,fmul den ratio yr) + (inst ,fmul temp-r ratio xr) + (inst ,fmul temp-i ratio xi) + + (inst ,fadd den den yi) ; den = yi + (yr/yi)*yr + (inst ,fadd temp-r temp-r xi) ; temp-r = xi + xr*(yr/yi) + + (inst ,fsub temp-i temp-i xr) ; temp-i = xi*(yr/yi) - xr + + (emit-label done) + + (inst ,fdiv rr temp-r den) + (inst ,fdiv ri temp-i den) + )))))) + + (frob single fcmps fadds fsubs fmuls fdivs (inst fabss) 15) + (frob double fcmpd faddd fsubd fmuld fdivd (abs-double-reg) 15)) + + +;; Divide a complex by a real +(macrolet + ((frob (float-type fdiv cost) + (let* ((vop-name (symbolicate "COMPLEX-" float-type "-FLOAT-/-" float-type "-FLOAT")) + (complex-sc-type (symbolicate "COMPLEX-" float-type "-REG")) + (real-sc-type (symbolicate float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (r-type (symbolicate float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-sc-type)) (y :scs (,real-sc-type))) + (:results (r :scs (,complex-sc-type))) + (:arg-types ,c-type ,r-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float arithmetic") + (:translate /) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (inst ,fdiv rr xr y) ; xr * y + (inst ,fdiv ri xi y) ; xi * yi + )))))) + (frob single fdivs 2) + (frob double fdivd 2)) + +;; Divide a real by a complex + +(macrolet + ((frob (float-type fcmp fadd fmul fdiv fneg fabs cost) + (let ((vop-name (symbolicate float-type "-FLOAT-/-COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-reg (symbolicate float-type "-REG")) + (r-type (symbolicate float-type "-FLOAT")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-tn (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-tn (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,real-reg)) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,r-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex float division") + (:translate /) + (:temporary (:sc ,real-reg) ratio) + (:temporary (:sc ,real-reg) den) + (:temporary (:sc ,real-reg) temp) + (:generator ,cost + (let ((yr (,real-tn y)) + (yi (,imag-tn y)) + (rr (,real-tn r)) + (ri (,imag-tn r)) + (bigger (gen-label)) + (done (gen-label))) + (,@fabs ratio yr) + (,@fabs den yi) + (inst ,fcmp ratio den) + (unless (backend-featurep :sparc-v9) + (inst nop)) + (inst fb :ge bigger) + (inst nop) + ;; The case of |yi| <= |yr| + (inst ,fdiv ratio yi yr) ; ratio = yi/yr + (inst ,fmul den ratio yi) + (inst ,fadd den den yr) ; den = yr + (yi/yr)*yi + + (inst ,fmul temp ratio x) ; temp = (yi/yr)*x + (inst ,fdiv rr x den) ; rr = x/den + (inst b done) + (inst ,fdiv temp temp den) ; temp = (yi/yr)*x/den + + (emit-label bigger) + ;; The case of |yi| > |yr| + (inst ,fdiv ratio yr yi) ; ratio = yr/yi + (inst ,fmul den ratio yr) + (inst ,fadd den den yi) ; den = yi + (yr/yi)*yr + + (inst ,fmul temp ratio x) ; temp = (yr/yi)*x + (inst ,fdiv rr temp den) ; rr = (yr/yi)*x/den + (inst ,fdiv temp x den) ; temp = x/den + (emit-label done) + + (,@fneg ri temp))))))) + + (frob single fcmps fadds fmuls fdivs (inst fnegs) (inst fabss) 10) + (frob double fcmpd faddd fmuld fdivd (negate-double-reg) (abs-double-reg) 10)) + +;; Conjugate of a complex number + +(macrolet + ((frob (float-type fneg fmov cost) + (let ((vop-name (symbolicate "CONJUGATE/COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline complex conjugate") + (:translate conjugate) + (:generator ,cost + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (rr (,real-part r)) + (ri (,imag-part r))) + (,@fneg ri xi) + (unless (location= rr xr) + (,@fmov rr xr)))))))) + + (frob single (inst fnegs) (inst fmovs) 4) + (frob double (negate-double-reg) (move-double-reg) 4)) + +;; Compare a float with a complex or a complex with a float +#+nil +(macrolet + ((frob (name name-r f-type c-type) + `(progn + (defknown ,name (,f-type ,c-type) t) + (defknown ,name-r (,c-type ,f-type) t) + (defun ,name (x y) + (declare (type ,f-type x) + (type ,c-type y)) + (,name x y)) + (defun ,name-r (x y) + (declare (type ,c-type x) + (type ,f-type y)) + (,name-r x y)) + ))) + (frob %compare-complex-single-single %compare-single-complex-single + single-float (complex single-float)) + (frob %compare-complex-double-double %compare-double-complex-double + double-float (complex double-float))) + +#+nil +(macrolet + ((frob (trans-1 trans-2 float-type fcmp fsub) + (let ((vop-name + (symbolicate "COMPLEX-" float-type "-FLOAT-" + float-type "-FLOAT-COMPARE")) + (vop-name-r + (symbolicate float-type "-FLOAT-COMPLEX-" + float-type "-FLOAT-COMPARE")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (real-reg (symbolicate float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (r-type (symbolicate float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(progn + ;; (= float complex) + (define-vop (,vop-name) + (:args (x :scs (,real-reg)) + (y :scs (,complex-reg))) + (:arg-types ,r-type ,c-type) + (:translate ,trans-1) + (:conditional) + (:info target not-p) + (:policy :fast-safe) + (:note "inline complex float/float comparison") + (:vop-var vop) + (:save-p :compute-only) + (:temporary (:sc ,real-reg) fp-zero) + (:guard (not (backend-featurep :sparc-v9))) + (:generator 6 + (note-this-location vop :internal-error) + (let ((yr (,real-part y)) + (yi (,imag-part y))) + ;; Set fp-zero to zero + (inst ,fsub fp-zero fp-zero fp-zero) + (inst ,fcmp x yr) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst ,fcmp yi fp-zero) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst nop)))) + ;; (= complex float) + (define-vop (,vop-name-r) + (:args (y :scs (,complex-reg)) + (x :scs (,real-reg))) + (:arg-types ,c-type ,r-type) + (:translate ,trans-2) + (:conditional) + (:info target not-p) + (:policy :fast-safe) + (:note "inline complex float/float comparison") + (:vop-var vop) + (:save-p :compute-only) + (:temporary (:sc ,real-reg) fp-zero) + (:guard (not (backend-featurep :sparc-v9))) + (:generator 6 + (note-this-location vop :internal-error) + (let ((yr (,real-part y)) + (yi (,imag-part y))) + ;; Set fp-zero to zero + (inst ,fsub fp-zero fp-zero fp-zero) + (inst ,fcmp x yr) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst ,fcmp yi fp-zero) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst nop)))))))) + (frob %compare-complex-single-single %compare-single-complex-single + single fcmps fsubs) + (frob %compare-complex-double-double %compare-double-complex-double + double fcmpd fsubd)) + +;; Compare two complex numbers for equality +(macrolet + ((frob (float-type fcmp) + (let ((vop-name + (symbolicate "COMPLEX-" float-type "-FLOAT-COMPARE")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:translate =) + (:conditional) + (:info target not-p) + (:policy :fast-safe) + (:note "inline complex float comparison") + (:vop-var vop) + (:save-p :compute-only) + (:guard (not (backend-featurep :sparc-v9))) + (:generator 6 + (note-this-location vop :internal-error) + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y))) + (inst ,fcmp xr yr) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst ,fcmp xi yi) + (inst nop) + (inst fb (if not-p :ne :eq) target #+sparc-v9 :fcc0 #+sparc-v9 :pn) + (inst nop))))))) + (frob single fcmps) + (frob double fcmpd)) + +;; Compare a complex with a complex, for V9 +(macrolet + ((frob (float-type fcmp) + (let ((vop-name + (symbolicate "V9-COMPLEX-" float-type "-FLOAT-COMPARE")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (real-part (symbolicate "COMPLEX-" float-type "-REG-REAL-TN")) + (imag-part (symbolicate "COMPLEX-" float-type "-REG-IMAG-TN"))) + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg)) + (y :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:translate =) + (:conditional) + (:info target not-p) + (:policy :fast-safe) + (:note "inline complex float comparison") + (:vop-var vop) + (:save-p :compute-only) + (:temporary (:sc descriptor-reg) true) + (:guard (backend-featurep :sparc-v9)) + (:generator 6 + (note-this-location vop :internal-error) + (let ((xr (,real-part x)) + (xi (,imag-part x)) + (yr (,real-part y)) + (yi (,imag-part y))) + ;; Assume comparison is true + (load-symbol true t) + (inst ,fcmp xr yr) + (inst cmove (if not-p :eq :ne) true null-tn :fcc0) + (inst ,fcmp xi yi) + (inst cmove (if not-p :eq :ne) true null-tn :fcc0) + (inst cmp true null-tn) + (inst b (if not-p :eq :ne) target :icc :pt) + (inst nop))))))) + (frob single fcmps) + (frob double fcmpd)) + +) ; end progn complex-fp-vops + +#+sparc-v9 +(progn + +#+nil +(macrolet + ((frob (op type) + (let ((name (symbolicate op "-" type))) + `(progn + (defknown ,name (,type ,type) + ,type + (movable foldable flushable)) + (defun ,name (x y) + (declare (,type x y)) + (,name x y)))))) + (frob %max single-float) + (frob %max double-float) + (frob %min double-float) + (frob %min single-float)) + +(defknown (%%max %%min) ((or (unsigned-byte 32) (signed-byte 32) + single-float double-float) + (or (unsigned-byte 32) (signed-byte 32) + single-float double-float)) + (or (unsigned-byte 32) (signed-byte 32) + single-float double-float) + (movable foldable flushable)) + +(defun %%max (x y) + (declare (type (or (unsigned-byte 32) (signed-byte 32) + single-float double-float) x y)) + (%%max x y)) + +(defun %%min (x y) + (declare (type (or (unsigned-byte 32) (signed-byte 32) + single-float double-float) x y)) + (%%min x y)) + + +(macrolet + ((frob (name sc-type type compare cmov cost cc max min note) + (let ((vop-name (symbolicate name "-" type "=>" type)) + (trans-name (symbolicate "%%" name))) + `(define-vop (,vop-name) + (:args (x :scs (,sc-type)) + (y :scs (,sc-type))) + (:results (r :scs (,sc-type))) + (:arg-types ,type ,type) + (:result-types ,type) + (:policy :fast-safe) + (:note ,note) + (:translate ,trans-name) + (:guard (backend-featurep :sparc-v9)) + (:generator ,cost + (inst ,compare x y) + (cond ((location= r x) + ;; If x < y, need to move y to r, otherwise r already has + ;; the max. + (inst ,cmov ,min r y ,cc)) + ((location= r y) + ;; If x > y, need to move x to r, otherwise r already has + ;; the max. + (inst ,cmov ,max r x ,cc)) + (t + ;; It doesn't matter what R is, just copy the min to R. + (inst ,cmov ,max r x ,cc) + (inst ,cmov ,min r y ,cc)))))))) + (frob max single-reg single-float fcmps cfmovs 3 + :fcc0 :ge :l "inline float max") + (frob max double-reg double-float fcmpd cfmovd 3 + :fcc0 :ge :l "inline float max") + (frob min single-reg single-float fcmps cfmovs 3 + :fcc0 :l :ge "inline float min") + (frob min double-reg double-float fcmpd cfmovd 3 + :fcc0 :l :ge "inline float min") + ;; Strictly speaking these aren't float ops, but it's convenient to + ;; do them here. + ;; + ;; The cost is here is the worst case number of instructions. For + ;; 32-bit integer operands, we add 2 more to account for the + ;; untagging of fixnums, if necessary. + (frob max signed-reg signed-num cmp cmove 5 + :icc :ge :lt "inline (signed-byte 32) max") + (frob max unsigned-reg unsigned-num cmp cmove 5 + :icc :ge :lt "inline (unsigned-byte 32) max") + ;; For fixnums, make the cost lower so we don't have to untag the + ;; numbers. + (frob max any-reg tagged-num cmp cmove 3 + :icc :ge :lt "inline fixnum max") + (frob min signed-reg signed-num cmp cmove 5 + :icc :lt :ge "inline (signed-byte 32) min") + (frob min unsigned-reg unsigned-num cmp cmove 5 + :icc :lt :ge "inline (unsigned-byte 32) min") + ;; For fixnums, make the cost lower so we don't have to untag the + ;; numbers. + (frob min any-reg tagged-num cmp cmove 3 + :icc :lt :ge "inline fixnum min")) + +#+nil +(define-vop (max-boxed-double-float=>boxed-double-float) + (:args (x :scs (descriptor-reg)) + (y :scs (descriptor-reg))) + (:results (r :scs (descriptor-reg))) + (:arg-types double-float double-float) + (:result-types double-float) + (:policy :fast-safe) + (:note "inline float max/min") + (:translate %max-double-float) + (:temporary (:scs (double-reg)) xval) + (:temporary (:scs (double-reg)) yval) + (:guard (backend-featurep :sparc-v9)) + (:vop-var vop) + (:generator 3 + (let ((offset (- (* vm:double-float-value-slot vm:word-bytes) + vm:other-pointer-type))) + (inst lddf xval x offset) + (inst lddf yval y offset) + (inst fcmpd xval yval) + (cond ((location= r x) + ;; If x < y, need to move y to r, otherwise r already has + ;; the max. + (inst cmove :l r y :fcc0)) + ((location= r y) + ;; If x > y, need to move x to r, otherwise r already has + ;; the max. + (inst cmove :ge r x :fcc0)) + (t + ;; It doesn't matter what R is, just copy the min to R. + (inst cmove :ge r x :fcc0) + (inst cmove :l r y :fcc0)))))) + +) -- GitLab