Skip to content

Commit

Permalink
1.0.38.12: Fix FP traps on PPC/Linux.
Browse files Browse the repository at this point in the history
  * Linux on most platforms, including PPC, kicks off its signal
handlers with a cleared FP control word.  We already have a hook to deal
with this, so enable it.

  * The implementation of said hook on PPC/Linux was broken, largely due
to a variable-size mismatch in a KLUDGE it uses.  Fixed and documented
the KLUDGE, added support for preserving the current rounding mode, and
enabled the actual restoration of the FP control word.

  * NetBSD isn't the only target which requires :INVALID exceptions to
be disabled, it also matters on PPC.  Fixed the default control mode.

  * Fix up the test suite to reflect the current expectations for
float.pure.lisp tests.
  • Loading branch information
Alastair Bridgewater committed May 24, 2010
1 parent 52c61a5 commit cb42725
Show file tree
Hide file tree
Showing 6 changed files with 15 additions and 21 deletions.
1 change: 1 addition & 0 deletions NEWS
Expand Up @@ -18,6 +18,7 @@ changes relative to sbcl-1.9.38:
clisp. (lp#576787, thanks to Josh Elsasser)
* new platform: experimental support for ppc/openbsd (thanks to Josh
Elsasser).
* bug fix: Floating-point traps now work on ppc/linux.

changes in sbcl-1.0.38 relative to sbcl-1.0.37:
* incompatible change: Thread names are now restricted to SIMPLE-STRINGs
Expand Down
2 changes: 1 addition & 1 deletion src/code/float-trap.lisp
Expand Up @@ -158,7 +158,7 @@ sets the floating point modes to their current values (and thus is a no-op)."
;;; disabled by default. Joe User can explicitly enable them if
;;; desired.
(defvar *saved-floating-point-modes*
'(:traps (:overflow #!-netbsd :invalid :divide-by-zero)
'(:traps (:overflow #!-(or netbsd ppc) :invalid :divide-by-zero)
:rounding-mode :nearest :current-exceptions nil
:accrued-exceptions nil :fast-mode nil
#!+x86 :precision #!+x86 :53-bit))
Expand Down
26 changes: 9 additions & 17 deletions src/runtime/ppc-linux-os.c
Expand Up @@ -122,29 +122,21 @@ os_context_fp_control(os_context_t *context)
void
os_restore_fp_control(os_context_t *context)
{
unsigned long control;
/* KLUDGE: mtfsf has to be run against a float register, so we
* construct the float we need to use as an integer, then cast
* a pointer to its storage to a double and load that. For
* this to work, control must be the same width as a double,
* 64 bits. And why aren't we using a union here, anyway? */
unsigned long long control;
double d;

/* FIXME: We are only preserving enabled traps and rounding
* mode here. Do we also want to preserve "fast mode"? */
control = os_context_fp_control(context) &
/* FIXME: Should we preserve the user's requested rounding mode?
Note that doing
~(FLOAT_STICKY_BITS_MASK | FLOAT_EXCEPTIONS_BYTE_MASK)
here leads to infinite SIGFPE for invalid operations, as
there are bits in the control register that need to be
cleared that are let through by that mask. -- CSR, 2002-07-16 */

FLOAT_TRAPS_BYTE_MASK;
(FLOAT_TRAPS_BYTE_MASK | FLOAT_ROUNDING_MODE_MASK);

d = *((double *) &control);
/* Hmp. Apparently the following doesn't work either:
asm volatile ("mtfsf 0xff,%0" : : "f" (d));
causing segfaults at the first GC.
*/
}

void
Expand Down
1 change: 1 addition & 0 deletions src/runtime/ppc-linux-os.h
Expand Up @@ -10,6 +10,7 @@ static inline os_context_t *arch_os_get_context(void **void_context)
}

unsigned long os_context_fp_control(os_context_t *context);
#define RESTORE_FP_CONTROL_FROM_CONTEXT
void os_restore_fp_control(os_context_t *context);

#endif /* _PPC_LINUX_OS_H */
4 changes: 2 additions & 2 deletions tests/float.pure.lisp
Expand Up @@ -93,7 +93,7 @@
(assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum))))

(with-test (:name (:scale-float-overflow :bug-372)
:fails-on '(or :ppc :darwin)) ;; bug 372
:fails-on :darwin) ;; bug 372
(progn
(assert (raises-error? (scale-float 1.0 most-positive-fixnum)
floating-point-overflow))
Expand Down Expand Up @@ -125,7 +125,7 @@
(funcall (compile nil '(lambda () (tan (tan (round 0))))))

(with-test (:name (:addition-overflow :bug-372)
:fails-on '(or :ppc :darwin (and :x86 :netbsd)))
:fails-on '(or (and :ppc :openbsd) :darwin (and :x86 :netbsd)))
(assert (typep (nth-value
1
(ignore-errors
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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".)
"1.0.38.11"
"1.0.38.12"

0 comments on commit cb42725

Please sign in to comment.