Changeset 13007

Timestamp:

Oct 12, 2009, 9:00:54 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

New function ALL-WATCHED-OBJECTS. Try to be at least instantaneously
correct by mapping over watched areas with other threads suspended.

Use ALL-WATCHED-OBJECTS in WATCH.

Suspend other threads in UNWATCH, too.

File:

• trunk/source/lib/misc.lisp (modified) (2 diffs)

trunk/source/lib/misc.lisp

@@ -1052 +1052 @@
               (%ptr-to-int (%svref lock target::lock._value-cell)))))
 
+(defun all-watched-objects ()
+  (let (result)
+    (with-other-threads-suspended
+      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched))
+    result))
+    
 (defun watch (&optional thing)
   (if thing
@@ -1057 +1063 @@
       (require-type thing '(or cons (satisfies uvectorp)))
       (%watch thing))
-    (let (result)
-      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
-      result)))
+    (all-watched-objects)))
 
 (defun unwatch (thing)
-  (%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))
+  (with-other-threads-suspended
+    (%map-areas #'(lambda (x)
+                    (when (eq x thing)
+                      (let ((new (if (uvectorp thing)
+                                   (%alloc-misc (uvsize thing)
+                                                (typecode thing))
+                                   (cons nil nil))))
+                        (return-from unwatch (%unwatch thing new)))))
+                area-watched area-watched)))