Changeset 13007


Ignore:
Timestamp:
Oct 13, 2009, 4:00:54 AM (10 years ago)
Author:
rme
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/misc.lisp

    r12936 r13007  
    10521052              (%ptr-to-int (%svref lock target::lock._value-cell)))))
    10531053
     1054(defun all-watched-objects ()
     1055  (let (result)
     1056    (with-other-threads-suspended
     1057      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched))
     1058    result))
     1059   
    10541060(defun watch (&optional thing)
    10551061  (if thing
     
    10571063      (require-type thing '(or cons (satisfies uvectorp)))
    10581064      (%watch thing))
    1059     (let (result)
    1060       (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
    1061       result)))
     1065    (all-watched-objects)))
    10621066
    10631067(defun unwatch (thing)
    1064   (%map-areas #'(lambda (x)
    1065                   (when (eq x thing)
    1066                     ;; This is a rather questionable thing to do,
    1067                     ;; since we'll be unlinking an area from the area
    1068                     ;; list while %map-areas iterates over it, but I
    1069                     ;; think we'll get away with it.
    1070                     (let ((new (if (uvectorp thing)
    1071                                  (%alloc-misc (uvsize thing) (typecode thing))
    1072                                  (cons nil nil))))
    1073                       (return-from unwatch (%unwatch thing new)))))
    1074               area-watched area-watched))
     1068  (with-other-threads-suspended
     1069    (%map-areas #'(lambda (x)
     1070                    (when (eq x thing)
     1071                      (let ((new (if (uvectorp thing)
     1072                                   (%alloc-misc (uvsize thing)
     1073                                                (typecode thing))
     1074                                   (cons nil nil))))
     1075                        (return-from unwatch (%unwatch thing new)))))
     1076                area-watched area-watched)))
    10751077     
Note: See TracChangeset for help on using the changeset viewer.