Ignore:
Timestamp:
Dec 24, 2011, 1:11:50 AM (8 years ago)
Author:
gb
Message:

Keep process-whostate in a (CONS) cell in a slot in the PROCESS
object, not in a thread-local binding (so that we don't have to
suspend a process to print it.)

WITH-PROCESS-WHOSTATE needs to access this slot once and RPLACA it a
couple of times and needs to use UNWIND-PROTECT.

File:
1 edited

Legend:

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

    r15141 r15155  
    140140     (dribble-saved-terminal-io :initform nil)
    141141     (result :initform (cons nil nil)
    142              :reader process-result))
     142             :reader process-result)
     143     (whostate-cell :initform (list "Reset")
     144                    :reader process-whostate-cell))
    143145  (:primary-p t))
    144146
     
    228230(defun process-whostate (p)
    229231  "Return a string which describes the status of a specified process."
    230     (let* ((ip *initial-process*))
    231       (cond ((eq p *current-process*)
    232              (if (%tcr-binding-location (%current-tcr) '*whostate*)
    233                *whostate*
    234                (if (eq p ip)
    235                  "Active"
    236                  "Reset")))
    237             (t
    238              (without-interrupts
    239               (with-lock-grabbed (*kernel-exception-lock*)
    240                (with-lock-grabbed (*kernel-tcr-area-lock*)
    241                  (let* ((tcr (process-tcr p)))
    242                    (if tcr
    243                      (unwind-protect
    244                           (let* ((loc nil))
    245                             (%suspend-tcr tcr)
    246                             (setq loc (%tcr-binding-location tcr '*whostate*))
    247                             (if loc
    248                               (%fixnum-ref loc)
    249                               (if (eq p ip)
    250                                 "Active"
    251                                 "Reset")))
    252                        (%resume-tcr tcr))
    253                      "Exhausted")))))))))
     232  (car (process-whostate-cell p)))
    254233
    255234(defun (setf process-whostate) (new p)
    256   (unless (process-exhausted-p p)
    257     (setf (symbol-value-in-process '*whostate* p) new)))
     235  (setf (car (process-whostate-cell p)) new))
    258236
    259237
     
    379357            (add-to-all-processes process)
    380358            (with-initial-bindings (process-initial-bindings process)
    381               (setq *whostate* "Active")
    382               (run-process-initial-form process initial-form))))
     359              (with-process-whostate ("Active")
     360                (run-process-initial-form process initial-form)))))
    383361      process
    384362      initial-form)
     
    419397   (if (eq kill :shutdown)
    420398     (progn
    421        (setq *whostate* "Shutdown")
     399       (setf (car (process-whostate-cell process)) "Shutdown")
    422400       (add-to-shutdown-processes process)))
    423401   (let* ((semaphore (process-termination-semaphore process)))
Note: See TracChangeset for help on using the changeset viewer.