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?)
(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
* 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
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)
(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
;;; 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
(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)))
(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))
*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.
;;; 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")
3
0)
("no" "maybe" "yes" "yes"))
+
+(define-optimization-quality float-accuracy
+ 3
+ ("degraded" "full" "full" "full"))
(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)))
(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)
(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)
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
;;; 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"
projects / sbcl.git / commitdiff