Changeset 12983

Timestamp:

Oct 9, 2009, 9:47:12 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

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

File:

• branches/watchpoints/level-1/l1-error-system.lisp (modified) (1 diff)

branches/watchpoints/level-1/l1-error-system.lisp

@@ -104 +104 @@
 
 (define-condition write-to-watched-object (storage-condition)
-  ((address :initarg :address)
+  ((object :initform nil :initarg :object
+           :reader write-to-watched-object-object)
+   (offset :initarg :offset)
    (instruction :initform nil :initarg :instruction)
-   (object :initform nil :initarg :object)
-   (target :reader write-to-watched-object-target)
-   (location :reader write-to-watched-object-location))
+   (containing-object :initform nil)
+   (location :initform nil :reader write-to-watched-object-location))
   (:report report-write-to-watched-object))
 
-(defmethod initialize-instance :after ((condition write-to-watched-object)
+(defmethod initialize-instance :after ((c write-to-watched-object)
                                        &key &allow-other-keys)
-  (multiple-value-bind (what where)
-      (watched-object-and-location condition)
-    (setf (slot-value condition 'target) what
-          (slot-value condition 'location) where)))
+  (setf (slot-value c 'containing-object)
+        (watched-object-container (slot-value c 'object)))
+  (setf (slot-value c 'location) (watched-object-write-location c)))
 
 (defun report-write-to-watched-object (c s)
-  (with-slots (object address instruction) c
-    ;; This is safe only because watched objects are in a
-    ;; static GC area and (we hope) won't be moved around.
-    (with-slots (target location) c
-      (format s "Write to watched object ~s, key/index ~s~%"
-              target location))
+  (with-slots (object offset containing-object location instruction) c
+    (format s "~&Write to watched object ~s" object)
+    (unless (eq object containing-object)
+      (format s " (part of ~s)" containing-object))
+    (format s ", location ~s" location)
     (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
                                            #+x8632-target nil