From: Christophe Rhodes Date: Tue, 8 Jun 2004 14:49:14 +0000 (+0000) Subject: 0.8.11.4: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3a618201c9f2370bb8784217a866d000371769e5;p=sbcl.git 0.8.11.4: FINALLY! Fixed bugs related to DOUBLE-FLOAT-EPSILON on x86. Die, bug #45, die a horrible death. ... make lisp code run with the fpu set to 53-bit mantissa; ... add code in number stack allocation to set the fpu to 64-bit precision when calling out to C, conditional on new optimization quality SB-C::FLOAT-ACCURACY (unexported, undocumented, etc) ... use FLOAT-ACCURACY around syscalls, since they don't involve the FPU. Also add code to allow fpu precision control in the (nominally private) sb-int:set-floating-point-modes. (this checkin fixes not only bugs #45 and #118, but also six of PFD's EPSILONS tests and 29 ieeefp-tests related to +, -, *, / and sqrt) --- diff --git a/BUGS b/BUGS index e41f9e5..3385eaa 100644 --- a/BUGS +++ b/BUGS @@ -156,25 +156,6 @@ WORKAROUND: so they could be supported after all. Very likely SIGCONTEXT-FLOATING-POINT-MODES could now be supported, too. -45: - a slew of floating-point-related errors reported by Peter Van Eynde - on July 25, 2000: - c: Many expressions generate floating infinity on x86/Linux: - (/ 1 0.0) - (/ 1 0.0d0) - (EXPT 10.0 1000) - (EXPT 10.0d0 1000) - PVE's regression tests want them to raise errors. sbcl-0.7.0.5 - on x86/Linux generates the infinities instead. That might or - might not be conforming behavior, but it's also inconsistent, - which is almost certainly wrong. (Inconsistency: (/ 1 0.0) - should give the same result as (/ 1.0 0.0), but instead (/ 1 0.0) - generates SINGLE-FLOAT-POSITIVE-INFINITY and (/ 1.0 0.0) - signals an error. - d: (in section12.erg) various forms a la - (FLOAT 1 DOUBLE-FLOAT-EPSILON) - don't give the right behavior. - 60: The debugger LIST-LOCATIONS command doesn't work properly. (How should it work properly?) @@ -359,34 +340,6 @@ WORKAROUND: (see also bug 279) -118: - as reported by Eric Marsden on cmucl-imp@cons.org 2001-08-14: - (= (FLOAT 1 DOUBLE-FLOAT-EPSILON) - (+ (FLOAT 1 DOUBLE-FLOAT-EPSILON) DOUBLE-FLOAT-EPSILON)) => T - when of course it should be NIL. (He says it only fails for X86, - not SPARC; dunno about Alpha.) - - Also, "the same problem exists for LONG-FLOAT-EPSILON, - DOUBLE-FLOAT-NEGATIVE-EPSILON, LONG-FLOAT-NEGATIVE-EPSILON (though - for the -negative- the + is replaced by a - in the test)." - - Raymond Toy comments that this is tricky on the X86 since its FPU - uses 80-bit precision internally. - - Bruno Haible comments: - The values are those that are expected for an IEEE double-float - arithmetic. The problem appears to be that the rounding is not - IEEE on x86 compliant: namely, values are first rounded to 64 - bits mantissa precision, then only to 53 bits mantissa - precision. This gives different results than rounding to 53 bits - mantissa precision in a single step. - - The quick "fix", to permanently change the FPU control word from - 0x037f to 0x027f, will give problems with the fdlibm code that is - used for computing transcendental functions like sinh() etc. - so maybe we need to change the FPU control word to that for Lisp - code, and adjust it to the safe 0x037f for calls to C? - 124: As of version 0.pre7.14, SBCL's implementation of MACROLET makes the entire lexical environment at the point of MACROLET available diff --git a/NEWS b/NEWS index e5ee195..67a24b2 100644 --- a/NEWS +++ b/NEWS @@ -2522,6 +2522,9 @@ changes in sbcl-0.8.12 relative to sbcl-0.8.11: * the behaviour of the standard function ED is now customizeable by third parties through a hook variable: see ED's documentation string for information on the protocol. + * fixed bugs 45d and 118: DOUBLE-FLOAT[-NEGATIVE]-EPSILON now + exhibit the required behaviour on the x86 platform. (thanks to + Peter van Eynde, Eric Marsden and Bruno Haible) * fixed bug 335: ATANH now computes the inverse hyperbolic tangent even for difficult arguments. (reported by Peter Graves) * fixed a bug in backquote printing: no more modification of the diff --git a/TODO b/TODO index f26e4be..50e05ef 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,6 @@ for early 0.8.x: * test file reworking - ** non-x86 ports now pass irrat.pure.lisp ** ports with less than 256Mb of heap (sparc, ppc and mips) now don't fail bit-vector.impure-cload.lisp * faster bootstrapping (both make.sh and slam.sh) diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp index 8aaae61..886fc8e 100644 --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -30,6 +30,12 @@ (cons :positive-infinity float-round-to-positive) (cons :negative-infinity float-round-to-negative))) +#!+x86 +(defparameter *precision-mode-alist* + (list (cons :24-bit float-precision-24-bit) + (cons :53-bit float-precision-53-bit) + (cons :64-bit float-precision-64-bit))) + ;;; Return a mask with all the specified float trap bits set. (defun float-trap-mask (names) (reduce #'logior @@ -74,6 +80,9 @@ ;;; have this feature, and some SBCL ports don't implement it anyway ;;; -- in such cases the value is always NIL. ;;; +;;;:PRECISION (x86 only) :24-bit, :53-bit and :64-bit, for the +;;;internal precision of the mantissa. +;;; ;;; GET-FLOATING-POINT-MODES may be used to find the floating point modes ;;; currently in effect. See cold-init.lisp for the list of initially ;;; enabled traps @@ -82,7 +91,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) + #!+x86 (precision nil precisionp)) (let ((modes (floating-point-modes))) (when traps-p (setf (ldb float-traps-byte modes) (float-trap-mask traps))) @@ -100,6 +110,11 @@ (if fast-mode (setq modes (logior float-fast-bit modes)) (setq modes (logand (lognot float-fast-bit) modes)))) + #!+x86 + (when precisionp + (setf (ldb float-precision-control modes) + (or (cdr (assoc precision *precision-mode-alist*)) + (error "unknown precision mode: ~S" precision)))) ;; FIXME: This apparently doesn't work on Darwin #!-darwin (setf (floating-point-modes) modes)) @@ -127,7 +142,10 @@ *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 + #!+x86 ,(car (rassoc (ldb float-precision-control modes) + *precision-mode-alist*)))))) ;;; Return true if any of the named traps are currently trapped, false ;;; otherwise. diff --git a/src/code/unix.lisp b/src/code/unix.lisp index b0e1811..c1b32ab 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -64,21 +64,25 @@ ;;; implemented using SB!XC:DEFMACRO wrapped in EVAL-WHEN. (defmacro syscall ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + `(locally + (declare (optimize (sb!c::float-accuracy 0))) + (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) ,@args))) - (if (minusp result) - (values nil (get-errno)) - ,success-form))) + (if (minusp result) + (values nil (get-errno)) + ,success-form)))) ;;; This is like SYSCALL, but if it fails, signal an error instead of ;;; returning error codes. Should only be used for syscalls that will ;;; never really get an error. (defmacro syscall* ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (minusp result) - (error "Syscall ~A failed: ~A" ,name (strerror)) - ,success-form))) + `(locally + (declare (optimize (sb!c::float-accuracy 0))) + (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (minusp result) + (error "Syscall ~A failed: ~A" ,name (strerror)) + ,success-form)))) (/show0 "unix.lisp 109") diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp index 780ee7c..14a0867 100644 --- a/src/compiler/policies.lisp +++ b/src/compiler/policies.lisp @@ -56,3 +56,7 @@ 3 0) ("no" "maybe" "yes" "yes")) + +(define-optimization-quality float-accuracy + 3 + ("degraded" "full" "full" "full")) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index c40c98c..cb7f2da 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -237,8 +237,16 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:node-var node) (:generator 0 (aver (location= result esp-tn)) + (when (policy node (= sb!c::float-accuracy 3)) + (inst sub esp-tn 4) + (inst fnstcw (make-ea :word :base esp-tn)) + (inst wait) + (inst or (make-ea :word :base esp-tn) #x300) + (inst fldcw (make-ea :word :base esp-tn)) + (inst wait)) (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) (inst sub esp-tn delta))) @@ -246,10 +254,16 @@ (define-vop (dealloc-number-stack-space) (:info amount) + (:node-var node) (:generator 0 (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) - (inst add esp-tn delta))))) + (inst add esp-tn delta))) + (when (policy node (= sb!c::float-accuracy 3)) + (inst and (make-ea :word :base esp-tn) #xfeff) + (inst fldcw (make-ea :word :base esp-tn)) + (inst wait) + (inst add esp-tn 4)))) (define-vop (alloc-alien-stack-space) (:info amount) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index b15bb06..27d9cd3 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -96,6 +96,10 @@ (def!constant float-round-to-positive 2) (def!constant float-round-to-zero 3) +(def!constant float-precision-24-bit 0) +(def!constant float-precision-53-bit 2) +(def!constant float-precision-64-bit 3) + (defconstant-eqx float-rounding-mode (byte 2 10) #'equalp) (defconstant-eqx float-sticky-bits (byte 6 16) #'equalp) (defconstant-eqx float-traps-byte (byte 6 0) #'equalp) diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index a1b1385..1170bba 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -178,8 +178,8 @@ Lstack: fnsave (%esp) # save and reset NPX movl (%esp),%eax # Load NPX control word. - andl $0xfffff3ff,%eax # Set rounding mode to nearest. - orl $0x00000300,%eax # Set precision to 64 bits. + andl $0xfffff2ff,%eax # Set rounding mode to nearest. + orl $0x00000200,%eax # Set precision to 64 bits. (53-bit mantissa) pushl %eax fldcw (%esp) # Recover modes. popl %eax diff --git a/version.lisp-expr b/version.lisp-expr index 9f63546..3a188a4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.11.3" +"0.8.11.4"