From: Juho Snellman <jsnell@iki.fi>
Date: Thu, 2 Nov 2006 12:00:30 +0000 (+0000)
Subject: 0.9.18.22:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bd4f596b07e3783992e00eae88afdc05ebe7c6a6;p=sbcl.git

0.9.18.22:
        Use the si_code field for mapping FP exceptions to conditions
        on Posix platforms (Patch by NIIMI Satoshi, sbcl-devel "Patch to handle
        floating point exception" on 2006-10-30).
---

diff --git a/NEWS b/NEWS
index 69b14a8..1fb6c91 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18:
     startup, not time since first call to GET-INTERNAL-REAL-TIME.
   * improvement: SAVE-LISP-AND-DIE explicitly checks that multiple
     threads are not running after *SAVE-HOOKS* have run.
+  * improvement: floating-point exception handling should work on all
+    POSIX platforms (thanks to NIIMI Satoshi)
   * bug fix: compiler bug triggered by a (non-standard) VALUES
     declaration in a LET* was fixed. (reported by Kaersten Poeck)
   * bug fix: file compiler no longer confuses validated and already
diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index dca6771..429c5df 100644
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -175,33 +175,27 @@ sets the floating point modes to their current values (and thus is a no-op)."
   `(not (zerop (logand ,(dpb (float-trap-mask traps) float-traps-byte 0)
                        (floating-point-modes)))))
 
+;;; SIGFPE code to floating-point error
+#!-win32
+(defparameter *sigfpe-code-error-alist*
+  (list (cons sb!unix::fpe-intovf 'floating-point-overflow)
+        (cons sb!unix::fpe-intdiv 'division-by-zero)
+        (cons sb!unix::fpe-fltdiv 'division-by-zero)
+        (cons sb!unix::fpe-fltovf 'floating-point-overflow)
+        (cons sb!unix::fpe-fltund 'floating-point-underflow)
+        (cons sb!unix::fpe-fltres 'floating-point-inexact)
+        (cons sb!unix::fpe-fltinv 'floating-point-invalid-operation)
+        (cons sb!unix::fpe-fltsub 'floating-point-exception)))
+
 ;;; Signal the appropriate condition when we get a floating-point error.
 #!-win32
 (defun sigfpe-handler (signal info context)
-  (declare (ignore signal info))
-  (declare (type system-area-pointer context))
-  (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))))
+  (declare (ignore signal context))
+  (declare (type system-area-pointer info))
+  (let ((code (sb!unix::siginfo-code info)))
     (with-interrupts
-      (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 'floating-point-exception))))))
+        (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
diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 8308012..ceffe0b 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -163,6 +163,10 @@
 
 ;;;; etc.
 
+;;; extract si_code from siginfo_t
+(sb!alien:define-alien-routine ("siginfo_code" siginfo-code) sb!alien:int
+  (info system-area-pointer))
+
 ;;; CMU CL comment:
 ;;;   Magically converted by the compiler into a break instruction.
 (defun receive-pending-interrupt ()
diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 0d219b0..db665fd 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -1384,3 +1384,11 @@ interrupt_init()
     SHOW("returning from interrupt_init()");
 #endif
 }
+
+#ifndef LISP_FEATURE_WIN32
+int
+siginfo_code(siginfo_t *info)
+{
+    return info->si_code;
+}
+#endif
diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c
index 12476d9..ed6cfe6 100644
--- a/tools-for-build/grovel-headers.c
+++ b/tools-for-build/grovel-headers.c
@@ -354,6 +354,14 @@ main(int argc, char *argv[])
     defsignal("sigxcpu", SIGXCPU);
     defsignal("sigxfsz", SIGXFSZ);
 #endif
+    defconstant("fpe-intovf", FPE_INTOVF);
+    defconstant("fpe-intdiv", FPE_INTDIV);
+    defconstant("fpe-fltdiv", FPE_FLTDIV);
+    defconstant("fpe-fltovf", FPE_FLTOVF);
+    defconstant("fpe-fltund", FPE_FLTUND);
+    defconstant("fpe-fltres", FPE_FLTRES);
+    defconstant("fpe-fltinv", FPE_FLTINV);
+    defconstant("fpe-fltsub", FPE_FLTSUB);
 #endif // _WIN32
     return 0;
 }
diff --git a/version.lisp-expr b/version.lisp-expr
index 72c8229..7c29fd9 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.9.18.21"
+"0.9.18.22"