diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index abc77905547d0010a7ab60268fb16827369e4d49..6682e0fba5d7a8463951b64725abb8c63169ec99 100644
--- a/compiler/x86/float.lisp
+++ b/compiler/x86/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.36 2000/04/23 16:59:53 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.37 2000/06/26 15:56:00 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,7 +18,7 @@
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
 ;;;
 ;;; Rewrite, enhancements, complex-float and long-float support by
-;;; Douglas Crosher, 1996, 1997, 1998.
+;;; Douglas Crosher, 1996, 1997, 1998, 1999, 2000.
 ;;;
 
 (in-package :x86)
@@ -1271,6 +1271,19 @@
 		(:generator 3
 		   ;; Handle a few special cases
 		   (cond
+		     ;; x is ST0.
+		     ((and (sc-is x single-reg) (zerop (tn-offset x)))
+		      (sc-case y
+			(single-reg
+			 (inst fcom y))
+			((single-stack descriptor-reg)
+			 (if (sc-is y single-stack)
+			     (inst fcom (ea-for-sf-stack y))
+			     (inst fcom (ea-for-sf-desc y)))))
+		      (inst fnstsw)			; status word to ax
+		      (inst and ah-tn #x45)
+		      ,@(unless (zerop test)
+			  `((inst cmp ah-tn ,test))))
 		     ;; y is ST0.
 		     ((and (sc-is y single-reg) (zerop (tn-offset y)))
 		      (sc-case x
@@ -1284,14 +1297,13 @@
 		      (inst and ah-tn #x45)
 		      ,@(unless (zerop ntest)
 			  `((inst cmp ah-tn ,ntest))))
-		     ;; General case when y is not in ST0.
+		     ;; General case when neither x or y is in ST0.
 		     (t
 		      ,@(if (zerop ntest)
 			    `(;; y to ST0
 			      (sc-case y
 			        (single-reg
-				 (unless (zerop (tn-offset y))
-				   (copy-fp-reg-to-fr0 y)))
+				 (copy-fp-reg-to-fr0 y))
 			        ((single-stack descriptor-reg)
 				 (fp-pop)
 				 (if (sc-is y single-stack)
@@ -1309,8 +1321,7 @@
 			    `(;; x to ST0
 			      (sc-case x
 			        (single-reg
-				 (unless (zerop (tn-offset x))
-				   (copy-fp-reg-to-fr0 x)))
+				 (copy-fp-reg-to-fr0 x))
 			        ((single-stack descriptor-reg)
 				 (fp-pop)
 				 (if (sc-is x single-stack)
@@ -1349,7 +1360,20 @@
 		(:generator 3
 		   ;; Handle a few special cases
 		   (cond
-		     ;; y is ST0.
+		     ;; x is in ST0.
+		     ((and (sc-is x double-reg) (zerop (tn-offset x)))
+		      (sc-case y
+			(double-reg
+			 (inst fcomd y))
+			((double-stack descriptor-reg)
+			 (if (sc-is y double-stack)
+			     (inst fcomd (ea-for-df-stack y))
+			     (inst fcomd (ea-for-df-desc y)))))
+		      (inst fnstsw)			; status word to ax
+		      (inst and ah-tn #x45)
+		      ,@(unless (zerop test)
+			  `((inst cmp ah-tn ,test))))
+		     ;; y is in ST0.
 		     ((and (sc-is y double-reg) (zerop (tn-offset y)))
 		      (sc-case x
 			(double-reg
@@ -1362,14 +1386,13 @@
 		      (inst and ah-tn #x45)
 		      ,@(unless (zerop ntest)
 			  `((inst cmp ah-tn ,ntest))))
-		     ;; General case when y is not in ST0.
+		     ;; General case when neither x or y is in ST0.
 		     (t
 		      ,@(if (zerop ntest)
 			    `(;; y to ST0
 			      (sc-case y
 			        (double-reg
-				 (unless (zerop (tn-offset y))
-				   (copy-fp-reg-to-fr0 y)))
+				 (copy-fp-reg-to-fr0 y))
 			        ((double-stack descriptor-reg)
 				 (fp-pop)
 				 (if (sc-is y double-stack)
@@ -1387,8 +1410,7 @@
 			    `(;; x to ST0
 			      (sc-case x
 			        (double-reg
-				 (unless (zerop (tn-offset x))
-				   (copy-fp-reg-to-fr0 x)))
+				 (copy-fp-reg-to-fr0 x))
 			        ((double-stack descriptor-reg)
 				 (fp-pop)
 				 (if (sc-is x double-stack)