Changeset 12881

Timestamp:

Sep 23, 2009, 12:28:43 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

In error callback, add restart to unwatch object and continue.

File:

• branches/watchpoints/level-1/x86-trap-support.lisp (modified) (2 diffs)

branches/watchpoints/level-1/x86-trap-support.lisp

@@ -435 +435 @@
                          (setf (%get-ptr a) (%int-to-ptr i))
                          (%get-object a 0))))
-                (%error (make-condition
-                         'write-to-watched-object
-                         :address addr
-                         :object (%int-to-object other))
-                        nil frame-ptr)))))
+                (let ((object (%int-to-object other)))
+                  (restart-case (%error (make-condition
+                                         'write-to-watched-object
+                                         :address addr
+                                         :object object)
+                                        nil frame-ptr)
+                  (unwatch ()
+                    :report (lambda (s)
+                              (format s "Unwatch ~s and perform the write." object))
+                    (unwatch (%int-to-object other)))))))))
           ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
            (if (= code -1)
@@ -452 +457 @@
   0)
 
+#||
+(defun analyze-faulting-instruction (xp)
+  (let* ((ds (make-x86-disassembly-state
+              :mode-64 #+x8664-target t #+x8632-target nil))
+         (insn (make-x86-disassembled-instruction
+                :address (indexed-gpr-integer xp rip-register-offset)
+||#