diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index 4cd582c65608e34dc5d368e9546e19ea62c19fff..9c96c0de3b0e002a49d7c8cf0f29f4e05997dfb4 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.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/lispinit.lisp,v 1.76 2006/06/30 18:41:22 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.77 2007/10/04 19:58:19 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -400,7 +400,8 @@
   (print-and-call kernel::signal-init)
   (setf (alien:extern-alien "internal_errors_enabled" boolean) t)
 
-  (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))
+  (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)
+			    #+x86 :precision-control #+x86 :53-bit)
   ;; This is necessary because some of the initial top level forms might
   ;; have changed the compilation policy in strange ways.
   (print-and-call c::proclaim-init)
diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp
index c3916b0b8e5547917e2aed7f8fb67c6a5f42b829..e2338f17ab36441b56892bbb4dcce1dec6163af0 100644
--- a/compiler/x86/c-call.lisp
+++ b/compiler/x86/c-call.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/c-call.lisp,v 1.17 2007/07/06 08:04:39 cshapiro Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.18 2007/10/04 19:58:20 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -276,6 +276,7 @@
     #+darwin (inst and esp-tn #xfffffff0)
     (move result esp-tn)))
 
+#+nil
 (define-vop (dealloc-number-stack-space)
   (:info amount)
   (:node-var node)
@@ -292,6 +293,34 @@
       (inst wait)
       (inst add esp-tn 4))))
 
+(define-vop (dealloc-number-stack-space)
+  (:info amount)
+  (:node-var node)
+  (:temporary (:sc unsigned-reg) precision)
+  (:temporary (:sc word-reg) cw)
+  (:generator 0
+    (unless (zerop amount)
+      (let ((delta (logandc2 (+ amount 3) 3)))
+	(inst add esp-tn delta)))
+    ;; Reset the rounding precision to 53-bits
+    (when (policy node (= float-accuracy 3))
+      (inst fnstcw (make-ea :word :base esp-tn))
+      (load-symbol-value precision *fpu-precision*)
+      (inst sar precision 2)		; Remove fixnum tag bits
+      (inst wait)
+      ;; Clear the precision bits so we can fill them in with our
+      ;; desired precision value.
+      (inst mov cw (make-ea :word :base esp-tn))
+      (inst and cw #xfcff)
+      (inst or cw
+	    (make-random-tn :kind :normal
+			    :sc (sc-or-lose 'word-reg *backend*)
+			    :offset (tn-offset precision)))
+      (inst mov (make-ea :word :base esp-tn) cw)
+      (inst fldcw (make-ea :word :base esp-tn))
+      (inst wait)
+      (inst add esp-tn 4))))
+
 (define-vop (alloc-alien-stack-space)
   (:info amount)
   (:results (result :scs (sap-reg any-reg)))
diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index e8d33b8882f555e665159ab854847cf8934f2f31..511453b64570deef9519b59acade730fd0d227d2 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.49 2007/04/14 14:10:08 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.50 2007/10/04 19:58:20 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2276,6 +2276,9 @@
 (defconstant npx-cw-offset 0)
 (defconstant npx-sw-offset 4)
 
+(defvar *fpu-precision*
+  (dpb float-precision-53-bit float-precision-control 0))
+
 (define-vop (floating-point-modes)
   (:results (res :scs (unsigned-reg)))
   (:result-types unsigned-num)
@@ -2310,6 +2313,12 @@
    (inst wait)                          ; Catch any pending FPE exceptions
    (inst fstenv (make-ea :dword :base esp-tn))
    (inst mov eax new)
+   ;; Save precision bits so we can restore them properly
+   (inst and eax #x300)
+   (inst shl eax 2)			; Convert to fixnum
+   (store-symbol-value eax *fpu-precision*)
+   ;; Now set the desired mode
+   (inst mov eax new)
    (inst xor eax #x3f)	    ; turn trap enable bits into exception mask
    (inst mov (make-ea :word :base esp-tn :disp npx-cw-offset) ax-tn)
    (inst shr eax 16)			; position status word
diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 4d0e51e9e27391f11249a4134e5a2381ea0b97de..27448d4137aab93cf453ae61b2eb29ca6ff79c55 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.32 2007/07/06 08:04:39 cshapiro Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.33 2007/10/04 19:58:20 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -332,10 +332,10 @@
       :value
       :key-and-value
       :key-or-value
-      
+
+      *fpu-precision*
       ;; Spare symbols.  Rename these when you need to add some static
       ;; symbols and don't want to do a cross-compile.
-      spare-9
       spare-8
       spare-7
       spare-6