Index: /branches/watchpoints/lib/misc.lisp
===================================================================
--- /branches/watchpoints/lib/misc.lisp	(revision 12929)
+++ /branches/watchpoints/lib/misc.lisp	(revision 12930)
@@ -1044,14 +1044,43 @@
               (%ptr-to-int (%svref lock target::lock._value-cell)))))
 
+(defun primitive-watch (thing)
+  (check-type thing (or cons (satisfies uvectorp)))
+  (%watch thing))
+
+(defun all-watched-objects ()
+  (let (result)
+    (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
+    result))
+
+(defvar *watch-reverse-map* (make-hash-table))
+
+;;; DWIM-y interface to watching objects
 (defun watch (&optional thing)
-  (if thing
-    (progn
-      (require-type thing '(or cons (satisfies uvectorp)))
-      (%watch thing))
-    (let (result)
-      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
-      result)))
+  (cond
+    ((null thing)
+     (all-watched-objects))
+    ((hash-table-p thing)
+     (let ((vector (nhash.vector thing)))
+       (setf (gethash vector *watch-reverse-map*) thing)
+       (primitive-watch vector)))
+    ((arrayp thing)
+     (multiple-value-bind (data offset) (array-data-and-offset thing)
+       (declare (ignore offset))
+       (setf (gethash data *watch-reverse-map*) thing)
+       (primitive-watch data)))
+    ((standard-instance-p thing)
+     (let ((slots (instance-slots thing)))
+       (setf (gethash slots *watch-reverse-map*) thing)
+       (primitive-watch slots)))
+    (t
+     (primitive-watch thing))))
 
 (defun unwatch (thing)
+  (maphash #'(lambda (k v)
+	       (when (eq v thing)
+		 (setq thing k)))
+	   *watch-reverse-map*)
+  (remhash thing *watch-reverse-map*)
+  (check-type thing (or cons (satisfies uvectorp)))
   (%map-areas #'(lambda (x)
 		  (when (eq x thing)
@@ -1068,5 +1097,5 @@
 ;;; These functions would seem to belong somewhere else.
       
-;; This will work only if the uvector is in a static gc area.
+;; This will work reliably only if the uvector is in a static gc area.
 (defun %uvector-index-for-address (uvector address)
   (let* ((size (uvsize uvector))
@@ -1080,4 +1109,45 @@
          (index (/ offset bytes-per-element)))
     index))
+
+(defun %array-index-for-address (array address)
+  (multiple-value-bind (data 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* ((v (nhash.vector hash-table))
+	 (i (%uvector-index-for-address v address))
+	 (key (uvref v (1- i))))
+    (values hash-table key)))
+
+(defun %slot-name-for-address (object address)
+  (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)))
+    (cond
+      ((hash-table-p user-object)
+       (%hash-table-key-for-address user-object address))
+      ((arrayp user-object)
+       (%array-index-for-address user-object address))
+      ((standard-instance-p user-object)
+       (%slot-name-for-address user-object address))
+      ((uvectorp user-object)
+       (%uvector-index-for-address user-object address))
+      ((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)))))
+      (t
+       (values user-object :unknown)))))
 
 (defun x86-imm-reg-p (reg-num)