Changeset 13004


Ignore:
Timestamp:
Oct 13, 2009, 12:10:09 AM (10 years ago)
Author:
rme
Message:

Get watched object from lisp stack instead of callback parameter. Use
new function X86-FAULTING-INSTRUCTION to initialize instruction slot
of WRITE-TO-WATCHED-OBJECT condition.

Add a "skip this write instruction" restart.

Instead of returning 0 as the value of the callback, return SKIP bytes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/x86-trap-support.lisp

    r12888 r13004  
    387387;;; may not be meaningful.
    388388(defcallback xcmain (:address xp :address xcf :int signal :long code :long addr :long other :int)
    389   (let* ((frame-ptr (macptr->fixnum xcf)))
     389  (let* ((frame-ptr (macptr->fixnum xcf))
     390         (skip 0))
    390391    (cond ((zerop signal)               ;thread interrupt
    391392           (cmain))
     
    431432             ((= code 2)
    432433              ;; Write to a watched object.
    433               (flet ((%int-to-object (i)
    434                        (rlet ((a :address))
    435                          (setf (%get-ptr a) (%int-to-ptr i))
    436                          (%get-object a 0))))
    437                 (let ((object (%int-to-object other)))
     434              (let* ((offset other)
     435                     ;; The kernel exception handler leaves the
     436                     ;; watched object on the lisp stack under the
     437                     ;; xcf.
     438                     (object (%get-object xcf target::xcf.size)))
     439                (multiple-value-bind (insn insn-length)
     440                    (ignore-errors (x86-faulting-instruction xp))
    438441                  (restart-case (%error (make-condition
    439442                                         'write-to-watched-object
    440                                          :address addr
    441                                          :object object)
     443                                         :offset offset
     444                                         :object object
     445                                         :instruction insn)
    442446                                        nil frame-ptr)
     447                    (skip ()
     448                      :test (lambda (c)
     449                              (declare (ignore c))
     450                              insn)
     451                      :report "Skip over this write instruction."
     452                      (setq skip insn-length))
    443453                    (unwatch ()
    444                       :report (lambda (s)
    445                                 (format s "Unwatch ~s and perform the write." object))
     454                      :report "Unwatch the object and retry the write."
    446455                      (unwatch object))))))))
    447456          ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
     
    454463                                     :write-p (not (zerop code)))
    455464                     ()
    456                      frame-ptr)))))
    457   0)
     465                     frame-ptr))))
     466    skip))
     467
     468(defun x86-faulting-instruction (xp)
     469  (let* ((code-bytes (make-array 15 :element-type '(unsigned-byte 8)))
     470         (pc (indexed-gpr-macptr xp #+x8632-target eip-register-offset
     471                                    #+x8664-target rip-register-offset)))
     472    (dotimes (i (length code-bytes))
     473      (setf (aref code-bytes i) (%get-unsigned-byte pc i)))
     474    (let* ((ds (make-x86-disassembly-state
     475                :mode-64 #+x8664-target t #+x8632-target nil
     476                :code-vector code-bytes
     477                :code-pointer 0))
     478           (insn (x86-disassemble-instruction ds nil))
     479           (len (- (x86-ds-code-pointer ds) (x86-ds-insn-start ds))))
     480      (values insn len))))
Note: See TracChangeset for help on using the changeset viewer.