diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index b4ffed819a3c3ec0d20491f9cde10431313da93a..b3332dda3a8ed3d26daffcbe4e4127709d48778c 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.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/float-tran.lisp,v 1.24 1997/01/18 14:31:35 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.25 1997/02/05 15:41:50 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -237,6 +237,8 @@
   (frob scale-single-float)
   (frob scale-double-float))
 	     
+;;; toy@rtp.ericsson.se:
+;;;
 ;;; Defoptimizers for %single-float and %double-float.  This makes the
 ;;; FLOAT function return the correct ranges if the input has some
 ;;; defined range.  Quite useful if we want to convert some time of
@@ -450,11 +452,27 @@
     (deftransform name ((x y) '(double-float double-float)
 			rtype :eval-name t :when :both)
       `(,prim x y))))
-
+#+nil
 (deftransform log ((x y) (float float) float)
   '(/ (log x) (log y)))
 
+;;; ANSI says log with base zero returns zero.
+(deftransform log ((x y) (float float) float)
+  '(if (zerop y) y (/ (log x) (log y))))
+
 
+;;; Return the float format of the result of an elementary function.
+;;; If the format is NIL (which means type FLOAT), we return NIL.  If
+;;; the format is 'DOUBLE-FLOAT, we return that.  For any other case,
+;;; we return 'SINGLE-FLOAT.
+  
+(proclaim '(inline elfun-format numeric-type-real-p))  
+(defun elfun-float-format (format)
+  (if format
+      (if (eq format 'double-float)
+	  'double-float
+	  'single-float)))
+
 #+propagate-fun-type
 (progn
 ;;;; Optimizers for elementary functions
@@ -487,18 +505,6 @@
       (float 0 x)))
 
 
-;;; Return the float format of the result of an elementary function.
-;;; If the format is NIL (which means type FLOAT), we return NIL.  If
-;;; the format is 'DOUBLE-FLOAT, we return that.  For any other case,
-;;; we return 'SINGLE-FLOAT.
-  
-(proclaim '(inline elfun-format numeric-type-real-p))  
-(defun elfun-float-format (format)
-  (if format
-      (if (eq format 'double-float)
-	  'double-float
-	  'single-float)))
-
 ;;; The number is of type REAL.
 
 (defun numeric-type-real-p (type)
@@ -520,20 +526,40 @@
 (defmacro elfun-derive-type (num cond limit-fun)
   (let ((type (gensym))
 	(lo-lim (gensym))
-	(hi-lim (gensym)))
+	(hi-lim (gensym))
+	(fp-mode (gensym)))
     `(let ((,type (continuation-type ,num)))
       (when (numeric-type-real-p ,type)
 	(let ((lo (numeric-type-low ,type))
 	      (hi (numeric-type-high ,type)))
 	  (when ,cond
-	    (multiple-value-bind (,lo-lim ,hi-lim)
-		(funcall ,limit-fun lo hi)
-	      (make-numeric-type :class 'float
-				 :format (elfun-float-format
-					  (numeric-type-format ,type))
-				 :complexp :real
-				 :low ,lo-lim
-				 :high ,hi-lim))))))))
+	    (let ((,fp-mode (get-floating-point-modes)))
+	      (unwind-protect
+		   (progn
+		     ;; Disable all traps except for :invalid.  We
+		     ;; want standard IEEE handling to return the
+		     ;; appropriate value which we will handle later.
+		     ;; However, for :invalid, there's probably
+		     ;; nothing we can do about it.  We don't need to
+		     ;; do anything else because we don't check any
+		     ;; other flags and they get restored later.
+		     (set-floating-point-modes :traps '(:invalid))
+
+		     ;; The call to the limit-fun has (most) traps
+		     ;; disabled.  It can naively compute the result,
+		     ;; but it must call set-bound to make sure any
+		     ;; overflow is converted to NIL appropriately.
+		     (multiple-value-bind (,lo-lim ,hi-lim)
+			 (funcall ,limit-fun lo hi)
+		       (make-numeric-type :class 'float
+					  :format (elfun-float-format
+						   (numeric-type-format ,type))
+					  :complexp :real
+					  :low ,lo-lim
+					  :high ,hi-lim)))
+		;; Restore the floating-point modes
+		(apply #'set-floating-point-modes ,fp-mode)
+		))))))))
 
 ;;; Handle these monotonic increasing functions whose domain is
 ;;; possibly part of the real line
@@ -732,24 +758,38 @@
       (multiple-value-bind (lo hi)
 	  (extract-bounds type)
 	(let* ((max-bnd (max-bound (bound-abs lo) (bound-abs hi)))
-	       (min-bnd (min-bound (bound-abs lo) (bound-abs hi))))
-	  (make-numeric-type
-	   :class 'float
-	   :format (elfun-float-format (numeric-type-format type))
-	   :complexp :real
-	   :low (if (and (bound-< lo 0) (bound-< 0 hi))
-		    ;; If zero is in the input domain, then the lower
-		    ;; bound is cosh(0).  Otherwise it's the min of
-		    ;; the bounds.
-		    1
-		    (if (symbolp min-bnd)
-			nil
-			(set-bound (cosh (bound-value min-bnd))
-				   (consp min-bnd))))
-	   :high (if (symbolp max-bnd)
-		     nil
-		     (set-bound (cosh (bound-value max-bnd))
-				(consp max-bnd)))))))))
+	       (min-bnd (min-bound (bound-abs lo) (bound-abs hi)))
+	       (fp-modes (get-floating-point-modes)))
+	  (unwind-protect
+	       (progn
+		 ;; Disable all traps except for :invalid.  We want
+		 ;; standard IEEE handling to return the appropriate
+		 ;; value which we will handle later. However, for
+		 ;; :invalid, there's probably nothing we can do about
+		 ;; it.  We don't need to do anything else because we
+		 ;; don't check any other flags and they get restored
+		 ;; later.
+		 (set-floating-point-modes :traps '(:invalid))
+		 
+		 (make-numeric-type
+		  :class 'float
+		  :format (elfun-float-format (numeric-type-format type))
+		  :complexp :real
+		  :low (if (and (bound-< lo 0) (bound-< 0 hi))
+			   ;; If zero is in the input domain, then the lower
+			   ;; bound is cosh(0).  Otherwise it's the min of
+			   ;; the bounds.
+			   1
+			   (if (symbolp min-bnd)
+			       nil
+			       (set-bound (cosh (bound-value min-bnd))
+					  (consp min-bnd))))
+		  :high (if (symbolp max-bnd)
+			    nil
+			    (set-bound (cosh (bound-value max-bnd))
+				       (consp max-bnd)))))
+	    ;; Restore the floating-point modes
+	    (apply #'set-floating-point-modes fp-modes)))))))
 
 (defoptimizer (phase derive-type) ((num))
   (let ((type (continuation-type num)))
diff --git a/compiler/main.lisp b/compiler/main.lisp
index c7159ffa322769e5f831bae8d54c0ea4583249d3..4cca1630c246c6430f823c8e001f11598714fabc 100644
--- a/compiler/main.lisp
+++ b/compiler/main.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/main.lisp,v 1.108 1997/01/18 14:31:32 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.109 1997/02/05 15:41:53 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -235,12 +235,20 @@
 	(maybe-mumble "Constraint ")
 	(constraint-propagate component))
       (maybe-mumble "Type ")
-      (generate-type-checks component)
-      (unless (or (component-reoptimize component)
-		  (component-reanalyze component)
-		  (component-new-functions component)
-		  (component-reanalyze-functions component))
-	(return))
+      ;; Delay the generation of type checks until the type
+      ;; constraints have had time to propagate, else the compiler can
+      ;; confuse itself.
+      (unless (and (or (component-reoptimize component)
+		       (component-reanalyze component)
+		       (component-new-functions component)
+		       (component-reanalyze-functions component))
+		   (< loop-count (- *reoptimize-after-type-check-max* 2)))
+	      (generate-type-checks component)
+	      (unless (or (component-reoptimize component)
+			  (component-reanalyze component)
+			  (component-new-functions component)
+			  (component-reanalyze-functions component))
+		      (return)))
       (when (>= loop-count *reoptimize-after-type-check-max*)
 	(maybe-mumble "[Reoptimize Limit]")
 	(event reoptimize-maxed-out)
@@ -1541,23 +1549,23 @@
 ;;; exist.
 ;;;
 (defun verify-source-files (stuff)
-  (unless stuff
-    (error "Can't compile with no source files."))
-  (mapcar #'(lambda (x)
-	      (let ((x (pathname x)))
-		(if (probe-file x)
-		    x
-		    (let ((y (merge-pathnames x (make-pathname :type "lisp"))))
-		      (if (probe-file y)
-			  y
-			  (let ((z (merge-pathnames
-				    x
-				    (make-pathname :type "dylan"))))
-			    (if (probe-file z)
-				z
-				(truename y))))))))
-	  (if (listp stuff) stuff (list stuff))))
-
+  (flet ((try-with-type (path type error-p)
+	   (let ((new (merge-pathnames path (make-pathname :type type
+							   :defaults path))))
+	     (if (probe-file new)
+		 new
+		 (and error-p (truename new))))))
+    (unless stuff
+      (error "Can't compile with no source files."))
+    (mapcar #'(lambda (x)
+		(let ((x (pathname x)))
+		  (cond ((logical-pathname-p x)
+			 (try-with-type x "LISP" t))
+			((probe-file x) x)
+			((try-with-type x "lisp"  nil))
+			((try-with-type x "dylan" nil))
+			((try-with-type x "lisp"  t)))))
+	    (if (listp stuff) stuff (list stuff)))))
 
 ;;; COMPILE-FROM-STREAM  --  Public
 ;;;
@@ -1712,22 +1720,23 @@
 	 (error-severity nil)
 	 (source (verify-source-files source))
 	 (source-info (make-file-source-info source))
-	 (default (pathname (first source)))
-	 (diddle-case (logical-pathname-p (pathname default))))
+	 (default (pathname (first source))))
     (unwind-protect
 	(progn
 	  (flet ((frob (file type)
 		   (if (eq file t)
-		       (make-pathname :type (lisp::maybe-diddle-case type diddle-case)
-				      :defaults default)
+		       (make-pathname :type type
+				      :defaults
+				      (if (logical-pathname-p default)
+					  (translate-logical-pathname default)
+					  default))
 		       (pathname file))))
 	    
 	    (when output-file
 	      (setq output-file-name
-		    (frob output-file
-		      (if (eq *byte-compile* t)
-			  (backend-byte-fasl-file-type *backend*)
-			  (backend-fasl-file-type *backend*))))
+		    (compile-file-pathname (first source)
+					   :output-file output-file
+					   :byte-compile *byte-compile*))
 	      (setq fasl-file (open-fasl-file output-file-name
 					      (namestring (first source))
 					      (eq *byte-compile* t))))
@@ -1794,7 +1803,6 @@
 		nil)
 	    (not (null error-severity))
 	    (if (member error-severity '(:warning :error)) t nil))))
-
 
 ;;;; COMPILE and UNCOMPILE:
 
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index e0f3ba99c9265f59f5924f163ee16ddfb930db4c..6093358988f8562715228b5f1bf592b85f9cb18a 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.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/srctran.lisp,v 1.46 1997/01/18 14:31:30 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.47 1997/02/05 15:41:57 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -396,9 +396,12 @@
       b))
 
 (defun set-bound (val exclusive)
-  (if exclusive
-      `(,val)
-      val))
+  (if (and (floatp val)
+	   (float-infinity-p val))
+      nil
+      (if exclusive
+	  `(,val)
+	  val)))
 
 (defun bound-< (x y)
   (cond ((eq x 'pos-inf)
@@ -775,7 +778,7 @@
 					    nil))))))))
 
 
-;; ;; bugged below?? #-propagate-float-type)
+#-propagate-float-type
 (defoptimizer (truncate derive-type) ((number divisor))
   (let ((number-type (continuation-type number))
 	(divisor-type (continuation-type divisor))
@@ -797,34 +800,56 @@
 
 #+propagate-float-type
 (progn
-#+nil
 (defoptimizer (truncate derive-type) ((number divisor))
   (let ((number-type (continuation-type number))
 	(divisor-type (continuation-type divisor))
-	(integer-type (specifier-type '(or integer real))))
+	(real-type (specifier-type '(or integer real))))
     (if (and (numeric-type-p number-type)
-	     (csubtypep number-type integer-type)
+	     (csubtypep number-type real-type)
 	     (numeric-type-p divisor-type)
-	     (csubtypep divisor-type integer-type))
+	     (csubtypep divisor-type real-type))
 	(let ((number-low (numeric-type-low number-type))
 	      (number-high (numeric-type-high number-type))
 	      (divisor-low (numeric-type-low divisor-type))
 	      (divisor-high (numeric-type-high divisor-type)))
-	  (setf number-low (if (consp number-low) (car number-low) number-low))
-	  (setf number-high (if (consp number-high) (car number-high) number-high))
-	  (setf divisor-low (if (consp divisor-low) (car divisor-low) divisor-low))
-	  (setf divisor-high (if (consp divisor-high) (car divisor-high) divisor-high))
-	  (if (csubtypep number-type (specifier-type 'integer))
+	  (setf number-low (if (consp number-low)
+			       (car number-low)
+			       number-low))
+	  (setf number-high (if (consp number-high)
+				(car number-high)
+				number-high))
+	  (setf divisor-low (if (consp divisor-low)
+				(car divisor-low)
+				divisor-low))
+	  (setf divisor-high (if (consp divisor-high)
+				 (car divisor-high)
+				 divisor-high))
+	  (if (and (csubtypep number-type (specifier-type 'integer))
+		   (csubtypep divisor-type (specifier-type 'integer)))
+	      ;; If both the number and the divisor are integers of
+	      ;; some type, then both results of truncate are
+	      ;; integers.  Figure out the appropriate ranges of the
+	      ;; results.
 	      (values-specifier-type
-	       `(values ,(integer-truncate-derive-type number-low number-high
-						       divisor-low divisor-high)
-		        ,(integer-rem-derive-type number-low number-high
-						  divisor-low divisor-high)))
+	       `(values
+		 ,(integer-truncate-derive-type number-low number-high
+						divisor-low divisor-high
+						divisor-type)
+		 ,(integer-rem-derive-type number-low number-high
+					   divisor-low divisor-high)))
+	      ;; Otherwise, the first result of truncate is an integer
+	      ;; and the second result is a float of some type.
+	      ;; Figure out the ranges of the results and their
+	      ;; appropriate types.
 	      (values-specifier-type
-	       `(values ,(integer-truncate-derive-type number-low number-high
-						       divisor-low divisor-high)
-		        ,(real-rem-derive-type number-low number-high
-					       divisor-low divisor-high)))))
+	       `(values
+		 ,(integer-truncate-derive-type number-low number-high
+						divisor-low divisor-high
+						divisor-type)
+		 ,(real-rem-derive-type number-low number-high
+					divisor-low divisor-high
+					number-type
+					divisor-type)))))
 	*universal-type*)))
 
 (defoptimizer (%unary-truncate derive-type) ((number))
@@ -832,12 +857,19 @@
     (if (and (numeric-type-p number-type)
 	     (csubtypep number-type (specifier-type 'real)))
 	(let ((number-low (numeric-type-low number-type))
-	      (number-high (numeric-type-high number-type)))
-	  (setf number-low (if (consp number-low) (car number-low) number-low))
-	  (setf number-high (if (consp number-high) (car number-high) number-high))
-	  (values-specifier-type
-	   `(values ,(integer-truncate-derive-type number-low number-high 1 1)
-	     ,(real-rem-derive-type number-low number-high 1 1))))
+	      (number-high (numeric-type-high number-type))
+	      (divisor (make-numeric-type
+			:class 'integer
+			:low 1
+			:high 1)))
+	  (setf number-low (if (consp number-low)
+			       (car number-low)
+			       number-low))
+	  (setf number-high (if (consp number-high)
+				(car number-high)
+				number-high))
+	  (specifier-type `,(integer-truncate-derive-type
+			     number-low number-high 1 1 divisor)))
 	*universal-type*)))
 )
 
@@ -924,7 +956,7 @@
 	     ;; The number we are dividing is unbounded, so we can't tell
 	     ;; anything about the result.
 	     'integer)))))
-
+	  
 (defun integer-rem-derive-type
        (number-low number-high divisor-low divisor-high)
   (if (and divisor-low divisor-high)
@@ -957,101 +989,152 @@
 #+propagate-float-type
 (progn
 (defun integer-truncate-derive-type
-       (number-low number-high divisor-low divisor-high)
+    (number-low number-high divisor-low divisor-high divisor-type)
   ;; The result cannot be larger in magnitude than the number, but the sign
   ;; might change.  If we can determine the sign of either the number or
   ;; the divisor, we can eliminate some of the cases.
-  (multiple-value-bind
-      (number-sign number-min number-max)
-      (numeric-range-info number-low number-high)
+  (macrolet ((maybe* (form)
+	       ;; return result of form or * if overflow occurs
+	       `(handler-case ,form
+		  (arithmetic-error () '*))))
     (multiple-value-bind
-	(divisor-sign divisor-min divisor-max)
-	(numeric-range-info divisor-low divisor-high)
-      (when (and divisor-max (zerop divisor-max))
-	;; We've got a problem: guarenteed division by zero.
-	(return-from integer-truncate-derive-type t))
-      (when (zerop divisor-min)
-	;; We'll assume that they arn't going to divide by zero.
-	(if (integerp divisor-min)
-	    (incf divisor-min)
-	    (incf divisor-min (if (typep divisor-min 'single-float)
-				  least-positive-normalized-single-float
-				  least-positive-normalized-double-float))))
-      (cond ((and number-sign divisor-sign)
-	     ;; We know the sign of both.
-	     (if (eq number-sign divisor-sign)
-		 ;; Same sign, so the result will be positive.
-		 `(integer ,(if divisor-max
-				(truncate number-min divisor-max)
-				0)
-			   ,(if number-max
-				(truncate number-max divisor-min)
-				'*))
-		 ;; Different signs, the result will be negative.
-		 `(integer ,(if number-max
-				(- (truncate number-max divisor-min))
-				'*)
-			   ,(if divisor-max
-				(- (truncate number-min divisor-max))
-				0))))
-	    ((eq divisor-sign '+)
-	     ;; The divisor is positive.  Therefore, the number will just
-	     ;; become closer to zero.
-	     `(integer ,(if number-low
-			    (truncate number-low divisor-min)
-			    '*)
-		       ,(if number-high
-			    (truncate number-high divisor-min)
-			    '*)))
-	    ((eq divisor-sign '-)
-	     ;; The divisor is negative.  Therefore, the absolute value of
-	     ;; the number will become closer to zero, but the sign will also
-	     ;; change.
-	     `(integer ,(if number-high
-			    (- (truncate number-high divisor-min))
-			    '*)
-		       ,(if number-low
-			    (- (truncate number-low divisor-min))
-			    '*)))
-	    ;; The divisor could be either positive or negative.
-	    (number-max
-	     ;; The number we are dividing has a bound.  Divide that by the
-	     ;; smallest posible divisor.
-	     (let ((bound (truncate number-max divisor-min)))
-	       `(integer ,(- bound) ,bound)))
-	    (t
-	     ;; The number we are dividing is unbounded, so we can't tell
-	     ;; anything about the result.
-	     'integer)))))
-	  
+	(number-sign number-min number-max)
+	(numeric-range-info number-low number-high)
+      (multiple-value-bind
+	  (divisor-sign divisor-min divisor-max)
+	  (numeric-range-info divisor-low divisor-high)
+	(when (and divisor-max (zerop divisor-max))
+	  ;; We've got a problem: guarenteed division by zero.
+	  (return-from integer-truncate-derive-type t))
+	(when (zerop divisor-min)
+	  ;; We'll assume that they aren't going to divide by zero.  Set
+	  ;; divisor min to be the smallest positive number of the
+	  ;; appropriate type.  (Does this really make sense for floats?
+	  ;; Let's go with it for now.)
+	  (setf divisor-min
+		(cond ((csubtypep divisor-type (specifier-type 'integer))
+		       1)
+		      ((csubtypep divisor-type (specifier-type 'double-float))
+		       least-positive-normalized-double-float)
+		      ((csubtypep divisor-type (specifier-type 'real))
+		       least-positive-normalized-single-float)
+		      (t
+		       (cerror "Return INTEGER as result of truncate"
+			       "This should not have happened!")
+		       (return-from integer-truncate-derive-type t)))))
+	(cond ((and number-sign divisor-sign)
+	       ;; We know the sign of both.
+	       (if (eq number-sign divisor-sign)
+		   ;; Same sign, so the result will be positive.
+		   `(integer
+		     ,(if divisor-max
+			  (maybe* (truncate number-min divisor-max))
+			  0)
+		     ,(if number-max
+			  (maybe* (truncate number-max divisor-min))
+			  '*))
+		   ;; Different signs, the result will be negative.
+		   `(integer
+		     ,(if number-max
+			  (maybe* (- (truncate number-max divisor-min)))
+			  '*)
+		     ,(if divisor-max
+			  (maybe* (- (truncate number-min divisor-max)))
+			  0))))
+	      ((eq divisor-sign '+)
+	       ;; The divisor is positive.  Therefore, the number will just
+	       ;; become closer to zero.
+	       `(integer
+		 ,(if number-low
+		      (maybe* (truncate number-low divisor-min))
+		      '*)
+		 ,(if number-high
+		      (maybe* (truncate number-high divisor-min))
+		      '*)))
+	      ((eq divisor-sign '-)
+	       ;; The divisor is negative.  Therefore, the absolute value of
+	       ;; the number will become closer to zero, but the sign will also
+	       ;; change.
+	       `(integer
+		 ,(if number-high
+		      (maybe* (- (truncate number-high divisor-min)))
+		      '*)
+		 ,(if number-low
+		      (maybe* (- (truncate number-low divisor-min)))
+		      '*)))
+	      ;; The divisor could be either positive or negative.
+	      (number-max
+	       ;; The number we are dividing has a bound.  Divide that by the
+	       ;; smallest posible divisor.
+	       (let ((bound (maybe* (truncate number-max divisor-min))))
+		 (if (numberp bound)
+		     `(integer ,(- bound) ,bound)
+		     `integer)))
+	      (t
+	       ;; The number we are dividing is unbounded, so we can't tell
+	       ;; anything about the result.
+	       'integer))))))
+
+;;; This probably needs a lot of reworking to make sure everything is
+;;; covered.
 (defun real-rem-derive-type
-       (number-low number-high divisor-low divisor-high)
-  (if (and divisor-low divisor-high)
-      ;; We know the range of the divisor, and the remainder must be smaller
-      ;; than the divisor.  We can tell the sign of the remainer if we know
-      ;; the sign of the number.
-      (let ((divisor-max (float (max (abs divisor-low) (abs divisor-high)))))
-	`(float ,(if (or (null number-low)
-			   (minusp number-low))
-		       (- divisor-max)
-		       0.0)
-		  ,(if (or (null number-high)
-			   (plusp number-high))
-		       divisor-max
-		       0.0)))
-      ;; The divisor is potentially either very positive or very negative.
-      ;; Therefore, the remainer is unbounded, but we might be able to tell
-      ;; something about the sign from the number.
-      `(float ,(if (and number-low (not (minusp number-low)))
-		     ;; The number we are dividing is positive.  Therefore,
-		     ;; the remainder must be positive.
-		     0.0
-		     '*)
-		,(if (and number-high (not (plusp number-high)))
-		     ;; The number we are dividing is negative.  Therefore,
-		     ;; the remainder must be negative.
-		     0.0
-		     '*))))
+    (number-low number-high divisor-low divisor-high number-type divisor-type)
+  ;; First figure out what the type of the result should be.
+  (let* ((result-type
+	  (cond ((csubtypep number-type (specifier-type 'integer))
+		 ;; If NUMBER is an integer, the result must be the
+		 ;; type of the divisor.  A numeric-type-format of nil
+		 ;; means either REAL or COMPLEX, but we know at this
+		 ;; point the numbers are not complex.
+		 (or (numeric-type-format divisor-type)
+		     'real))
+		((csubtypep divisor-type (specifier-type 'integer))
+		 ;; The divisor is an integer, so the result must be
+		 ;; the type of the number.
+		 (or (numeric-type-format number-type)
+		     'real))
+		(t
+		 ;; Hmm, neither are integers, so we take the largest format
+		 (or (float-format-max (numeric-type-format number-type)
+				   (numeric-type-format divisor-type))
+		     'real)))))
+    ;; Without the following sexp, RESULT-TYPE can sometimes be NIL!
+    ;; How can that be?  The above code looks like it always returns
+    ;; something besides nil!
+    (unless result-type
+      (setf result-type 'real)
+      (cerror "Use REAL as result type" "Shouldn't happen!  Result type was NIL"))
+    (if (and divisor-low divisor-high)
+	;; We know the range of the divisor, and the remainder must be smaller
+	;; than the divisor.  We can tell the sign of the remainer if we know
+	;; the sign of the number.
+	(let ((divisor-max (float (max (abs divisor-low) (abs divisor-high)))))
+	  `(,result-type ,(coerce (if (or (null number-low)
+					  (minusp number-low))
+				      (- divisor-max)
+				      0.0)
+				  result-type)
+	                  ,(coerce (if (or (null number-high)
+					   (plusp number-high))
+				       divisor-max
+				       0.0)
+				   result-type)))
+	;; The divisor is potentially either very positive or very negative.
+	;; Therefore, the remainer is unbounded, but we might be able to tell
+	;; something about the sign from the number.
+	`(,result-type ,(if (and number-low
+				 (not (minusp number-low)))
+			    ;; The number we are dividing is positive.
+			    ;; Therefore, the remainder must be
+			    ;; positive.
+			    (coerce 0.0 result-type)
+			    '*)
+	               ,(if (and number-high (not (plusp number-high)))
+			    ;; The number we are dividing is negative.
+			    ;; Therefore, the remainder must be
+			    ;; negative.
+			    (coerce 0.0 result-type)
+			    '*)))))
 )
 
 (defoptimizer (random derive-type) ((bound &optional state))