Index: /branches/watchpoints/level-1/x86-trap-support.lisp
===================================================================
--- /branches/watchpoints/level-1/x86-trap-support.lisp	(revision 12983)
+++ /branches/watchpoints/level-1/x86-trap-support.lisp	(revision 12984)
@@ -432,11 +432,13 @@
 	     ((= code 2)
 	      ;; Write to a watched object.
-	      ;; We somehow need to guard against another thread unwatching
-	      ;; the object out from underneath us.
-	      (flet ((%int-to-object (i)
-		       (rlet ((a :address))
-			 (setf (%get-ptr a) (%int-to-ptr i))
-			 (%get-object a 0))))
-		(let ((object (%int-to-object other)))
+	      ;;
+	      ;; A potential problem here is that some other thread
+	      ;; might unwatch the object while we're in here trying
+	      ;; to figure out what happened.
+	      (let* ((offset other)
+		     ;; The kernel exception handler has put the object
+		     ;; on the lisp stack under the xcf.
+		     (object (%get-object xcf target::xcf.size))
+		     (result nil))
 		  (multiple-value-bind (insn insn-length)
 		      (x86-faulting-instruction xp)
@@ -444,10 +446,10 @@
 					   'write-to-watched-object
 					   :instruction insn
-					   :address addr
+					   :offset offset
 					   :object object)
 					  nil frame-ptr)
-		      ;; This certainly has the potential to cause amusing
-		      ;; errors.
+		      #-windows-target
 		      (allow ()
+			;; There may be subtle race conditions here.
 			:report "Allow this write."
 			:test (lambda (c)
@@ -455,13 +457,21 @@
 				(string= (subseq (x86-di-mnemonic insn) 0 3)
 					 "mov"))
-			(let ((result nil)
-			      (ptr (%int-to-ptr
-				    (logandc2 addr (1- *host-page-size*)))))
+			(flet ((watchedp (object)
+				 (%map-areas #'(lambda (x)
+						 (when (eq object x)
+						   (return-from watchedp t)))
+					     area-watched area-watched)))
 			  (with-other-threads-suspended
-			    (#_mprotect ptr *host-page-size*
-					#$PROT_WRITE)
-			    (setq result (x86-emulate-write-instruction xp insn addr object))
-			    (#_mprotect ptr *host-page-size*
-					(logior #$PROT_READ #$PROT_EXEC)))
+			    (when (watchedp object)
+			      ;; We now trust that the object is in a
+			      ;; static gc area.
+			      (let* ((a (+ (%address-of object) offset))
+				     (ptr (%int-to-ptr
+					   (logandc2 a (1- *host-page-size*)))))
+				(#_mprotect ptr *host-page-size* #$PROT_WRITE)
+				(setq result (x86-emulate-write-instruction
+					      xp insn offset object))
+				(#_mprotect ptr *host-page-size*
+					    (logior #$PROT_READ #$PROT_EXEC)))))
 			  (if result
 			    (setq skip insn-length)
@@ -472,6 +482,7 @@
 		      (unwatch ()
 			:report (lambda (s)
-				  (format s "Unwatch ~s and perform the write." object))
-			(unwatch object)))))))))
+				  (format s "Unwatch ~s and perform the write."
+					  object))
+			(unwatch object))))))))
           ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
            (if (= code -1)
@@ -488,5 +499,6 @@
 (defun x86-faulting-instruction (xp)
   (let* ((code-bytes (make-array 15 :element-type '(unsigned-byte 8)))
-         (pc (indexed-gpr-macptr xp rip-register-offset)))
+         (pc (indexed-gpr-macptr xp #+x8632-target eip-register-offset
+				    #+x8664-target rip-register-offset)))
     (dotimes (i (length code-bytes))
       (setf (aref code-bytes i) (%get-unsigned-byte pc i)))