diff --git a/code/pred.lisp b/code/pred.lisp
index d04096430af572a1380f590167bf9225e4dca7b3..1da31992f9f0cb987d629dacb81b19fdbcb5cc40 100644
--- a/code/pred.lisp
+++ b/code/pred.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/code/pred.lisp,v 1.43 1997/11/29 20:13:11 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.44 1998/01/05 22:34:54 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -209,6 +209,7 @@
 		 (long-float (typep num 'long-float))
 		 ((nil) (floatp num))))
 	      ((nil) t)))
+	  #-negative-zero-is-not-zero
 	  (flet ((bound-test (val)
 		   (let ((low (numeric-type-low type))
 			 (high (numeric-type-high type)))
@@ -218,6 +219,37 @@
 			  (cond ((null high) t)
 				((listp high) (< val (car high)))
 				(t (<= val high)))))))
+	    (ecase (numeric-type-complexp type)
+	      ((nil) t)
+	      (:complex
+	       (and (complexp object)
+		    (bound-test (realpart object))
+		    (bound-test (imagpart object))))
+	      (:real
+	       (and (not (complexp object))
+		    (bound-test object)))))
+	  #+negative-zero-is-not-zero
+	  (labels ((signed-> (x y)
+		     (if (and (zerop x) (zerop y) (floatp x) (floatp y))
+			 (> (float-sign x) (float-sign y))
+			 (> x y)))
+		   (signed->= (x y)
+		     (if (and (zerop x) (zerop y) (floatp x) (floatp y))
+			 (>= (float-sign x) (float-sign y))
+			 (>= x y)))
+		   (bound-test (val)
+		     (let ((low (numeric-type-low type))
+			   (high (numeric-type-high type)))
+		       (and (cond ((null low) t)
+				  ((listp low)
+				   (signed-> val (car low)))
+				  (t
+				   (signed->= val low)))
+			    (cond ((null high) t)
+				  ((listp high)
+				   (signed-> (car high) val))
+				  (t
+				   (signed->= high val)))))))
 	    (ecase (numeric-type-complexp type)
 	      ((nil) t)
 	      (:complex
diff --git a/code/type.lisp b/code/type.lisp
index 1d6d512b93e5dfd1d9524dfadbab248e5c9f1877..851e409fc102e70910e60853bd553f406d6dc895 100644
--- a/code/type.lisp
+++ b/code/type.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/code/type.lisp,v 1.23 1997/12/18 16:49:10 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.24 1998/01/05 22:34:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1118,6 +1118,7 @@
 ;;;    This is for comparing bounds of the same kind, e.g. upper and upper.
 ;;; Use Numeric-Bound-Test* for different kinds of bounds.
 ;;;
+#-negative-zero-is-not-zero
 (defmacro numeric-bound-test (x y closed open)
   `(cond ((not ,y) t)
 	 ((not ,x) nil)
@@ -1130,6 +1131,24 @@
 	      (,open ,x (car ,y))
 	      (,closed ,x ,y)))))
 
+#+negative-zero-is-not-zero
+(defmacro numeric-bound-test-zero (op x y)
+  `(if (and (zerop ,x) (zerop ,y) (floatp ,x) (floatp ,y))
+       (,op (float-sign ,x) (float-sign ,y))
+       (,op ,x ,y)))
+
+#+negative-zero-is-not-zero
+(defmacro numeric-bound-test (x y closed open)
+  `(cond ((not ,y) t)
+	 ((not ,x) nil)
+	 ((consp ,x)
+	  (if (consp ,y)
+	      (numeric-bound-test-zero ,closed (car ,x) (car ,y))
+	      (numeric-bound-test-zero ,closed (car ,x) ,y)))
+	 (t
+	  (if (consp ,y)
+	      (numeric-bound-test-zero ,open ,x (car ,y))
+	      (numeric-bound-test-zero ,closed ,x ,y)))))
 
 ;;; Numeric-Bound-Test*  --  Internal
 ;;;
@@ -1140,6 +1159,7 @@
 ;;; -- an open inner bound is "greater" and also squeezes the interval, causing
 ;;;    us to use the Open test for those cases as well.
 ;;;
+#-negative-zero-is-not-zero
 (defmacro numeric-bound-test* (x y closed open)
   `(cond ((not ,y) t)
 	 ((not ,x) t)
@@ -1152,6 +1172,19 @@
 	      (,open ,x (car ,y))
 	      (,closed ,x ,y)))))
 
+#+negative-zero-is-not-zero
+(defmacro numeric-bound-test* (x y closed open)
+  `(cond ((not ,y) t)
+	 ((not ,x) t)
+	 ((consp ,x)
+	  (if (consp ,y)
+	      (numeric-bound-test-zero ,open (car ,x) (car ,y))
+	      (numeric-bound-test-zero ,open (car ,x) ,y)))
+	 (t
+	  (if (consp ,y)
+	      (numeric-bound-test-zero ,open ,x (car ,y))
+	      (numeric-bound-test-zero ,closed ,x ,y)))))
+
 
 ;;; Numeric-Bound-Max  --  Internal
 ;;;
diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index db6899ee00e9a5578c7c0e11134c7cc48b35bb3f..a5fa991ad65bc8d11a2741dcd2938e6631e9bdce 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.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/typetran.lisp,v 1.31 1997/11/15 04:38:57 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.32 1998/01/05 22:35:00 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -175,6 +175,7 @@
 ;;; specified by Type.  Base is the name of the base type, for declaration.  We
 ;;; make safety locally 0 to inhibit any checking of this assertion.
 ;;;
+#-negative-zero-is-not-zero
 (defun transform-numeric-bound-test (n-object type base)
   (declare (type numeric-type type))
   (let ((low (numeric-type-low type))
@@ -190,6 +191,25 @@
 		    `((< (the ,base ,n-object) ,(car high)))
 		    `((<= (the ,base ,n-object) ,high))))))))
 
+#+negative-zero-is-not-zero
+(defun transform-numeric-bound-test (n-object type base)
+  (declare (type numeric-type type))
+  (let ((low (numeric-type-low type))
+	(high (numeric-type-high type)))
+    `(locally
+       (declare (optimize (safety 0)))
+       (and ,@(when low
+		(if (consp low)
+		    `((kernel::numeric-bound-test-zero
+		       > (the ,base ,n-object) ,(car low)))
+		    `((kernel::numeric-bound-test-zero
+		       >= (the ,base ,n-object) ,low))))
+	    ,@(when high
+		(if (consp high)
+		    `((kernel::numeric-bound-test-zero
+		       < (the ,base ,n-object) ,(car high)))
+		    `((kernel::numeric-bound-test-zero
+		       <= (the ,base ,n-object) ,high))))))))
 
 ;;; Source-Transform-Numeric-Typep  --  Internal
 ;;;
diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index c3b2b952c2fa2fdd9438cb360a9b2a1dbd4dce24..d2d41933988edc5741e6dfe38b2dab79db776bb6 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.17 1997/11/30 22:53:51 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.18 1998/01/05 22:35:04 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1230,34 +1230,52 @@
 (define-vop (=0/single-float float-test)
   (:translate =)
   (:args (x :scs (single-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types single-float (:constant (single-float 0f0 0f0)))
+  #+negative-zero-is-not-zero
+  (:arg-types single-float (:constant (single-float -0f0 0f0)))
   (:variant #x40))
 (define-vop (=0/double-float float-test)
   (:translate =)
   (:args (x :scs (double-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types double-float (:constant (double-float 0d0 0d0)))
+  #+negative-zero-is-not-zero
+  (:arg-types double-float (:constant (double-float -0d0 0d0)))
   (:variant #x40))
 
 (define-vop (<0/single-float float-test)
   (:translate <)
   (:args (x :scs (single-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types single-float (:constant (single-float 0f0 0f0)))
+  #+negative-zero-is-not-zero
+  (:arg-types single-float (:constant (single-float -0f0 0f0)))
   (:variant #x01))
 (define-vop (<0/double-float float-test)
   (:translate <)
   (:args (x :scs (double-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types double-float (:constant (double-float 0d0 0d0)))
+  #+negative-zero-is-not-zero
+  (:arg-types double-float (:constant (double-float -0d0 0d0)))
   (:variant #x01))
 
 (define-vop (>0/single-float float-test)
   (:translate >)
   (:args (x :scs (single-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types single-float (:constant (single-float 0f0 0f0)))
+  #+negative-zero-is-not-zero
+  (:arg-types single-float (:constant (single-float -0f0 0f0)))
   (:variant #x00))
 (define-vop (>0/double-float float-test)
   (:translate >)
   (:args (x :scs (double-reg)))
+  #-negative-zero-is-not-zero
   (:arg-types double-float (:constant (double-float 0d0 0d0)))
+  #+negative-zero-is-not-zero
+  (:arg-types double-float (:constant (double-float -0d0 0d0)))
   (:variant #x00))