Commit d88bcbc7 authored by rtoy's avatar rtoy
Browse files

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.
parent 55e2e65b
......@@ -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)
......
......@@ -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)))
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment