diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 2c3e0ff555b818e38690732c8faf5e84a1e805c7..6c7bbedc5f61666fc30eb1058e29e59192415369 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -2388,6 +2388,7 @@ "ATOMIC-PUSH" "CURRENT-PROCESS" "DESTROY-PROCESS" "DISABLE-PROCESS" "ENABLE-PROCESS" "INIT-STACK-GROUPS" "LOCK" "MAKE-STACK-GROUP" "MAKE-LOCK" "MAKE-PROCESS" "PROCESS-ACTIVE-P" + "PROCESS-JOIN" "PROCESS-ADD-ARREST-REASON" "PROCESS-ADD-RUN-REASON" "PROCESS-ALIVE-P" "PROCESS-ARREST-REASONS" "PROCESS-IDLE-TIME" "PROCESS-INTERRUPT" "PROCESS-NAME" diff --git a/src/code/multi-proc.lisp b/src/code/multi-proc.lisp index b0ce883a1d172c6eca19c34d6d846ebea0276496..e478a958facb624e9f1148f61090c8254e2fb332 100644 --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -298,6 +298,7 @@ (%real-time 0d0 :type double-float) (%run-time 0d0 :type double-float) (property-list nil :type list) + (%return-values nil :type list) (initial-bindings nil :type list)) @@ -956,9 +957,11 @@ (with-simple-restart (destroy "Destroy the process") (setf *inhibit-scheduling* nil) - (apply-with-bindings function - nil - initial-bindings)) + (setf (process-%return-values *current-process*) + (multiple-value-list + (apply-with-bindings function + nil + initial-bindings)))) ;; Normal exit. (throw '%end-of-the-process nil)))) (setf *inhibit-scheduling* t) @@ -1973,19 +1976,7 @@ #-x86 (when (eq (lock-process ,lock) *current-process*) (setf (lock-process ,lock) nil))))))) -(defun %make-thread (function name) - (mp:make-process (lambda () - (let ((return-values - (multiple-value-list (funcall function)))) - (setf (getf (mp:process-property-list mp:*current-process*) - 'return-values) - return-values) - (values-list return-values))) - :name name)) - -(defun join-thread (thread) +(defun process-join (process) (mp:process-wait (format nil "Waiting for thread ~A to complete" thread) (lambda () (not (mp:process-alive-p thread)))) - (let ((return-values - (getf (mp:process-property-list thread) 'return-values))) - (values-list return-values))) + (values-list (process-%return-values process))) diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index 06c2fc67e4e4f4d571598e091b2790298eed8bea..d38c14cf81cf64083eadece2cdacb44b863438f5 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -42,7 +42,7 @@ New in this release: * :I486 and :PENTIUM (Always assume we're running on at least a Pentium.) * Update unicode to support Unicode 6.2. - * Add MP:JOIN-THREAD, as given in ticket #77. + * Add MP:PROCESS-JOIN, as given in ticket #77. * ANSI compliance fixes: * Attempts to modify the standard readtable or the standard pprint