Changeset 12903

Timestamp:

Oct 3, 2009, 3:42:17 AM (10 years ago)

Author:

rme

Message:

Add instruction slot to write-to-watched-object condition. Print it out
when reporting.

File:

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

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

@@ -105 +105 @@
 (define-condition write-to-watched-object (storage-condition)
   ((address :initarg :address)
+   (instruction :initform nil :initarg :instruction)
    (object :initform nil :initarg :object))
   (:report (lambda (c s)
-             (with-slots (object address) c
+             (with-slots (object address instruction) c
                (if (uvectorp object)
                  ;; This is safe only because watched objects are in a
@@ -121 +122 @@
                         (index (/ offset bytes-per-element)))
                    (format s "Write to watched object ~s at address #x~x (uvector index ~d)." object address index))
-                 (format s "Write to watched object ~s at address #x~x" object address))))))
+                 (format s "Write to watched object ~s at address #x~x" object address))
+               (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
+                                                      #+x8632-target nil
+                                                      :code-vector nil
+                                                      :code-pointer 0))
+                      (str (with-output-to-string (*standard-output*)
+                             (x86-print-one-disassembled-instruction ds instruction))))
+                 (format s "~&Faulting instruction: ~a" (string-trim " " str)))))))
 
 (define-condition type-error (error)