diff --git a/code/float-trap.lisp b/code/float-trap.lisp
index 8839d4bc898dd401c990d328914af52bdcfeb3ed..a8b8009d8fa0386834323580ac5c6fd25674bd67 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.17 2001/12/06 19:15:40 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.18 2002/01/13 18:25:59 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -48,6 +48,11 @@
 	(cons :zero float-round-to-zero)
 	(cons :positive-infinity float-round-to-positive)
 	(cons :negative-infinity float-round-to-negative)))
+
+(defconstant precision-control-alist
+  (list (cons :24-bit float-precision-24-bit)
+	(cons :53-bit float-precision-53-bit)
+	(cons :64-bit float-precision-64-bit)))
   
 ); Eval-When (Compile Load Eval)
 
@@ -64,7 +69,8 @@
 				      (rounding-mode nil round-p)
 				      (current-exceptions nil current-x-p)
 				      (accrued-exceptions nil accrued-x-p)
-				      (fast-mode nil fast-mode-p))
+				      (fast-mode nil fast-mode-p)
+				      (precision-control nil precision-control-p))
   "This function sets options controlling the floating-point hardware.  If a
   keyword is not supplied, then the current value is preserved.  Possible
   keywords:
@@ -90,6 +96,11 @@
        conformance or debuggability may be impaired.  Some machines may not
        have this feature, in which case the value is always NIL.
 
+   :PRECISION-CONTROL
+       On the x86 architecture, you can set the precision of the arithmetic
+       to :24-BIT, :53-BIT, or :64-BIT mode, corresponding to IEEE single
+       precision, double precision, and extended double precision.
+
    GET-FLOATING-POINT-MODES may be used to find the floating point modes
    currently in effect."
   (let ((modes (floating-point-modes)))
@@ -109,6 +120,15 @@
       (if fast-mode
 	  (setq modes (logior float-fast-bit modes))
 	  (setq modes (logand (lognot float-fast-bit) modes))))
+    #+x86
+    (when precision-control-p
+      (setf (ldb float-precision-control modes)
+	    (or (cdr (assoc precision-control precision-control-alist))
+		(error "Unknown precision mode: ~S." precision-control))))
+    #-x86
+    (when precision-control-p
+      (warn "Precision control only available for x86"))
+    
     (setf (floating-point-modes) modes))
     
   (values))
@@ -138,7 +158,13 @@
 				     rounding-mode-alist))
 	:current-exceptions ,(exc-keys (ldb float-exceptions-byte modes))
 	:accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes))
-	:fast-mode ,(logtest float-fast-bit modes)))))
+	:fast-mode ,(logtest float-fast-bit modes)
+	#+x86
+	:precision-control
+	#+x86
+	,(car (rassoc (ldb float-precision-control modes)
+		      precision-control-alist))
+	))))
 
   
 ;;; CURRENT-FLOAT-TRAP  --  Interface
diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 18dc12816a87c532420882457f3337d3fcfda8e9..76f58f694f79d3b009aef9349a9db95af8c4f9df 100644
--- a/compiler/x86/parms.lisp
+++ b/compiler/x86/parms.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/parms.lisp,v 1.16 2000/10/16 17:30:08 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.17 2002/01/13 18:26:00 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -156,6 +156,10 @@
 (defconstant float-round-to-positive 2)
 (defconstant float-round-to-zero     3)
 
+(defconstant float-precision-24-bit  0)
+(defconstant float-precision-53-bit  2)
+(defconstant float-precision-64-bit  3)
+
 (defconstant float-rounding-mode   (byte 2 10))
 (defconstant float-sticky-bits     (byte 6 16))
 (defconstant float-traps-byte      (byte 6  0))