Changeset 12984


Ignore:
Timestamp:
Oct 10, 2009, 4:53:23 AM (10 years ago)
Author:
rme
Message:

When handling a write to a watched object, try to be more careful about
assuming that the object is in a static gc area. This is the idea behind
using offsets from the tagged object pointer, rather than an address passed
as an integer.

In lieu of using the passed in address to locate the watched object,
assume that the kernel will have pushed the watched object onto the lisp
stack immediately before the xcf.

Don't offer to emulate writes on Windows platforms, since they don't
have #_mprotect. (This is just laziness. Windows has #_VirtualProtect, so
it's just a matter of using it correctly and testing it.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/watchpoints/level-1/x86-trap-support.lisp

    r12931 r12984  
    432432             ((= code 2)
    433433              ;; Write to a watched object.
    434               ;; We somehow need to guard against another thread unwatching
    435               ;; the object out from underneath us.
    436               (flet ((%int-to-object (i)
    437                        (rlet ((a :address))
    438                          (setf (%get-ptr a) (%int-to-ptr i))
    439                          (%get-object a 0))))
    440                 (let ((object (%int-to-object other)))
     434              ;;
     435              ;; A potential problem here is that some other thread
     436              ;; might unwatch the object while we're in here trying
     437              ;; to figure out what happened.
     438              (let* ((offset other)
     439                     ;; The kernel exception handler has put the object
     440                     ;; on the lisp stack under the xcf.
     441                     (object (%get-object xcf target::xcf.size))
     442                     (result nil))
    441443                  (multiple-value-bind (insn insn-length)
    442444                      (x86-faulting-instruction xp)
     
    444446                                           'write-to-watched-object
    445447                                           :instruction insn
    446                                            :address addr
     448                                           :offset offset
    447449                                           :object object)
    448450                                          nil frame-ptr)
    449                       ;; This certainly has the potential to cause amusing
    450                       ;; errors.
     451                      #-windows-target
    451452                      (allow ()
     453                        ;; There may be subtle race conditions here.
    452454                        :report "Allow this write."
    453455                        :test (lambda (c)
     
    455457                                (string= (subseq (x86-di-mnemonic insn) 0 3)
    456458                                         "mov"))
    457                         (let ((result nil)
    458                               (ptr (%int-to-ptr
    459                                     (logandc2 addr (1- *host-page-size*)))))
     459                        (flet ((watchedp (object)
     460                                 (%map-areas #'(lambda (x)
     461                                                 (when (eq object x)
     462                                                   (return-from watchedp t)))
     463                                             area-watched area-watched)))
    460464                          (with-other-threads-suspended
    461                             (#_mprotect ptr *host-page-size*
    462                                         #$PROT_WRITE)
    463                             (setq result (x86-emulate-write-instruction xp insn addr object))
    464                             (#_mprotect ptr *host-page-size*
    465                                         (logior #$PROT_READ #$PROT_EXEC)))
     465                            (when (watchedp object)
     466                              ;; We now trust that the object is in a
     467                              ;; static gc area.
     468                              (let* ((a (+ (%address-of object) offset))
     469                                     (ptr (%int-to-ptr
     470                                           (logandc2 a (1- *host-page-size*)))))
     471                                (#_mprotect ptr *host-page-size* #$PROT_WRITE)
     472                                (setq result (x86-emulate-write-instruction
     473                                              xp insn offset object))
     474                                (#_mprotect ptr *host-page-size*
     475                                            (logior #$PROT_READ #$PROT_EXEC)))))
    466476                          (if result
    467477                            (setq skip insn-length)
     
    472482                      (unwatch ()
    473483                        :report (lambda (s)
    474                                   (format s "Unwatch ~s and perform the write." object))
    475                         (unwatch object)))))))))
     484                                  (format s "Unwatch ~s and perform the write."
     485                                          object))
     486                        (unwatch object))))))))
    476487          ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
    477488           (if (= code -1)
     
    488499(defun x86-faulting-instruction (xp)
    489500  (let* ((code-bytes (make-array 15 :element-type '(unsigned-byte 8)))
    490          (pc (indexed-gpr-macptr xp rip-register-offset)))
     501         (pc (indexed-gpr-macptr xp #+x8632-target eip-register-offset
     502                                    #+x8664-target rip-register-offset)))
    491503    (dotimes (i (length code-bytes))
    492504      (setf (aref code-bytes i) (%get-unsigned-byte pc i)))
Note: See TracChangeset for help on using the changeset viewer.