From d88bcbc71aa7cd980f39b9965b240a00306b4fce Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 4 Oct 2007 19:58:20 +0000 Subject: [PATCH] The floating point precision was always getting reset to :53-bit, even if the user set a different value. Fix this so the correct precision is restored. compiler/x86/parms.lisp: o Add new static-symbol *FPU-PRECISION* to hold the precision bits that are given in (setf floating-point-modes). compiler/x86/float.lisp: o Whenever (setf floating-point-modes) is called, save the precision bits to *FPU-PRECISION* so that get restored correctly in DEALLOC-NUMBER-STACK-SPACE. compiler/x86/c-call.lisp: o Update DEALLOC-NUMBER-STACK-SPACE VOP so that when float-accuracy policy says so, we restore the precision from *fpu-precision*, instead of always making it :53-bit. code/lispinit.lisp: o Initialize the default precision to :53-bit on startup. --- code/lispinit.lisp | 5 +++-- compiler/x86/c-call.lisp | 31 ++++++++++++++++++++++++++++++- compiler/x86/float.lisp | 11 ++++++++++- compiler/x86/parms.lisp | 6 +++--- 4 files changed, 46 insertions(+), 7 deletions(-) diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 4cd582c65..9c96c0de3 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 c3916b0b8..e2338f17a 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 e8d33b888..511453b64 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 4d0e51e9e..27448d413 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 -- GitLab