Changeset 12932


Ignore:
Timestamp:
Oct 9, 2009, 4:44:56 AM (10 years ago)
Author:
rme
Message:

Add target and location slots to write-to-watched-object condition and fill
them in at initialization time; do a little clean-up.

File:
1 edited

Legend:

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

    r12903 r12932  
    106106  ((address :initarg :address)
    107107   (instruction :initform nil :initarg :instruction)
    108    (object :initform nil :initarg :object))
    109   (:report (lambda (c s)
    110              (with-slots (object address instruction) c
    111                (if (uvectorp object)
    112                  ;; This is safe only because watched objects are in a
    113                  ;; static GC area and won't be moved around.
    114                  (let* ((size (uvsize object))
    115                         (nbytes (if (ivectorp object)
    116                                   (subtag-bytes (typecode object) size)
    117                                   (* size target::node-size)))
    118                         (bytes-per-element (/ nbytes size))
    119                         (noderef (logandc2 (%address-of object)
    120                                            target::fulltagmask))
    121                         (offset (- address (+ noderef target::node-size)))
    122                         (index (/ offset bytes-per-element)))
    123                    (format s "Write to watched object ~s at address #x~x (uvector index ~d)." object address index))
    124                  (format s "Write to watched object ~s at address #x~x" object address))
    125                (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
    126                                                       #+x8632-target nil
    127                                                       :code-vector nil
    128                                                       :code-pointer 0))
    129                       (str (with-output-to-string (*standard-output*)
    130                              (x86-print-one-disassembled-instruction ds instruction))))
    131                  (format s "~&Faulting instruction: ~a" (string-trim " " str)))))))
     108   (object :initform nil :initarg :object)
     109   (target :reader write-to-watched-object-target)
     110   (location :reader write-to-watched-object-location))
     111  (:report report-write-to-watched-object))
     112
     113(defmethod initialize-instance :after ((condition write-to-watched-object)
     114                                       &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)))
     119
     120(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))
     127    (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
     128                                           #+x8632-target nil
     129                                           :code-vector nil
     130                                           :code-pointer 0))
     131           (str (with-output-to-string (*standard-output*)
     132                  (x86-print-one-disassembled-instruction ds instruction))))
     133      (format s "~&Faulting instruction: ~a" (string-trim " " str)))))
    132134
    133135(define-condition type-error (error)
Note: See TracChangeset for help on using the changeset viewer.