From 7b6eb2172fe582d5d1278abc041ba097fda9aa32 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Fri, 14 Oct 2011 22:44:17 -0700
Subject: [PATCH] Properly handle a denormal operand exception.  This should
 get rid of the occasional problem about SIGFPE's with no exceptions enabled.

error.lisp:
o Add floating-point-denormal-operand arithmetic error.

exports.lisp:
o Export the new arithmetic error type.

float-trap.lisp:
o Check the denormal trap bit and signal the appropriate error.

release-20c.txt:
o Update.
---
 code/error.lisp              | 5 ++++-
 code/exports.lisp            | 4 +++-
 code/float-trap.lisp         | 5 +++++
 general-info/release-20c.txt | 2 +-
 4 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/code/error.lisp b/code/error.lisp
index f2b2a196d..2678d221f 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -53,7 +53,8 @@
 	  arithmetic-error arithmetic-error-operation arithmetic-error-operands
 	  package-error package-error-package division-by-zero
 	  floating-point-overflow floating-point-underflow
-	  floating-point-inexact floating-point-invalid-operation))
+	  floating-point-inexact floating-point-invalid-operation
+	  #+x86 floating-point-denormal-operand))
 
 (in-package "CONDITIONS")
 
@@ -1129,6 +1130,8 @@
 (define-condition floating-point-underflow (arithmetic-error) ())
 (define-condition floating-point-inexact   (arithmetic-error) ())
 (define-condition floating-point-invalid-operation   (arithmetic-error) ())
+#+x86
+(define-condition floating-point-denormal-operand    (arithmetic-error) ())
 
 ;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that
 ;;; compiler warnings can be emitted as appropriate.
diff --git a/code/exports.lisp b/code/exports.lisp
index 6749fb02b..d34e2d30a 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -720,7 +720,9 @@
    "FIND-IF" "FIND-IF-NOT" "FIND-PACKAGE"
    "FIND-RESTART" "FIND-SYMBOL" "FINISH-OUTPUT" "FIRST" "FIXNUM"
    "FLET" "FLOAT" "FLOAT-DIGITS" "FLOAT-PRECISION" "FLOAT-RADIX"
-   "FLOAT-SIGN" "FLOATING-POINT-INEXACT"
+   "FLOAT-SIGN"
+   "FLOATING-POINT-DENORMAL-OPERAND"
+   "FLOATING-POINT-INEXACT"
    "FLOATING-POINT-INVALID-OPERATION"
    "FLOATING-POINT-OVERFLOW" "FLOATING-POINT-UNDERFLOW"
    "FLOATP" "FLOOR" "FMAKUNBOUND" "FORCE-OUTPUT" "FORMAT" "FORMATTER"
diff --git a/code/float-trap.lisp b/code/float-trap.lisp
index 5cb3b3fdf..0ac3898d0 100644
--- a/code/float-trap.lisp
+++ b/code/float-trap.lisp
@@ -289,6 +289,11 @@
 	     (error 'floating-point-inexact
 		    :operation fop
 		    :operands operands))
+	    #+x86
+	    ((not (zerop (logand float-denormal-trap-bit traps)))
+	     (error 'floating-point-denormal-operand
+		    :operation fop
+		    :operands operands))
 	    (t
 	     ;; It looks like the sigcontext on Solaris/x86 doesn't
 	     ;; actually save the status word of the FPU.  The
diff --git a/general-info/release-20c.txt b/general-info/release-20c.txt
index 50bea98d7..ffe98b5c9 100644
--- a/general-info/release-20c.txt
+++ b/general-info/release-20c.txt
@@ -145,7 +145,7 @@ New in this release:
       actually prevent stack overflows from crashing lisp.
     - Fix rounding of numbers larger than a fixnum.  (See Trac #10 for
       a related issue.)
-
+    - Properly handle the denormal operand trap on x86es.
 
   * Trac Tickets:
     - #43: unread-char doesn't change file-position
-- 
GitLab