diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp
index 8358d6fa8b89826631f1f70ba8db44e0b1153e55..3e8028002a6d9f05720949b0bd9871d3953f31e9 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.27 2000/02/18 01:24:31 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.28 2000/02/24 14:40:34 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -121,7 +121,7 @@
 ;;; on the :sparc-v9 feature.
 (defun move-long-reg (dst src)
   (cond ((backend-featurep :sparc-v9)
-	 (inst fmovx dst src))
+	 (inst fmovq dst src))
 	(t
 	 (dotimes (i 4)
 	   (let ((dst (make-random-tn :kind :normal
@@ -645,10 +645,10 @@
 		  (:translate ,op)
 		  (:generator ,lcost
 		    (inst ,linst r x y)))))
-  (frob + faddx +/long-float 2)
-  (frob - fsubx -/long-float 2)
-  (frob * fmulx */long-float 6)
-  (frob / fdivx //long-float 20))
+  (frob + faddq +/long-float 2)
+  (frob - fsubq -/long-float 2)
+  (frob * fmulq */long-float 6)
+  (frob / fdivq //long-float 20))
 
 
 (macrolet ((frob (name inst translate sc type)
@@ -668,6 +668,36 @@
   (frob abs/single-float fabss abs single-reg single-float)
   (frob %negate/single-float fnegs %negate single-reg single-float))
 
+(defun negate-double-reg (dst src)
+  (cond ((backend-featurep :sparc-v9)
+	 (inst fnegd dst src))
+	(t
+	 ;; Negate the MS part of the numbers, then copy over the rest
+	 ;; of the bits.
+	 (inst fnegs dst src)
+	 (let ((dst-odd (make-random-tn :kind :normal
+					:sc (sc-or-lose 'single-reg *backend*)
+					:offset (+ 1 (tn-offset dst))))
+	       (src-odd (make-random-tn :kind :normal
+					:sc (sc-or-lose 'single-reg *backend*)
+					:offset (+ 1 (tn-offset src)))))
+	   (inst fmovs dst-odd src-odd)))))
+
+(defun abs-double-reg (dst src)
+  (cond ((backend-featurep :sparc-v9)
+	 (inst fabsd dst src))
+	(t
+	 ;; Abs the MS part of the numbers, then copy over the rest
+	 ;; of the bits.
+	 (inst fabss dst src)
+	 (let ((dst-2 (make-random-tn :kind :normal
+				      :sc (sc-or-lose 'single-reg *backend*)
+				      :offset (+ 1 (tn-offset dst))))
+	       (src-2 (make-random-tn :kind :normal
+				      :sc (sc-or-lose 'single-reg *backend*)
+				      :offset (+ 1 (tn-offset src)))))
+	   (inst fmovs dst-2 src-2)))))
+
 (define-vop (abs/double-float)
   (:args (x :scs (double-reg)))
   (:results (y :scs (double-reg)))
@@ -680,17 +710,7 @@
   (:save-p :compute-only)
   (:generator 1
     (note-this-location vop :internal-error)
-    (cond ((backend-featurep :sparc-v9)
-	   (inst fabsd y x))
-	  (t
-	   (inst fabss y x)
-	   (let ((y-odd (make-random-tn :kind :normal
-					:sc (sc-or-lose 'single-reg *backend*)
-					:offset (+ 1 (tn-offset y))))
-		 (x-odd (make-random-tn :kind :normal
-					:sc (sc-or-lose 'single-reg *backend*)
-					:offset (+ 1 (tn-offset x)))))
-	     (inst fmovs y-odd x-odd))))))
+    (abs-double-reg y x)))
 
 (define-vop (%negate/double-float)
   (:args (x :scs (double-reg)))
@@ -704,17 +724,7 @@
   (:save-p :compute-only)
   (:generator 1
     (note-this-location vop :internal-error)
-    (cond ((backend-featurep :sparc-v9)
-	   (inst fnegd y x))
-	  (t
-	   (inst fnegs y x)
-	   (let ((y-odd (make-random-tn :kind :normal
-					:sc (sc-or-lose 'single-reg *backend*)
-					:offset (+ 1 (tn-offset y))))
-		 (x-odd (make-random-tn :kind :normal
-					:sc (sc-or-lose 'single-reg *backend*)
-					:offset (+ 1 (tn-offset x)))))
-	     (inst fmovs y-odd x-odd))))))
+    (negate-double-reg y x)))
 
 #+long-float
 (define-vop (abs/long-float)
@@ -730,7 +740,7 @@
   (:generator 1
     (note-this-location vop :internal-error)
     (cond ((backend-featurep :sparc-v9)
-	   (inst fabsx y x))
+	   (inst fabsq y x))
 	  (t
 	   (inst fabss y x)
 	   (dotimes (i 3)
@@ -758,7 +768,7 @@
   (:generator 1
     (note-this-location vop :internal-error)
     (cond ((backend-featurep :sparc-v9)
-	   (inst fnegx y x))
+	   (inst fnegq y x))
 	  (t
 	   (inst fnegs y x)
 	   (dotimes (i 3)
@@ -789,7 +799,7 @@
     (ecase format
       (:single (inst fcmps x y))
       (:double (inst fcmpd x y))
-      (:long (inst fcmpx x y)))
+      (:long (inst fcmpq x y)))
     ;; The SPARC V9 doesn't need an instruction between a
     ;; floating-point compare and a floating-point branch.
     (unless (backend-featurep :sparc-v9)
@@ -865,7 +875,7 @@
   (frob %single-float/signed %single-float fitos single-reg single-float)
   (frob %double-float/signed %double-float fitod double-reg double-float)
   #+long-float
-  (frob %long-float/signed %long-float fitox long-reg long-float))
+  (frob %long-float/signed %long-float fitoq long-reg long-float))
 
 (macrolet ((frob (name translate inst from-sc from-type to-sc to-type)
 	     `(define-vop (,name)
@@ -884,18 +894,18 @@
   (frob %single-float/double-float %single-float fdtos
     double-reg double-float single-reg single-float)
   #+long-float
-  (frob %single-float/long-float %single-float fxtos
+  (frob %single-float/long-float %single-float fqtos
     long-reg long-float single-reg single-float)
   (frob %double-float/single-float %double-float fstod
     single-reg single-float double-reg double-float)
   #+long-float
-  (frob %double-float/long-float %double-float fxtod
+  (frob %double-float/long-float %double-float fqtod
     long-reg long-float double-reg double-float)
   #+long-float
-  (frob %long-float/single-float %long-float fstox
+  (frob %long-float/single-float %long-float fstoq
     single-reg single-float long-reg long-float)
   #+long-float
-  (frob %long-float/double-float %long-float fdtox
+  (frob %long-float/double-float %long-float fdtoq
     double-reg double-float long-reg long-float))
 
 (macrolet ((frob (trans from-sc from-type inst)
@@ -927,7 +937,7 @@
   (frob %unary-truncate single-reg single-float fstoi)
   (frob %unary-truncate double-reg double-float fdtoi)
   #+long-float
-  (frob %unary-truncate long-reg long-float fxtoi)
+  (frob %unary-truncate long-reg long-float fqtoi)
   #-sun4
   (frob %unary-round single-reg single-float fstoir)
   #-sun4
@@ -1248,6 +1258,24 @@
       (loadw res nfp (tn-offset temp))
       (inst nop))))
 
+#+nil
+(define-vop (floating-point-modes)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:translate floating-point-modes)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:temporary (:sc double-stack) temp)
+  (:generator 3
+    (let* ((nfp (current-nfp-tn vop))
+	   (offset (* 4 (tn-offset temp))))
+      (inst stxfsr nfp offset)
+      ;; The desired FP mode data is in the least significant 32
+      ;; bits, which is stored at the next higher word in memory.
+      (loadw res nfp (+ offset 4))
+      ;; Is this nop needed? (toy@rtp.ericsson.se)
+      (inst nop))))
+
 (define-vop (set-floating-point-modes)
   (:args (new :scs (unsigned-reg) :target res))
   (:results (res :scs (unsigned-reg)))
@@ -1263,6 +1291,57 @@
       (inst ldfsr nfp (* word-bytes (tn-offset temp)))
       (move res new))))
 
+#+nil
+(define-vop (set-floating-point-modes)
+  (:args (new :scs (unsigned-reg) :target res))
+  (:results (res :scs (unsigned-reg)))
+  (:arg-types unsigned-num)
+  (:result-types unsigned-num)
+  (:translate (setf floating-point-modes))
+  (:policy :fast-safe)
+  (:temporary (:sc double-stack) temp)
+  (:temporary (:sc unsigned-reg) my-fsr)
+  (:vop-var vop)
+  (:generator 3
+    (let ((nfp (current-nfp-tn vop))
+	  (offset (* word-bytes (tn-offset temp))))
+      (pseudo-atomic ()
+        ;; Get the current FSR, so we can get the new %fcc's
+        (inst stxfsr nfp offset)
+	(inst ldx my-fsr nfp offset)
+	;; Carefully merge in the new mode bits with the rest of the
+	;; FSR.  This is only needed if we care about preserving the
+	;; high 32 bits of the FSR, which contain the additional
+	;; %fcc's on the sparc V9.  If not, we don't need this, but we
+	;; do need to make sure that the unused bits are written as
+	;; zeroes, according the the V9 architecture manual.
+	(inst sra new 0)
+	(inst srlx my-fsr 32)
+	(inst sllx my-fsr 32)
+	(inst or my-fsr new)
+	;; Save it back and load it into the fsr register
+	(inst stx my-fsr nfp offset)
+	(inst ldxfsr nfp offset)
+	(move res new)))))
+
+#+nil
+(define-vop (set-floating-point-modes)
+  (:args (new :scs (unsigned-reg) :target res))
+  (:results (res :scs (unsigned-reg)))
+  (:arg-types unsigned-num)
+  (:result-types unsigned-num)
+  (:translate (setf floating-point-modes))
+  (:policy :fast-safe)
+  (:temporary (:sc double-stack) temp)
+  (:temporary (:sc unsigned-reg) my-fsr)
+  (:vop-var vop)
+  (:generator 3
+    (let ((nfp (current-nfp-tn vop))
+	  (offset (* word-bytes (tn-offset temp))))
+      (inst stx new nfp offset)
+      (inst ldxfsr nfp offset)
+      (move res new))))
+
 
 ;;;; Special functions.
 
@@ -1285,7 +1364,7 @@
     (inst fsqrtd y x)))
 
 #+long-float
-(define-vop (fsqrt)
+(define-vop (fsqrt-long)
   (:args (x :scs (long-reg)))
   (:results (y :scs (long-reg)))
   (:translate %sqrt)
@@ -1297,7 +1376,7 @@
   (:save-p :compute-only)
   (:generator 1
     (note-this-location vop :internal-error)
-    (inst fsqrtx y x)))
+    (inst fsqrtq y x)))
 
 
 ;;;; Complex float VOPs