Changeset 10461


Ignore:
Timestamp:
Aug 13, 2008, 11:41:37 AM (11 years ago)
Author:
gb
Message:

Hold locks and be more careful in PROCESS-WHOSTATE and
SYMBOL-VALUE-IN-PROCESS. Note that the lock-holding can be a bit
dangerous and can slow things down a bit, but that's generally
better than crashing.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-processes.lisp

    r10426 r10461  
    211211        (thread-exhausted-p thread))))
    212212 
    213 
     213;;; This should be way more concerned about being correct and thread-safe
     214;;; than about being quick: it's generally only called while printing
     215;;; or debugging, and there are all kinds of subtle race conditions
     216;;; here.
    214217(defun process-whostate (p)
    215218  "Return a string which describes the status of a specified process."
    216   (if (process-exhausted-p p)
    217     "Exhausted"
    218     (let* ((loc nil))
    219     (if (eq p *current-process*)
    220       (setq loc (%tcr-binding-location (%current-tcr) '*whostate*))
    221       (let* ((tcr (process-tcr p)))
    222         (without-interrupts
    223          (unwind-protect
    224               (progn
    225                 (%suspend-tcr tcr)
    226                 (setq loc (%tcr-binding-location tcr '*whostate*)))
    227            (%resume-tcr tcr)))))
    228     (if loc
    229       (%fixnum-ref loc)
    230       (if (eq p *initial-process*)
    231         "Active"
    232         "Reset")))))
     219    (let* ((ip *initial-process*))
     220      (cond ((eq p *current-process*)
     221             (if (%tcr-binding-location (%current-tcr) '*whostate*)
     222               *whostate*
     223               (if (eq p ip)
     224                 "Active"
     225                 "Reset")))
     226            (t
     227             (without-interrupts
     228              (with-lock-grabbed (*kernel-exception-lock*)
     229               (with-lock-grabbed (*kernel-tcr-area-lock*)
     230                 (let* ((tcr (process-tcr p)))
     231                   (if tcr
     232                     (unwind-protect
     233                          (let* ((loc nil))
     234                            (%suspend-tcr tcr)
     235                            (setq loc (%tcr-binding-location tcr '*whostate*))
     236                            (if loc
     237                              (%fixnum-ref loc)
     238                              (if (eq p ip)
     239                                "Active"
     240                                "Reset")))
     241                       (%resume-tcr tcr))
     242                     "Exhausted")))))))))
    233243
    234244(defun (setf process-whostate) (new p)
     
    257267  (if (eq process *current-process*)
    258268    (symbol-value sym)
    259     (symbol-value-in-tcr sym (process-tcr process))))
     269    (let* ((val
     270            (without-interrupts
     271             (with-lock-grabbed (*kernel-exception-lock*)
     272               (with-lock-grabbed (*kernel-tcr-area-lock*)
     273                 (let* ((tcr (process-tcr process)))
     274                   (if tcr
     275                     (symbol-value-in-tcr sym tcr)
     276                     (%sym-global-value sym))))))))
     277      (if (eq val (%unbound-marker))
     278        ;; This might want to be a CELL-ERROR.
     279        (error "~S is unbound in ~S." sym process)
     280        val))))
    260281
    261282(defun (setf symbol-value-in-process) (value sym process)
    262283  (if (eq process *current-process*)
    263284    (setf (symbol-value sym) value)
    264     (setf (symbol-value-in-tcr sym (process-tcr process)) value)))
     285    (with-lock-grabbed (*kernel-exception-lock*)
     286      (with-lock-grabbed (*kernel-tcr-area-lock*)
     287        (let* ((tcr (process-tcr process)))
     288          (if tcr
     289            (setf (symbol-value-in-tcr sym tcr) value)
     290            (%set-sym-global-value sym value)))))))
    265291
    266292
Note: See TracChangeset for help on using the changeset viewer.