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