Changeset 7330


Ignore:
Timestamp:
Oct 1, 2007, 6:13:02 PM (12 years ago)
Author:
wws
Message:

(join-process (p process) &key default)

Waits for process p to quit. Returns the values returned by it initial
function if it quits normally. If killed, returns default if
specified, or signals an error otherwise.
Patterned after SBCL's join-thread function.

Location:
trunk/ccl
Files:
2 edited

Legend:

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

    r6942 r7330  
    137137                         :type (satisfies valid-allocation-quantum-p))
    138138     (dribble-stream :initform nil)
    139      (dribble-saved-terminal-io :initform nil))
     139     (dribble-saved-terminal-io :initform nil)
     140     (result :initform (cons nil nil)
     141             :reader process-result))
    140142  (:primary-p t))
    141143
     
    333335         (kill (handler-case
    334336                   (restart-case
    335                     (progn
    336                       (apply (car initial-form) (cdr (the list initial-form)))
     337                    (let ((values
     338                           (multiple-value-list
     339                            (apply (car initial-form)
     340                                   (cdr (the list initial-form)))))
     341                          (result (process-result process)))
     342                      (setf (cdr result) values
     343                            (car result) t)
    337344                      (setq exited t)
    338345                      nil)
     
    662669                              (make-broadcast-stream out f)))))
    663670      path)))
     671
     672(defmethod join-process ((p process) &key (default nil defaultp))
     673  (wait-on-semaphore (process-termination-semaphore p) nil "join-process")
     674  (let ((result (process-result p)))
     675    (cond ((car result) (values-list (cdr result)))
     676          (defaultp default)
     677          (t (error "Failed to join ~s" p)))))
  • trunk/ccl/lib/ccl-export-syms.lisp

    r6979 r7330  
    433433     default-allocation-quantum
    434434     current-process-allocation-quantum
     435     join-process
    435436
    436437     *HOST-PAGE-SIZE*
Note: See TracChangeset for help on using the changeset viewer.