From 0174bfebdb2ed8edbdf5b3dade4fd64965d4a9f4 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 31 Jan 2013 21:27:36 -0800 Subject: [PATCH] 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. --- src/code/float-trap.lisp | 23 +++++++++++++++++--- src/code/x86-vm.lisp | 47 ++++++++++++++++++++++++++++++++++------ 2 files changed, 60 insertions(+), 10 deletions(-) diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp index 661614670..d7bab6f62 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 19211ed35..961dacbb0 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) -- GitLab