From 9fde59c0e56e9982c0fa96643341975962d3fe81 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 20 Mar 2007 18:21:39 +0000 Subject: [PATCH] Was not getting the right instruction for the faulting floating-point exception. This was happening when the faulting FP instruction was in the delay slot of a branch. The PC was incremented to the branch target, and hence had the wrong information. The FPQ structure has the right information. code/sparc-svr4-vm.lisp: o Add FPQ structure so we can access the information about the faulting FP instruction. compiler/sparc/float.lisp: o Extract the correct information about the faulting FP instruction instead of from the PC. --- code/sparc-svr4-vm.lisp | 9 +++- compiler/sparc/float.lisp | 92 ++++++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 41 deletions(-) diff --git a/code/sparc-svr4-vm.lisp b/code/sparc-svr4-vm.lisp index 3cff4b5b3..ea805f9a4 100644 --- a/code/sparc-svr4-vm.lisp +++ b/code/sparc-svr4-vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.8 2006/01/03 17:58:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.9 2007/03/20 18:21:38 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -62,6 +62,13 @@ ;; This means the XRS entry is valid. (defconstant +xrs-id-valid+ #x78727300) +(def-alien-type fpq + (struct nil + ;; Address of faulting FP instruction + (fpq-addr system-area-pointer) + ;; The instruction itself + (fpq-inst c-call:unsigned-long))) + ; In the include files (sys/ucontext.h) this structure consists of 3 ; structures: struct ucontext, that includes struct mcontext which ; includes; struct fpu. Because the fpu structure contains doubles, it diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index f8fc0b27f..9e3cc9eed 100644 --- a/compiler/sparc/float.lisp +++ b/compiler/sparc/float.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.47 2006/11/16 15:37:04 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.48 2007/03/20 18:21:39 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2869,50 +2869,62 @@ (in-package "SPARC") (export 'get-fp-operands) + +(defun get-fp-fault-info (scp) + (declare (type (alien (* sigcontext)) scp)) + ;; The FPQ structure in the context has the faulting FP address and + ;; the faulting FP instruction. Return both. + (let ((fpq (alien:sap-alien + (with-alien ((scp (* sigcontext) scp)) + (slot scp 'fpq)) + (* fpq)))) + (with-alien ((fpq (* fpq) fpq)) + (values (slot fpq 'fpq-addr) + (slot fpq 'fpq-inst))))) + (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. - (let* ((pc (sigcontext-program-counter scp)) - ;; The trap seems to happen just after the offending FP - ;; instruction, so back up one. - (opcode (sap-ref-32 pc -4)) - (format (ldb (byte 2 30) opcode)) - (op3 (ldb (byte 6 19) opcode)) - (rs1 (ldb (byte 5 14) opcode)) - (opf (ldb (byte 8 5) opcode)) - (rs2 (ldb (byte 5 0) opcode)) - ) - ;; Handle only the ones we know about. - (unless (and (= format #b10) (= op3 #b110100)) - (return-from get-fp-operation (values nil nil nil nil))) - (let ((fop (case (ldb (byte 6 2) opf) - (#b0010000 '+) - (#b0010001 '-) - (#b0010010 '*) - (#b0010011 '/) - (#b0001010 - ;; The fsqrt instruction only uses the rs2 field. - (setf rs1 nil) - 'sqrt))) - (format (case (ldb (byte 2 0) opf) - (#b01 'single-float) - (#b10 'double-float) - (#b11 'long-float)))) - (flet ((fix-up-reg-index (index) - (if (eq format 'single-float) - index - (when index - ;; For double-float (and long-float), the - ;; register is coded in a special way since the - ;; register address must be even, but we only - ;; have 5 bits to encode the register. Hence the - ;; LSB is used to indicate the upper 32 - ;; registers. - (+ (ash (logand index 1) 5) - (ash (ldb (byte 4 1) index) 1)))))) - (values fop format (fix-up-reg-index rs1) (fix-up-reg-index rs2)))))) + (multiple-value-bind (addr opcode) + (get-fp-fault-info scp) + (declare (ignore addr)) + (let* ((format (ldb (byte 2 30) opcode)) + (op3 (ldb (byte 6 19) opcode)) + (rs1 (ldb (byte 5 14) opcode)) + (opf (ldb (byte 8 5) opcode)) + (rs2 (ldb (byte 5 0) opcode)) + ) + ;; Handle only the ones we know about. + (unless (and (= format #b10) (= op3 #b110100)) + (return-from get-fp-operation (values nil nil nil nil))) + (let ((fop (case (ldb (byte 6 2) opf) + (#b0010000 '+) + (#b0010001 '-) + (#b0010010 '*) + (#b0010011 '/) + (#b0001010 + ;; The fsqrt instruction only uses the rs2 field. + (setf rs1 nil) + 'sqrt))) + (format (case (ldb (byte 2 0) opf) + (#b01 'single-float) + (#b10 'double-float) + (#b11 'long-float)))) + (flet ((fix-up-reg-index (index) + (if (eq format 'single-float) + index + (when index + ;; For double-float (and long-float), the + ;; register is coded in a special way since the + ;; register address must be even, but we only + ;; have 5 bits to encode the register. Hence the + ;; LSB is used to indicate the upper 32 + ;; registers. + (+ (ash (logand index 1) 5) + (ash (ldb (byte 4 1) index) 1)))))) + (values fop format (fix-up-reg-index rs1) (fix-up-reg-index rs2))))))) (defun get-fp-operands (scp modes) (declare (type (alien (* sigcontext)) scp) -- GitLab