From 81879632d61b81f562f5d20fce79a63a870f97e0 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Tue, 1 Apr 2003 21:22:20 +0000 Subject: [PATCH] Add functions to extract out the operation and args of a floating-point instruction from a sigcontext. --- compiler/sparc/float.lisp | 62 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 61 insertions(+), 1 deletion(-) diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index f35274bb2..faca965fc 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.37 2002/11/26 15:50:58 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.38 2003/04/01 21:22:20 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2643,3 +2643,63 @@ ) + + + +(in-package "SPARC") +(export 'get-fp-operands) + +(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)))))) + +(defun get-fp-operands (scp) + (declare (type (alien (* sigcontext)) scp)) + ;; From the offending FP instruction, get the operation and + ;; operands, if we can. + (multiple-value-bind (fop format rs1 rs2) + (get-fp-operation scp) + (let ((fs1 (and fop rs1 (sigcontext-float-register scp rs1 format))) + (fs2 (and fop rs2 (sigcontext-float-register scp rs2 format)))) + (values fop (remove nil (list fs1 fs2)))))) -- GitLab