Fix ticket:72 : SIGFPE with no exceptions enabled

 code/float-trap.lisp::
  * In the default case, check FOP to see if it's defined.  This means
    it's a divide exception.

 code/x86-vm.lisp::
  * Also check to see if the offending instruction is a DIV or IDIV,
    which means we got an integer overflow.  Return the appropriate
    values in this case.

diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index 6616146..d7bab6f 100644 (file)
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -239,7 +239,7 @@
 ;;;    Signal the appropriate condition when we get a floating-point error.
 ;;;
 (defun sigfpe-handler (signal code scp)
-  (declare (ignore signal code)
+  (declare (ignore signal)
           (type system-area-pointer scp))
   (let* ((modes (sigcontext-floating-point-modes
                 (alien:sap-alien scp (* unix:sigcontext))))
@@ -313,9 +313,26 @@
             ;; operands also seem to be missing.  Signal a general
             ;; arithmetic error.
             #+(and x86 solaris)
-            (error 'arithmetic-error :operands operands)
+            (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)"
+                   code)
+            ;; For all other x86 ports, we should only get here if
+            ;; the SIGFPE was caused by an integer overflow on
+            ;; division.  For sparc and ppc, I (rtoy) don't think
+            ;; there's any other way to get here since integer
+            ;; overflows aren't signaled.
+            ;;
+            ;; In that case, FOP should be /, so we can generate a
+            ;; nice arithmetic-error.  It's possible to use CODE,
+            ;; which is supposed to indicate what caused the
+            ;; exception, but each OS is different, so we don't; FOP
+            ;; can tell us.
             #-(and x86 solaris)
-            (error _"SIGFPE with no exceptions currently enabled?"))))))
+            (if fop
+                (error 'arithmetic-error
+                       :operation fop
+                       :operands operands)
+                (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D"
+                       code)))))))
 
 ;;; WITH-FLOAT-TRAPS-MASKED  --  Public
 ;;;

diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index 19211ed..961dacb 100644 (file)
--- a/src/code/x86-vm.lisp
+++ b/src/code/x86-vm.lisp
@@ -539,9 +539,11 @@
 
 (defun get-fp-operation (scp)
   (declare (type (alien (* sigcontext)) scp))
-  ;; Get the offending FP instruction from the context.  We return the
-  ;; operation associated with the FP instruction, the precision of
-  ;; the operation, and the operands of the instruction.
+  ;; Get the instruction that caused the SIGFPE from the context.  The
+  ;; SIGFPE can be caused by either a floating-point operation or an
+  ;; integer division (overflow).  We return the operation associated
+  ;; with the instruction, and the the operands of the instruction, if
+  ;; possible.
 
   ;; For SSE2, the PC should be at the offending SSE2 instruction
   (let ((pc (sigcontext-program-counter scp)))
@@ -580,9 +582,10 @@
                     (when (= mod #b11)
                       (sigcontext-float-register scp (+ 8 r/m) format))))))
       ;; Look at the instruction and see if it's one of the arithmetic
-      ;; SSE2 instructions.  If so, figure out the operation and try
-      ;; to get the operands.  Currently, if an operand is in memory,
-      ;; we don't try to fetch it.
+      ;; SSE2 instructions or an integer division instruction.  If so,
+      ;; figure out the operation and try to get the operands.
+      ;; Currently, if an operand is in memory, we don't try to fetch
+      ;; it.
       ;;
       ;; Also, for the packed operations that hold complex numbers,
       ;; it's not exactly clear what to do.  The main issue is that
@@ -644,8 +647,38 @@
                       (when src
                         (list (realpart src)
                               (imagpart src))))))
+           ((or (= (sys:sap-ref-8 pc 0) #xf7))
+            ;; DIV or IDIV.  We don't support 8-bit division
+            (multiple-value-bind (mod r/m v)
+                (decode-mod-r/m (sys:sap-ref-8 pc 1))
+              #+(or)
+              (format t "DIV: #X~X: mod, r/m v = ~X ~X ~X~%"
+                      (sys:sap-ref-8 pc 0)
+                      mod r/m v)
+              ;; r/m tells us the divisor reg
+              (flet ((maybe-adjust-sign (x 64bit-p)
+                       ;; Maybe convert unsigned integer X to a
+                       ;; signed integer.  64BIT-P is set if X is
+                       ;; supposed to be a 64-bit integer.
+                       (if (= v 7)
+                           (- x (if 64bit-p
+                                    #x10000000000000000
+                                    #x100000000))
+                           x)))
+                ;; For the div instructions, the dividend is always
+                ;; in EDX:EAX
+                (let ((dividend (maybe-adjust-sign
+                                 (+ (ash (sigcontext-register scp 4) 32)
+                                    (sigcontext-register scp 0))
+                                 t))
+                      (divisor (maybe-adjust-sign
+                                (sigcontext-register scp (ash r/m 1))
+                                nil)))
+                  (values '/
+                          dividend
+                          divisor)))))
            (t
-            (values nil nil nil nil))))))
+            (values nil nil nil))))))
 
 (defun get-fp-operands (scp modes)
   (declare (type (alien (* sigcontext)) scp)