- (declare (ignore signal info))
- (declare (type system-area-pointer context))
- ;; FIXME: The find-the-detailed-problem code below went stale with
- ;; the big switchover to POSIX signal handling and signal contexts
- ;; which are opaque at the Lisp level ca plod-0.6.7. It needs to be
- ;; revived, which will require writing a C-level os-dependent
- ;; function to extract floating point modes, and a Lisp-level
- ;; DEF-ALIEN-ROUTINE to get to the C-level os-dependent function.
- ;; Meanwhile we just say "something went wrong".
- (error 'floating-point-exception)
- #|
- (let* ((modes (context-floating-point-modes
- (sb!alien:sap-alien context (* os-context-t))))
- (traps (logand (ldb float-exceptions-byte modes)
- (ldb float-traps-byte modes))))
- (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps)))
- (error 'division-by-zero))
- ((not (zerop (logand float-invalid-trap-bit traps)))
- (error 'floating-point-invalid-operation))
- ((not (zerop (logand float-overflow-trap-bit traps)))
- (error 'floating-point-overflow))
- ((not (zerop (logand float-underflow-trap-bit traps)))
- (error 'floating-point-underflow))
- ((not (zerop (logand float-inexact-trap-bit traps)))
- (error 'floating-point-inexact))
- #!+FreeBSD
- ((zerop (ldb float-exceptions-byte modes))
- ;; I can't tell what caused the exception!!
- (error 'floating-point-exception
- :traps (getf (get-floating-point-modes) :traps)))
- (t
- (error "SIGFPE with no exceptions currently enabled?"))))
- |#
- )
-
+ (declare (ignore signal context))
+ (declare (type system-area-pointer info))
+ (let ((code (sb!unix::siginfo-code info)))
+ (with-interrupts
+ (error (or (cdr (assoc code *sigfpe-code-error-alist*))
+ 'floating-point-exception)))))
+
+;;; Execute BODY with the floating point exceptions listed in TRAPS
+;;; masked (disabled). TRAPS should be a list of possible exceptions
+;;; which includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
+;;; :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The
+;;; respective accrued exceptions are cleared at the start of the body
+;;; to support their testing within, and restored on exit.