From c94b32f927061d6e7b7ea1ebf92ccdb4c3b1a842 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sun, 24 Mar 2013 20:13:56 -0700 Subject: [PATCH] Fix ticket:77 correctly, using the supplied patch link. --- src/code/exports.lisp | 1 + src/code/multi-proc.lisp | 25 ++++++++----------------- src/general-info/release-20e.txt | 2 +- 3 files changed, 10 insertions(+), 18 deletions(-) diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 2c3e0ff55..6c7bbedc5 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 b0ce883a1..e478a958f 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 06c2fc67e..d38c14cf8 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 -- GitLab