Changeset 14843


Ignore:
Timestamp:
Jun 23, 2011, 6:33:09 AM (8 years ago)
Author:
gb
Message:

Provide some help in determining arithmetic-error operation/operands
by partial disassembly.

Use that help when we get an FPU exception.

If (%ERR-DISP $XDIVZRO ...) is called with a second operand, use that
as the first ARITHMETIC-ERROR-OPERAND in the resulting condition.

Pass that argument from ARM subrprims that can signal division-by-zero
from software.

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm-disassemble.lisp

    r14765 r14843  
    499499(defun arm-xdisassemble (function)
    500500  (disassemble-arm-xfunction function *standard-output*))
     501
     502;;; Help arithmetic-error handlers
     503(defun arithmetic-error-operation-from-instruction (template)
     504  (let* ((name (make-keyword (string-upcase (arm::arm-instruction-template-name template)))))
     505    (case name
     506      ((:fdivs :fdivd) '/)
     507      ((:fmuls :fmuld) '*)
     508      ((:fadds :faddd) '+)
     509      ((:fsubs :fsubd) '-)
     510      (t 'coerce))))
     511
     512(defun arithmetic-error-operands-from-instruction (template instruction regvals xp)
     513  (let* ((adi (make-arm-disassembled-instruction :opcode instruction))
     514         (adi-vector (vector adi))
     515         (parsed-ops (mapcar (lambda (type)
     516                               (funcall (svref *arm-operand-extract-functions* type) adi-vector 0))
     517                             (arm::arm-instruction-template-operand-types template)))
     518         (singles (make-array 32 :element-type 'single-float))
     519         (doubles (make-array 16 :element-type 'double-float)))
     520    (declare (dynamic-extent singles doubles))
     521    (%copy-ivector-to-ivector regvals 4 singles 0 (* 32 4))
     522    (%copy-ivector-to-ivector regvals 4 doubles 4 (* 16 8))
     523    (collect ((opvals))
     524      (dolist (op (cdr parsed-ops))
     525        (ecase (car op)
     526          (:double (opvals (aref doubles (cadr op))))
     527          (:single (opvals (aref singles (cadr op))))
     528          (:gpr (opvals (xp-gpr-signed-long xp (cadr op))))))
     529      (when (null (cddr parsed-ops))
     530        (opvals (case (caar parsed-ops)
     531                  (:single 'single-float)
     532                  (:double 'double-float))))
     533      (opvals))))
     534   
     535   
     536 
  • trunk/source/level-1/arm-error-signal.lisp

    r14807 r14843  
    115115    ;; handle_uuo() (in the lisp kernel) will not bump the PC here.
    116116    (setf (xp-gpr-lisp xp arm::pc) (uvref f 0))))
    117    
     117
     118 
    118119(defcallback %xerr-disp (:address xp
    119120                                  :signed-fullword error-number
     
    244245                        (5              ;fpu
    245246                         (let* ((reginfo (xp-gpr-lisp xp (ldb (byte 4 8) uuo)))
     247                                (instruction (logand (xp-gpr-signed-long xp (ldb (byte 4 12) uuo)) (1- (ash 1 32))))
    246248                                (condition-name (fp-condition-name-from-fpscr-status (aref reginfo 0))))
    247249                           (if condition-name
    248                              (%error condition-name nil frame-ptr)
     250                             (let* ((template (find-arm-instruction-template instruction))
     251                                    (operation (if template (arithmetic-error-operation-from-instruction template) 'unknown))
     252                                    (operands (if template (arithmetic-error-operands-from-instruction template instruction reginfo xp))))
     253                               (%error condition-name `(:operation ,operation :operands ,operands) frame-ptr))
    249254                             (%error "FPU exception, fpscr = ~d" (list (aref reginfo 0)) frame-ptr)))
    250255                         )
Note: See TracChangeset for help on using the changeset viewer.