Changeset 15155 for trunk/source/level-1


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.

Location:
trunk/source/level-1
Files:
3 edited

Legend:

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

    r14790 r15155  
    5656(def-standard-initial-binding *package*)
    5757(def-standard-initial-binding *random-state* (initial-random-state))
    58 (def-standard-initial-binding *whostate* "Reset")
    59 (setq *whostate* "Reset")
    6058(def-standard-initial-binding *error-print-length* 20)
    6159(def-standard-initial-binding *error-print-level* 8)
  • trunk/source/level-1/l1-lisp-threads.lisp

    r15145 r15155  
    11901190          (setf (%fixnum-ref catch target::catch-frame.db-link) bsp)))))
    11911191  (let* ((thread (new-lisp-thread-from-tcr (%current-tcr) "foreign")))
    1192     (setq *current-lisp-thread* thread
    1193           *current-process*
    1194           (make-process "foreign" :thread thread)
    1195           *whostate* "Foreign thread callback")))
     1192    (setf *current-lisp-thread* thread
     1193          *current-process* (make-process "foreign" :thread thread)
     1194          (car (process-whostate-cell *current-process*)) "Foreign thread callback")))
    11961195   
    11971196;;; Remove the foreign thread's lisp-thread and lisp process from
  • 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.