Changeset 14838


Ignore:
Timestamp:
Jun 23, 2011, 2:10:43 AM (8 years ago)
Author:
gb
Message:

Partial support for determining arithmetic-error operation/operands
on x86.

NOT YET TESTED ON ALL PLATFORMS; MAY NOT EVEN COMPILE WITHOUT ERROR.

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x86-asm.lisp

    r14622 r14838  
    48484848        (match-template-types template type0 type1 type2))))))
    48494849
     4850(defun ccl::register-operand-regno (op type)
     4851  (when (and (typep op 'x86::x86-register-operand)
     4852             (eql (x86::x86-register-operand-type op)
     4853                  type))
     4854    (x86::reg-entry-reg-num
     4855     (x86::x86-register-operand-entry op))))
     4856
    48504857
    48514858(provide "X86-ASM")
  • trunk/source/level-1/x86-trap-support.lisp

    r14428 r14838  
    3131  (defun xp-mxcsr (xp)
    3232    (pref xp :ucontext.uc_mcontext.fpregs.mxcsr))
     33  (defmacro xp-xmm-regs (xp)
     34    `(pref ,xp :ucontext.uc_mcontext.fpregs._xmm))
    3335  (defparameter *encoded-gpr-to-indexed-gpr*
    3436    #(13                                ;rax
     
    5961    (with-macptrs ((state (pref xp :__ucontext.uc_mcontext.mc_fpstate)))
    6062      (pref state :savefpu.sv_env.en_mxcsr)))
     63  (defmacro xp-xmm-regs (xp)
     64    (let* ((state (gensym)))
     65      `(with-macptrs ((,state (pref ,xp :__ucontext.uc_mcontext.mc_fpstate)))
     66        (pref ,state :savefpu.sv_xmm))))
     67     
    6168  (defparameter *encoded-gpr-to-indexed-gpr*
    6269    #(7                                 ;rax
     
    8592  (defmacro xp-gp-regs (xp)
    8693    `(pref ,xp :ucontext_t.uc_mcontext.__ss))
     94  (defmacro xp-xmm-regs (xp)
     95    `(pref ,xp :ucontext_t.uc_mcontext.__fs.__fpu_xmm0))
    8796
    8897  (defconstant flags-register-offset 17)
     
    116125  (defun xp-mxcsr (xp)
    117126    (pref xp :ucontext.uc_mcontext.fpregs.fp_reg_set.fpchip_state.mxcsr))
     127  (defmacro xp-mmx-regs (xp)
     128    `(pref ,xp :ucontext.uc_mcontext.fpregs.fp_reg_set.fpchip_state.xmm))
    118129  (defparameter *encoded-gpr-to-indexed-gpr*
    119130    #(14                                ;rax
     
    142153  (defun xp-mxcsr (xp)
    143154    (pref xp #>CONTEXT.MxCsr))
     155  (defmacro xp-xmm-regs (xp)
     156    `(pref ,xp #>CONTEXT.nil.FltSave.XmmRegisters))
    144157  (defparameter *encoded-gpr-to-indexed-gpr*
    145158    #(0                                 ;rax
     
    168181  (defun xp-mxcsr (xp)
    169182    (pref xp :ucontext_t.uc_mcontext.__fs.__fpu_mxcsr))
     183  (defmacro xp-xmm-regs (xp)
     184    `(pref ,xp :ucontext_t.uc_mcontext.__fs.__fpu_xmm0))
    170185  (defconstant flags-register-offset 9)
    171186  (defconstant eip-register-offset 10)
     
    189204    (pref (pref (pref xp :ucontext.uc_mcontext) :mcontext_t.fpregs)
    190205          :_fpstate.mxcsr))
     206  (defmacro xp-xmm-regs (xp)
     207    `(pref ,xp :ucontext.uc_mcontext.fpregs._xmm))
    191208  (defconstant flags-register-offset #$REG_EFL)
    192209  (defconstant eip-register-offset #$REG_EIP)
     
    210227  (defun xp-mxcsr (xp)
    211228    (%get-unsigned-long (pref xp #>CONTEXT.ExtendedRegisters) 24))
     229  (defmacro xp-xmm-regs (xp)
     230    `(%inc-ptr ,xp #x16c))
    212231  (defconstant flags-register-offset 48)
    213232  (defconstant eip-register-offset 45)
     
    232251    (pref xp :ucontext.uc_mcontext.fpregs.fp_reg_set.fpchip_state.mxcsr))
    233252  (defconstant flags-register-offset #$EFL)
     253  (defmacro xp-xmm-regs (xp)
     254    `(pref ,xp :ucontext.uc_mcontext.fpregs.fp_reg_set.fpchip_state.xmm))
    234255  (defconstant eip-register-offset #$EIP)
    235256  (defparameter *encoded-gpr-to-indexed-gpr*
     
    308329  #+x8632-target
    309330  (%get-signed-long (xp-gp-regs xp) (+ gp-regs-offset (ash flags-register-offset x8632::fixnumshift)))))
    310  
    311 
     331(defmacro xp-xmm-single-float (xp n)
     332  `(%get-single-float (xp-xmm-regs ,xp) (ash ,n 4)))
     333(defmacro xp-xmm-double-float (xp n)
     334  `(%get-double-float (xp-xmm-regs ,xp) (ash ,n 4)))
    312335
    313336(defun %get-xcf-byte (xcf-ptr delta)
     
    337360      -1)
    338361    skip))
    339                            
     362
     363(defun arithmetic-error-operation-from-instruction (instruction)
     364  (let* ((name (make-keyword (string-upcase (x86-di-mnemonic instruction)))))
     365    (case name
     366      ((:divss :divsd :idivl :idivd) '/)
     367      ((:mulss :mulsd) '*)
     368      ((:addss :addsd) '+)
     369      ((:subss :subsd) '-)
     370      (t 'coerce))))
     371
     372(defun arithmetic-error-operands-from-instruction (instruction xp)
     373  (let* ((name (make-keyword (string-upcase (x86-di-mnemonic instruction)))))
     374    (let* ((op0 (x86-di-op0 instruction))
     375           (op1 (x86-di-op1 instruction))
     376           (xmmop0 (register-operand-regno op0 #.x86::+operand-type-RegXMM+))
     377           (xmmop1 (register-operand-regno op1 #.x86::+operand-type-RegXMM+)))
     378      (collect ((opvals))
     379        (case name
     380          ((:divss :mulss :addss :subss)
     381           (when (and xmmop0 xmmop1)
     382             (opvals (xp-xmm-single-float xp xmmop1))
     383             (opvals (xp-xmm-single-float xp xmmop0))))
     384          ((:divsd :mulsd :addsd :subsd)
     385           (when (and xmmop0 xmmop1)
     386             (opvals (xp-xmm-double-float xp xmmop1))
     387             (opvals (xp-xmm-double-float xp xmmop0))))
     388           
     389          )
     390        (opvals)))))
     391
     392
    340393                                 
    341394(defun decode-arithmetic-error (xp xcf)
    342   (declare (ignore xp xcf))
    343   (values 'unknown nil))
     395  (declare (ignorable xp xcf))
     396  (let* ((code-vector (make-array 15 :element-type '(unsigned-byte 8)))
     397         (xfunction (%alloc-misc 1 target::subtag-xfunction)))
     398    (dotimes (i 15)                     ;maximum instructon size
     399      (setf (aref code-vector i) (%get-xcf-byte xcf i)))
     400    (setf (uvref xfunction 0) code-vector)
     401    (let* ((ds (make-x86-disassembly-state
     402                :mode-64 #+x8664-target t #+x8632-target nil
     403                :code-vector code-vector
     404                :constants-vector xfunction
     405                :entry-point 0
     406                :code-pointer 0           ; for next-u32/next-u16 below
     407                :symbolic-names nil
     408                :pending-labels (list 0)
     409                :code-limit 15
     410                :code-pointer 0))
     411           (instruction (ignore-errors (x86-disassemble-instruction ds nil))))
     412      (if instruction
     413        (values (arithmetic-error-operation-from-instruction  instruction)
     414                (arithmetic-error-operands-from-instruction instruction xp))
     415        (values 'unknown nil)))))
    344416
    345417(eval-when (:compile-toplevel :execute)
Note: See TracChangeset for help on using the changeset viewer.