[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-01-20-g0174bfe

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  0174bfebdb2ed8edbdf5b3dade4fd64965d4a9f4 (commit)
      from  719e87b7d103d3201c031412de576653a42daff7 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 0174bfebdb2ed8edbdf5b3dade4fd64965d4a9f4
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Thu Jan 31 21:27:36 2013 -0800

    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
--- 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
--- 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)

-----------------------------------------------------------------------

Summary of changes:
 src/code/float-trap.lisp |   23 +++++++++++++++++++--
 src/code/x86-vm.lisp     |   47 +++++++++++++++++++++++++++++++++++++++------
 2 files changed, 60 insertions(+), 10 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp