diff --git a/code/exports.lisp b/code/exports.lisp
index 7383898600261224ea71561cab3d375a096eb881..354ba4e519a2dd258cd86b235f6d1025badd775d 100644
--- a/code/exports.lisp
+++ b/code/exports.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/exports.lisp,v 1.123 1997/08/25 19:18:23 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.124 1997/08/30 18:21:34 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -961,6 +961,7 @@
              "TRANSLATE-MOUSE-KEY-EVENT" "TRULY-THE" "UNCOMPILE"
              "UNDEFINED-VALUE" "UNENCAPSULATE" "UNIX-NAMESTRING" "WEAK-POINTER"
              "WEAK-POINTER-P" "WEAK-POINTER-VALUE" "WITH-CLX-EVENT-HANDLING"
+	     "WITH-FLOAT-TRAPS-MASKED"
 	     "FEATUREP" "*IGNORE-EXTRA-CLOSE-PARENTHESES*" "*HERALD-ITEMS*"
 	     "SEARCH-LIST-DEFINED-P" "BYTES-CONSED-BETWEEN-GCS"
 	     "*LOAD-SOURCE-TYPES*" "*LOAD-OBJECT-TYPES*"
diff --git a/code/float-trap.lisp b/code/float-trap.lisp
index ce6ea5bdaa53efeb511ee974e82c2beb5671f8d2..b7b15c296be1f139764975494b0c7ba1e2b92ba3 100644
--- a/code/float-trap.lisp
+++ b/code/float-trap.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/float-trap.lisp,v 1.9 1997/01/18 14:30:52 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.10 1997/08/30 18:21:32 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,7 +18,8 @@
 (in-package "VM")
 (export '(current-float-trap floating-point-modes sigfpe-handler))
 (in-package "EXTENSIONS")
-(export '(set-floating-point-modes get-floating-point-modes))
+(export '(set-floating-point-modes get-floating-point-modes
+	  with-float-traps-masked))
 (in-package "VM")
 
 (eval-when (compile load eval)
@@ -194,4 +195,19 @@
 	  (t
 	   (error "SIGFPE with no exceptions currently enabled?")))))
 
-
+;;; WITH-FLOAT-TRAPS-MASKED  --  Public
+;;;
+(defmacro with-float-traps-masked (traps &body body)
+  (let ((trap-mask (dpb (lognot (float-trap-mask traps))
+			float-traps-byte #xffffffff))
+	(exception-mask (dpb (lognot (vm::float-trap-mask traps))
+			     float-exceptions-byte #xffffffff)))
+    `(let ((orig-modes (floating-point-modes)))
+      (unwind-protect
+	   (progn
+	     (setf (floating-point-modes) (logand orig-modes ,trap-mask))
+	     ,@body)
+	(setf (floating-point-modes)
+	      (logand (logior (floating-point-modes)
+			      (mask-field float-traps-byte orig-modes))
+		      ,exception-mask))))))
diff --git a/code/irrat.lisp b/code/irrat.lisp
index 7cd3974e696e6095758f3281548241c10e3f1ac4..c573566c1291f9c1764d6fffedee017e1c8d1ec5 100644
--- a/code/irrat.lisp
+++ b/code/irrat.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/irrat.lisp,v 1.20 1997/08/26 18:00:24 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.21 1997/08/30 18:21:36 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -610,7 +610,6 @@
 ;;;;
 ;;;; Internal functions:
 ;;;;    square coerce-to-complex-type cssqs complex-log-scaled
-;;;;    suppress-divide-by-zero
 ;;;;
 ;;;;
 ;;;; Please send any bug reports, comments, or improvements to Raymond
@@ -687,49 +686,41 @@ and Y are coerced to single-float."
 	       (float y 1.0))))
 
 (defun cssqs (z)
-  ;; Compute |x+i*y|^2/2^k carefully.  The result is r + i*k, where k
-  ;; is an integer.
+  ;; Compute |(x+i*y)/2^k|^2 scaled to avoid over/underflow. The
+  ;; result is r + i*k, where k is an integer.
   
   ;; Save all FP flags
-  (let* ((fp-modes (get-floating-point-modes))
-	 (x (float (realpart z) 1d0))
-	 (y (float (imagpart z) 1d0))
-	 (k 0)
-	 (rho 0d0)
-	 )
+  (let ((x (float (realpart z) 1d0))
+	(y (float (imagpart z) 1d0))
+	(k 0)
+	(rho 0d0))
     (declare (double-float x y)
 	     (type (double-float 0d0) rho)
 	     (fixnum k))
-    (unwind-protect
-	 (progn
-	   ;; Would this be better handled using an exception handler
-	   ;; to catch the overflow or underflow signal?  For now, we
-	   ;; turn all traps off and look at the accrued exceptions to
-	   ;; see if any signal would have been raised.
-
-	   (set-floating-point-modes :traps nil :accrued-exceptions nil)
-
-	   (setf rho (+ (square x) (square y)))
-	   (cond ((and (or (float-trapping-nan-p rho)
-			   (float-infinity-p rho))
-		       (or (float-infinity-p (abs x))
-			   (float-infinity-p (abs y))))
-		  (setf rho #.ext:double-float-positive-infinity))
-		 ((let* ((exceptions (getf (get-floating-point-modes)
-					   :accrued-exceptions))
-			 (threshold #.(/ least-positive-double-float
-					 double-float-epsilon)))
-		    ;; overflow raised or (underflow raised and rho <
-		    ;; lambda/eps)
-		    (or (member :overflow exceptions)
-			(and (member :underflow exceptions)
-			     (< rho threshold))))
-		  (setf k (logb (max (abs x) (abs y))))
-		  (setf rho (+ (square (scalb x (- k)))
-			       (square (scalb y (- k)))))))
-	   (values rho k))
-      ;; restore over/underflow flags
-      (apply #'set-floating-point-modes fp-modes))))
+    ;; Would this be better handled using an exception handler to
+    ;; catch the overflow or underflow signal?  For now, we turn all
+    ;; traps off and look at the accrued exceptions to see if any
+    ;; signal would have been raised.
+    (with-float-traps-masked (:underflow :overflow)
+      (setf rho (+ (square x) (square y)))
+      (cond ((and (or (float-trapping-nan-p rho)
+		      (float-infinity-p rho))
+		  (or (float-infinity-p (abs x))
+		      (float-infinity-p (abs y))))
+	     (setf rho #.ext:double-float-positive-infinity))
+	    ((let ((threshold #.(/ least-positive-double-float
+				   double-float-epsilon))
+		   (traps (ldb vm::float-exceptions-byte
+			       (vm:floating-point-modes))))
+	       ;; Overflow raised or (underflow raised and rho <
+	       ;; lambda/eps)
+	       (or (not (zerop (logand vm:float-overflow-trap-bit traps)))
+		   (and (not (zerop (logand vm:float-underflow-trap-bit traps)))
+			(< rho threshold))))
+	     (setf k (logb (max (abs x) (abs y))))
+	     (setf rho (+ (square (scalb x (- k)))
+			  (square (scalb y (- k))))))))
+    (values rho k)))
 
 (defun complex-sqrt (z)
   "Principle square root of Z
@@ -916,22 +907,6 @@ Z may be any number, but the result is always a complex."
 ;; However, we take a pragmatic approach and just use the whole
 ;; expression.
 
-;; This macro suppresses any divide-by-zero errors in the body.  After
-;; execution of the body, the floating point modes are returned as
-;; they were before entry.
-
-(defmacro suppress-divide-by-zero (&body body)
-  (let ((fp-modes (gensym)))
-    `(let ((,fp-modes (get-floating-point-modes)))
-      (unwind-protect
-	   (progn
-	     ;; Remove the divide-by-zero trap but leave everything
-	     ;; else undisturbed.
-	     (set-floating-point-modes
-	      :traps (remove :divide-by-zero (getf ,fp-modes :traps)))
-	     ,@body)
-	(apply #'set-floating-point-modes ,fp-modes)))))
-
 ;; NOTE: The formula given by Kahan is somewhat ambiguous in whether
 ;; it's the conjugate of the square root or the square root of the
 ;; conjugate.  This needs to be checked.
@@ -953,11 +928,11 @@ Z may be any number, but the result is always a complex."
   (declare (number z))
   (let ((sqrt-1+z (complex-sqrt (+ 1 z)))
 	(sqrt-1-z (complex-sqrt (- 1 z))))
-    (suppress-divide-by-zero
-     (complex (* 2 (atan (/ (realpart sqrt-1-z)
-			    (realpart sqrt-1+z))))
-	      (asinh (imagpart (* (conjugate sqrt-1+z)
-				  sqrt-1-z)))))))
+    (with-float-traps-masked (:divide-by-zero)
+      (complex (* 2 (atan (/ (realpart sqrt-1-z)
+			     (realpart sqrt-1+z))))
+	       (asinh (imagpart (* (conjugate sqrt-1+z)
+				   sqrt-1-z)))))))
 
 (defun complex-acosh (z)
   "Compute acosh z = 2 * log(sqrt((z+1)/2) + sqrt((z-1)/2))
@@ -966,11 +941,11 @@ Z may be any number, but the result is always a complex."
   (declare (number z))
   (let ((sqrt-z-1 (complex-sqrt (- z 1)))
 	(sqrt-z+1 (complex-sqrt (+ z 1))))
-    (suppress-divide-by-zero
-     (complex (asinh (realpart (* (conjugate sqrt-z-1)
-				  sqrt-z+1)))
-	      (* 2 (atan (/ (imagpart sqrt-z-1)
-			    (realpart sqrt-z+1))))))))
+    (with-float-traps-masked (:divide-by-zero)
+      (complex (asinh (realpart (* (conjugate sqrt-z-1)
+				   sqrt-z+1)))
+	       (* 2 (atan (/ (imagpart sqrt-z-1)
+			     (realpart sqrt-z+1))))))))
 
 
 (defun complex-asin (z)
@@ -980,11 +955,11 @@ Z may be any number, but the result is always a complex."
   (declare (number z))
   (let ((sqrt-1-z (complex-sqrt (- 1 z)))
 	(sqrt-1+z (complex-sqrt (+ 1 z))))
-    (suppress-divide-by-zero
-     (complex (atan (/ (realpart z)
-		       (realpart (* sqrt-1-z sqrt-1+z))))
-	      (asinh (imagpart (* (conjugate sqrt-1-z)
-				  sqrt-1+z)))))))
+    (with-float-traps-masked (:divide-by-zero)
+      (complex (atan (/ (realpart z)
+			(realpart (* sqrt-1-z sqrt-1+z))))
+	       (asinh (imagpart (* (conjugate sqrt-1-z)
+				   sqrt-1+z)))))))
 
 (defun complex-asinh (z)
   "Compute asinh z = log(z + sqrt(1 + z*z))
diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index dc1889437c1f68cb432b14594b02335cf2a64756..d17755a3f752f51f5d3ad9f30bd877c1cedb63cf 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.31 1997/06/11 18:32:24 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.32 1997/08/30 18:21:39 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -528,46 +528,38 @@
 (defmacro elfun-derive-type (num cond limit-fun)
   (let ((type (gensym))
 	(lo-lim (gensym))
-	(hi-lim (gensym))
-	(fp-mode (gensym)))
+	(hi-lim (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
-	    (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,
-		     ;; and return infinity for the value.  We convert
-		     ;; the infinity to nil, as needed.
-		     (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 (if (and (floatp ,lo-lim)
-							(float-infinity-p ,lo-lim))
-						   nil
-						   ,lo-lim)
-					  :high (if (and (floatp ,hi-lim)
-							 (float-infinity-p ,hi-lim))
-						    nil
-						    ,hi-lim))))
-		;; Restore the floating-point modes
-		(apply #'set-floating-point-modes ,fp-mode)
-		))))))))
+	    ;; 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.
+	    (with-float-traps-masked (:underflow :overflow :inexact
+				      :divide-by-zero)
+	      ;; The call to the limit-fun has (most) traps disabled.
+	      ;; It can naively compute the result, and return
+	      ;; infinity for the value.  We convert the infinity to
+	      ;; nil, as needed.
+	      (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 (if (and (floatp ,lo-lim)
+						 (float-infinity-p ,lo-lim))
+					    nil
+					    ,lo-lim)
+				   :high (if (and (floatp ,hi-lim)
+						  (float-infinity-p ,hi-lim))
+					     nil
+					     ,hi-lim))))))))))
 
 ;;; Handle these monotonic increasing functions whose domain is
 ;;; possibly part of the real line
@@ -755,38 +747,32 @@
       (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)))
-	       (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)))))))
+	       (min-bnd (min-bound (bound-abs lo) (bound-abs hi))))
+	  ;; 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.
+	  (with-float-traps-masked (:underflow :overflow :inexact
+				    :divide-by-zero)
+	    (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))))))))))
 
 (defoptimizer (cosh derive-type) ((num))
   (elfun-derive-type
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index a81d4475375d4214d140450e071283f9099febdc..a6d778ff5b4e34b50c53773f82681d7a1a09b43c 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.52 1997/06/16 18:51:33 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.53 1997/08/30 18:21:40 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -296,17 +296,6 @@
     (%make-interval :low (normalize-bound low)
 		    :high (normalize-bound high))))
 
-(defmacro without-over/under-flow-traps (&body body)
-  "Executes BODY with traps on overflow, underflow, and divide-by-zero
-turned off"
-  (let ((modes (gensym)))
-    `(let ((,modes (ext:get-floating-point-modes)))
-      (unwind-protect
-	   (progn
-	     (ext:set-floating-point-modes :traps '(:invalid))
-	     ,@body)
-	(apply #'ext:set-floating-point-modes ,modes)))))
-
 (proclaim '(inline bound-value set-bound bound-func))
 
 ;;; Extract the numeric value of a bound.  Return NIL, if X is NIL.
@@ -322,15 +311,15 @@ turned off"
 ;;; the result will be open.  IF X is NIL, the result is NIL.
 (defun bound-func (f x)
   (and x
-       (without-over/under-flow-traps
-        (set-bound (funcall f (bound-value x)) (consp x)))))
+       (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
+	 (set-bound (funcall f (bound-value x)) (consp x)))))
 
 ;;; Apply a binary operator OP to two bounds X and Y.  The result is
 ;;; NIL if either is NIL.  Otherwise bound is computed and the result
 ;;; is open if either X or Y is open.
 (defmacro bound-binop (op x y)
   `(and ,x ,y
-        (without-over/under-flow-traps
+       (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
 	 (set-bound (,op (bound-value ,x)
 			 (bound-value ,y))
 	            (or (consp ,x) (consp ,y))))))