Commit f1399c10 authored by rtoy's avatar rtoy
Browse files

Fix issue with complex contagion on sparc. The vops for complex+real

and complex-real didn't compute the imaginary part correctly; we need
to add (or subtract) 0 to get the correct signed zero.

(+ #c(1d0 -0d0) 1d0) -> #c(2d0 0d0), not #c(2d0 -0d0)

code/sparc-svr4-vm.lisp:
o Define *FP-CONSTANT-0F0* and *FP-CONSTANT-0D0*, floating point
  zeroes.

compiler/generic/new-genesis.lisp:
o Initialize *FP-CONSTANT-0F0* and *FP-CONSTANT-0D0* during genesis.

compiler/sparc/parms.lisp:
o Add *FP-CONSTANT-0F0* and *FP-CONSTANT-0D0* to the static symbols so
  vops can access them easily.  For bootstrapping purposes, we steal
  the spare-9 and sparc-8 symbols.

compiler/sparc/float.lisp:
o Update vops for complex + float and complex - float.  Need to add
  (or subtract) 0 to the imaginary part to get the correct signed
  zero.
o Update vop for float+complex as above.
parent 266512a4
......@@ -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/code/sparc-svr4-vm.lisp,v 1.12 2008/11/12 15:04:23 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.13 2009/06/15 16:56:08 rtoy Rel $")
;;;
;;; **********************************************************************
;;;
......@@ -485,3 +485,10 @@
(let ((fs1 (and fop rs1 (sigcontext-float-register scp rs1 format)))
(fs2 (and fop rs2 (sigcontext-float-register scp rs2 format))))
(values fop (remove nil (list fs1 fs2))))))
;;; FLOAT CONSTANTS
;;;
;;; These are filled in by genesis. These values are used in some
;;; vops to allow vops an easy way to get floating-poing zeroes.
(defvar *fp-constant-0f0*)
(defvar *fp-constant-0d0*)
......@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.86 2009/06/11 16:04:00 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.87 2009/06/15 16:56:08 rtoy Rel $")
;;;
;;; **********************************************************************
;;;
......@@ -926,6 +926,13 @@
(when (c:backend-featurep :gencgc)
(frob "*SCAVENGE-READ-ONLY-SPACE*" "X86" (cold-intern nil)))))
(when (c::backend-featurep :sparc)
(macrolet ((frob (name pkg value)
`(cold-setq (cold-intern (intern ,name ,pkg)) ,value)))
(frob "*FP-CONSTANT-0D0*" "SPARC" (number-to-core 0d0))
(frob "*FP-CONSTANT-0F0*" "SPARC" (number-to-core 0f0))))
;; Nothing should be allocated after this.
;;
(frob *read-only-space-free-pointer*
......
......@@ -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.60 2009/06/11 16:04:00 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.61 2009/06/15 16:56:08 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -1992,7 +1992,7 @@
;; Add and subtract a complex and a float
(macrolet
((frob (size op fop fmov cost)
((frob (size op fop cost)
(let ((vop-name (symbolicate "COMPLEX-" size "-FLOAT-"
op
"-" size "-FLOAT"))
......@@ -2001,7 +2001,16 @@
(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")))
(imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))
(load (ecase size
(single 'ldf)
(double 'lddf)))
(zero-sym (ecase size
(single '*fp-constant-0f0*)
(double '*fp-constant-0d0*)))
(slot (ecase size
(single vm:single-float-value-slot)
(double vm:double-float-value-slot))))
`(define-vop (,vop-name)
(:args (x :scs (,complex-reg))
(y :scs (,real-reg)))
......@@ -2009,6 +2018,8 @@
(:arg-types ,c-type ,r-type)
(:result-types ,c-type)
(:policy :fast-safe)
(:temporary (:scs (,real-reg)) zero)
(:temporary (:scs (descriptor-reg)) zero-val)
(:note "inline complex float/float arithmetic")
(:translate ,op)
(:generator ,cost
......@@ -2016,18 +2027,25 @@
(xi (,imag-part x))
(rr (,real-part r))
(ri (,imag-part r)))
;; Load up the necessary floating-point zero that we
;; need. It would be nice if we could do something
;; like xr-xr to get a floating-point zero, but that
;; can cause spurious signals if xr is an infinity or
;; NaN.
(load-symbol-value zero-val ,zero-sym)
(inst ,load zero zero-val (- (* ,slot vm:word-bytes)
vm:other-pointer-type))
(inst ,fop rr xr y)
(unless (location= ri xi)
(,@fmov ri xi))))))))
(inst ,fop ri xi zero)))))))
(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))
(frob single + fadds 2)
(frob single - fsubs 2)
(frob double + faddd 4)
(frob double - fsubd 4))
;; Add a float and a complex
(macrolet
((frob (size fop fmov cost)
((frob (size fop cost)
(let ((vop-name
(symbolicate size "-FLOAT-+-COMPLEX-" size "-FLOAT"))
(complex-reg (symbolicate "COMPLEX-" size "-REG"))
......@@ -2035,13 +2053,24 @@
(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")))
(imag-part (symbolicate "COMPLEX-" size "-REG-IMAG-TN"))
(load (ecase size
(single 'ldf)
(double 'lddf)))
(zero-sym (ecase size
(single '*fp-constant-0f0*)
(double '*fp-constant-0d0*)))
(slot (ecase size
(single vm:single-float-value-slot)
(double vm:double-float-value-slot))))
`(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)
(:temporary (:scs (,real-reg)) zero)
(:temporary (:scs (descriptor-reg)) zero-val)
(:policy :fast-safe)
(:note "inline complex float/float arithmetic")
(:translate +)
......@@ -2050,11 +2079,13 @@
(xi (,imag-part x))
(rr (,real-part r))
(ri (,imag-part r)))
(load-symbol-value zero-val ,zero-sym)
(inst ,load zero zero-val (- (* ,slot vm:word-bytes)
vm:other-pointer-type))
(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))
(inst ,fop rr xr zero)))))))
(frob single fadds 1)
(frob double faddd 2))
;; Subtract a complex from a float.
;;
......
......@@ -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/parms.lisp,v 1.57 2009/06/11 16:04:00 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.58 2009/06/15 16:56:09 rtoy Rel $")
;;;
;;; **********************************************************************
;;;
......@@ -334,12 +334,14 @@
:value
:key-and-value
:key-or-value
;; FP constants
*fp-constant-0d0*
*fp-constant-0f0*
;; Some spare static symbols. Useful for adding another static
;; symbol without having to do a cross-compile. Just rename one
;; of these to the desired name.
sparc-9
spare-8
spare-7
spare-6
spare-5
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment