Changeset 12983


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

Change the slots in write-to-watched-object around a bit; change reporting
function.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/watchpoints/level-1/l1-error-system.lisp

    r12932 r12983  
    104104
    105105(define-condition write-to-watched-object (storage-condition)
    106   ((address :initarg :address)
     106  ((object :initform nil :initarg :object
     107           :reader write-to-watched-object-object)
     108   (offset :initarg :offset)
    107109   (instruction :initform nil :initarg :instruction)
    108    (object :initform nil :initarg :object)
    109    (target :reader write-to-watched-object-target)
    110    (location :reader write-to-watched-object-location))
     110   (containing-object :initform nil)
     111   (location :initform nil :reader write-to-watched-object-location))
    111112  (:report report-write-to-watched-object))
    112113
    113 (defmethod initialize-instance :after ((condition write-to-watched-object)
     114(defmethod initialize-instance :after ((c write-to-watched-object)
    114115                                       &key &allow-other-keys)
    115   (multiple-value-bind (what where)
    116       (watched-object-and-location condition)
    117     (setf (slot-value condition 'target) what
    118           (slot-value condition 'location) where)))
     116  (setf (slot-value c 'containing-object)
     117        (watched-object-container (slot-value c 'object)))
     118  (setf (slot-value c 'location) (watched-object-write-location c)))
    119119
    120120(defun report-write-to-watched-object (c s)
    121   (with-slots (object address instruction) c
    122     ;; This is safe only because watched objects are in a
    123     ;; static GC area and (we hope) won't be moved around.
    124     (with-slots (target location) c
    125       (format s "Write to watched object ~s, key/index ~s~%"
    126               target location))
     121  (with-slots (object offset containing-object location instruction) c
     122    (format s "~&Write to watched object ~s" object)
     123    (unless (eq object containing-object)
     124      (format s " (part of ~s)" containing-object))
     125    (format s ", location ~s" location)
    127126    (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
    128127                                           #+x8632-target nil
Note: See TracChangeset for help on using the changeset viewer.