Index: /branches/watchpoints/lib/misc.lisp
===================================================================
--- /branches/watchpoints/lib/misc.lisp	(revision 12985)
+++ /branches/watchpoints/lib/misc.lisp	(revision 12986)
@@ -1050,5 +1050,6 @@
 (defun all-watched-objects ()
   (let (result)
-    (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
+    (with-other-threads-suspended
+      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched))
     result))
 
@@ -1077,26 +1078,26 @@
 
 (defun unwatch (thing)
-  (maphash #'(lambda (k v)
-	       (when (eq v thing)
-		 (setq thing k)))
-	   *watch-reverse-map*)
+  (block search
+    (maphash #'(lambda (k v)
+		 (when (eq v thing)
+		   (setq thing k)
+		   (return-from search)))
+	     *watch-reverse-map*))
   (remhash thing *watch-reverse-map*)
   (check-type thing (or cons (satisfies uvectorp)))
-  (%map-areas #'(lambda (x)
-		  (when (eq x thing)
-		    ;; This is a rather questionable thing to do,
-		    ;; since we'll be unlinking an area from the area
-		    ;; list while %map-areas iterates over it, but I
-		    ;; think we'll get away with it.
-		    (let ((new (if (uvectorp thing)
-				 (%alloc-misc (uvsize thing) (typecode thing))
-				 (cons nil nil))))
-		      (return-from unwatch (%unwatch thing new)))))
-	      area-watched area-watched))
-
-;;; These functions would seem to belong somewhere else.
-      
-;; This will work reliably only if the uvector is in a static gc area.
-(defun %uvector-index-for-address (uvector address)
+  (with-other-threads-suspended
+    (%map-areas #'(lambda (x)
+		    (when (eq x thing)
+		      ;; Note that we'll be unlinking an area from the
+		      ;; area list while %map-areas iterates over it.
+		      (let ((new (if (uvectorp thing)
+				   (%alloc-misc (uvsize thing)
+						(typecode thing))
+				   (cons nil nil))))
+			(return-from unwatch (%unwatch thing new)))))
+		area-watched area-watched)))
+
+;; offset is byte offset from tagged uvector pointer
+(defun %uvector-index-for-offset (uvector offset)
   (let* ((size (uvsize uvector))
          (nbytes (if (ivectorp uvector)
@@ -1104,60 +1105,58 @@
                    (* size target::node-size)))
          (bytes-per-element (/ nbytes size))
-         (noderef (logandc2 (%address-of uvector)
-                            target::fulltagmask))
-         (offset (- address (+ noderef target::node-size)))
+	 ;; account for tag, header
+	 (offset (- offset target::misc-data-offset))
          (index (/ offset bytes-per-element)))
-    index))
-
-(defun %array-index-for-address (array address)
-  (multiple-value-bind (data offset)
+    (if (fixnump index)
+      index
+      (error "offset corresponds to non-integral index"))))
+
+(defun %array-index-for-offset (array offset)
+  (multiple-value-bind (array-data array-offset)
       (array-data-and-offset array)
-    (let* ((i (%uvector-index-for-address data address)))
-      (values array (+ i offset)))))
-
-(defun %hash-table-key-for-address (hash-table address)
+    (let* ((i (%uvector-index-for-offset array-data offset)))
+      (- i array-offset))))
+
+(defun %hash-table-key-for-offset (hash-table offset)
   (let* ((v (nhash.vector hash-table))
-	 (i (%uvector-index-for-address v address))
+	 (i (%uvector-index-for-offset v offset))
 	 (key (uvref v (1- i))))
-    (values hash-table key)))
-
-(defun %slot-name-for-address (object address)
+    key))
+
+(defun %slot-name-for-offset (object offset)
   (let* ((wrapper (instance-class-wrapper object))
 	 (slot-names (%wrapper-instance-slots wrapper))
 	 (slots (instance.slots object))
-	 (i (%uvector-index-for-address slots address)))
-    (values object (svref slot-names i))))
-
-(defun watched-object-and-location (condition)
-  (let* ((watched-object (slot-value condition 'object))
-	 (address (slot-value condition 'address))
-	 (user-object (or (gethash watched-object *watch-reverse-map*)
-			  watched-object)))
+	 (i (%uvector-index-for-offset slots offset)))
+    ;; slot-vectors have their corresponding instance in element 0
+    (decf i)
+    (svref slot-names i)))
+
+(defun watched-object-container (object)
+  (or (gethash object *watch-reverse-map*) object))
+
+(defun watched-object-write-location (condition)
+  (let* ((object (slot-value condition 'object))
+	 (offset (slot-value condition 'offset))
+	 (user-object (watched-object-container object)))
     (cond
       ((hash-table-p user-object)
-       (%hash-table-key-for-address user-object address))
+       (%hash-table-key-for-offset user-object offset))
       ((arrayp user-object)
-       (%array-index-for-address user-object address))
+       (%array-index-for-offset user-object offset))
       ((standard-instance-p user-object)
-       (%slot-name-for-address user-object address))
+       (%slot-name-for-offset user-object offset))
       ((uvectorp user-object)
-       (%uvector-index-for-address user-object address))
+       (%uvector-index-for-offset user-object offset))
       ((consp user-object)
-       (let* ((node (%address-of user-object)))
-	 (if (= address (+ node target::cons.cdr))
-	   (values user-object (cdr user-object))
-	   (values user-object (car user-object)))))
+       (if (= offset target::cons.cdr)
+	 (cdr user-object)
+	 (car user-object)))
       (t
-       (values user-object :unknown)))))
-
-(defun x86-imm-reg-p (reg-num)
-  (member reg-num (list x8664::imm0 x8664::imm1 x8664::imm2
-                        x8664::imm0.l x8664::imm0.l x8664::imm2.l
-                        x8664::imm0.w x8664::imm0.w x8664::imm2.w
-                        x8664::imm0.b x8664::imm0.b x8664::imm2.b)))
+       nil))))
 
 ;;; Try to emulate the instruction.  Returns true on success,
-;;; NIL on failure.  If dest isn't in a static area, we will lose...
-(defun x86-emulate-write-instruction (xp insn addr dest)
+;;; NIL on failure.
+(defun x86-emulate-write-instruction (xp insn offset dest)
   (let ((op0 (x86-di-op0 insn)))
     (unless (and (typep op0 'x86::x86-register-operand)
@@ -1169,19 +1168,14 @@
         (cond ((gvectorp dest)
                (let* ((src (encoded-gpr-lisp xp reg-num))
-                      (index (%uvector-index-for-address dest addr)))
-                 (if (fixnump index)
-                   (setf (uvref dest index) src))))
+                      (index (%uvector-index-for-offset dest offset)))
+		 (setf (uvref dest index) src)))
               ((ivectorp dest)
-               (let* ((src (if (x86-imm-reg-p reg-num)
-                             (encoded-gpr-integer xp reg-num)
-                             (encoded-gpr-lisp xp reg-num)))
-                      (index (%uvector-index-for-address dest addr)))
-                 (if (fixnump index)
-                   (setf (uvref dest index) src))
-               (setq src (encoded-gpr-lisp xp reg-num)))))
+               (let* ((src (encoded-gpr-integer xp reg-num))
+                      (index (%uvector-index-for-offset dest offset)))
+		 (setf (uvref dest index) src))))
         (if (consp dest)
           (let* ((src (encoded-gpr-lisp xp reg-num)))
-            (if (= addr (+ (%address-of dest) target::cons.cdr))
+            (if (= offset target::cons.cdr)
               (rplacd dest src)
-              (if (= addr (+ (%address-of dest) target::cons.car))
+              (if (= offset target::cons.car)
                 (rplaca dest src)))))))))