Changeset 10212


Ignore:
Timestamp:
Jul 27, 2008, 2:37:10 AM (11 years ago)
Author:
gb
Message:

Hair up PROCESS-WHOSTATE, mostly so that we an handle the case
where there's no dynamic binding of *WHOSTATE* and special
case the initial process.

File:
1 edited

Legend:

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

    r9879 r10212  
    216216  (if (process-exhausted-p p)
    217217    "Exhausted"
    218     (symbol-value-in-process '*whostate* p)))
     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")))))
    219233
    220234(defun (setf process-whostate) (new p)
     
    251265
    252266
    253 (defun process-enable (p &optional (wait 1))
     267(defun process-enable (p &optional (wait (* 60 60 24)))
    254268  "Begin executing the initial function of a specified process."
    255269  (setq p (require-type p 'process))
     
    258272    (error "Process ~s has not been preset.  Use PROCESS-PRESET to preset the process." p))
    259273  (let* ((thread (process-thread p)))
    260     (do* ((total-wait wait (+ total-wait wait)))
     274    (do* ((total-wait wait (+ total-wait (or wait 0))))
    261275         ((thread-enable thread (process-termination-semaphore p) (1- (integer-length (process-allocation-quantum p)))  wait)
    262276          p)
Note: See TracChangeset for help on using the changeset viewer.