diff options
Diffstat (limited to 'third_party/lisp/sclf/mp')
| -rw-r--r-- | third_party/lisp/sclf/mp/cmu.lisp | 54 | ||||
| -rw-r--r-- | third_party/lisp/sclf/mp/sbcl.lisp | 94 |
2 files changed, 74 insertions, 74 deletions
diff --git a/third_party/lisp/sclf/mp/cmu.lisp b/third_party/lisp/sclf/mp/cmu.lisp index 6617f6dadd..1bdbba7989 100644 --- a/third_party/lisp/sclf/mp/cmu.lisp +++ b/third_party/lisp/sclf/mp/cmu.lisp @@ -30,14 +30,14 @@ (defmacro with-lock-held ((lock &key whostate (wait t) timeout) &body forms) `(mp:with-lock-held (,lock ,(or whostate "Lock Wait") - :wait wait - ,@(when timeout (list :timeout timeout))) + :wait wait + ,@(when timeout (list :timeout timeout))) ,@forms)) (defmacro with-recursive-lock-held ((lock &key wait timeout) &body forms) `(mp:with-lock-held (,lock - ,@(when wait (list :wait wait)) - ,@(when timeout (list :timeout timeout))) + ,@(when wait (list :wait wait)) + ,@(when timeout (list :timeout timeout))) ,@forms)) (defstruct condition-variable @@ -47,31 +47,31 @@ (defun %release-lock (lock) ; copied from with-lock-held in multiproc.lisp #+i486 (kernel:%instance-set-conditional - lock 2 mp:*current-process* nil) + lock 2 mp:*current-process* nil) #-i486 (when (eq (lock-process lock) mp:*current-process*) - (setf (lock-process lock) nil))) + (setf (lock-process lock) nil))) (defun condition-wait (cv lock &optional timeout) (declare (ignore timeout)) ;For now (loop (let ((cv-lock (condition-variable-lock cv))) (with-lock-held (cv-lock) - (when (condition-variable-value cv) - (setf (condition-variable-value cv) nil) - (return-from condition-wait t)) - (setf (condition-variable-process-queue cv) - (nconc (condition-variable-process-queue cv) - (list mp:*current-process*))) - (%release-lock lock)) + (when (condition-variable-value cv) + (setf (condition-variable-value cv) nil) + (return-from condition-wait t)) + (setf (condition-variable-process-queue cv) + (nconc (condition-variable-process-queue cv) + (list mp:*current-process*))) + (%release-lock lock)) (mp:process-add-arrest-reason mp:*current-process* cv) (let ((cv-val nil)) - (with-lock-held (cv-lock) - (setq cv-val (condition-variable-value cv)) - (when cv-val - (setf (condition-variable-value cv) nil))) - (when cv-val - (mp::lock-wait lock "waiting for condition variable lock") - (return-from condition-wait t)))))) + (with-lock-held (cv-lock) + (setq cv-val (condition-variable-value cv)) + (when cv-val + (setf (condition-variable-value cv) nil))) + (when cv-val + (mp::lock-wait lock "waiting for condition variable lock") + (return-from condition-wait t)))))) (defun condition-notify (cv) (with-lock-held ((condition-variable-lock cv)) @@ -79,12 +79,12 @@ ;; The waiting process may have released the CV lock but not ;; suspended itself yet (when proc - (loop - for activep = (mp:process-active-p proc) - while activep - do (mp:process-yield)) - (setf (condition-variable-value cv) t) - (mp:process-revoke-arrest-reason proc cv)))) + (loop + for activep = (mp:process-active-p proc) + while activep + do (mp:process-yield)) + (setf (condition-variable-value cv) t) + (mp:process-revoke-arrest-reason proc cv)))) ;; Give the other process a chance (mp:process-yield)) @@ -100,7 +100,7 @@ (defun destroy-process (process) ;; silnetly ignore a process that is trying to destroy itself (unless (eq (mp:current-process) - process) + process) (mp:destroy-process process))) (defun restart-process (process) diff --git a/third_party/lisp/sclf/mp/sbcl.lisp b/third_party/lisp/sclf/mp/sbcl.lisp index 7f47ec9c61..a2cf497ff9 100644 --- a/third_party/lisp/sclf/mp/sbcl.lisp +++ b/third_party/lisp/sclf/mp/sbcl.lisp @@ -24,8 +24,8 @@ (in-package :sclf) (defstruct (process - (:constructor %make-process) - (:predicate processp)) + (:constructor %make-process) + (:predicate processp)) name state whostate @@ -53,10 +53,10 @@ (defmacro get-mutex (mutex &optional (wait t)) `( #+#.(cl:if (cl:find-symbol "GRAB-MUTEX" "SB-THREAD") '(and) '(or)) - sb-thread:grab-mutex - #-#.(cl:if (cl:find-symbol "GRAB-MUTEX" "SB-THREAD") '(and) '(or)) - sb-thread:get-mutex - ,mutex :waitp ,wait)) + sb-thread:grab-mutex + #-#.(cl:if (cl:find-symbol "GRAB-MUTEX" "SB-THREAD") '(and) '(or)) + sb-thread:get-mutex + ,mutex :waitp ,wait)) (defvar *permanent-queue* (sb-thread:make-mutex :name "Lock for disabled threads")) @@ -65,7 +65,7 @@ (defun make-process (function &key name) (let ((p (%make-process :name name - :function function))) + :function function))) (sb-thread:with-mutex (*all-processes-lock*) (pushnew p *all-processes*)) (restart-process p))) @@ -73,7 +73,7 @@ (defun process-kill-thread (process) (let ((thread (process-thread process))) (when (and thread - (sb-thread:thread-alive-p thread)) + (sb-thread:thread-alive-p thread)) (assert (not (eq thread sb-thread:*current-thread*))) (sb-thread:terminate-thread thread) ;; Wait until all the clean-up forms are done. @@ -85,13 +85,13 @@ (defun restart-process (p) (labels ((boing () - (let ((*current-process* p) - (function (process-function p))) - (when function - (funcall function))))) + (let ((*current-process* p) + (function (process-function p))) + (when function + (funcall function))))) (process-kill-thread p) (when (setf (process-thread p) - (sb-thread:make-thread #'boing :name (process-name p))) + (sb-thread:make-thread #'boing :name (process-name p))) p))) (defun destroy-process (process) @@ -115,26 +115,26 @@ (defun process-wait (reason predicate) (let ((old-state (process-whostate *current-process*))) (unwind-protect - (progn - (setf old-state (process-whostate *current-process*) - (process-whostate *current-process*) reason) - (until (funcall predicate) - (process-yield))) + (progn + (setf old-state (process-whostate *current-process*) + (process-whostate *current-process*) reason) + (until (funcall predicate) + (process-yield))) (setf (process-whostate *current-process*) old-state)))) (defun process-wait-with-timeout (reason timeout predicate) (let ((old-state (process-whostate *current-process*)) - (end-time (+ (get-universal-time) timeout))) + (end-time (+ (get-universal-time) timeout))) (unwind-protect - (progn - (setf old-state (process-whostate *current-process*) - (process-whostate *current-process*) reason) - (loop - for result = (funcall predicate) - until (or result - (> (get-universal-time) end-time)) - do (process-yield) - finally (return result))) + (progn + (setf old-state (process-whostate *current-process*) + (process-whostate *current-process*) reason) + (loop + for result = (funcall predicate) + until (or result + (> (get-universal-time) end-time)) + do (process-yield) + finally (return result))) (setf (process-whostate *current-process*) old-state)))) (defun process-interrupt (process function) @@ -175,13 +175,13 @@ (let ((old-state (gensym "OLD-STATE"))) `(sb-thread:with-mutex (,place :wait-p ,wait) (let (,old-state) - (unwind-protect - (progn - (when ,state - (setf ,old-state (process-state *current-process*)) - (setf (process-state *current-process*) ,state)) - ,@body) - (setf (process-state *current-process*) ,old-state)))))) + (unwind-protect + (progn + (when ,state + (setf ,old-state (process-state *current-process*)) + (setf (process-state *current-process*) ,state)) + ,@body) + (setf (process-state *current-process*) ,old-state)))))) (defun make-recursive-lock (&optional name) @@ -193,24 +193,24 @@ `(sb-thread:with-recursive-lock (,place) (let (,old-state) (unwind-protect - (progn - (when ,state - (setf ,old-state (process-state *current-process*)) - (setf (process-state *current-process*) ,state)) - ,@body) - (setf (process-state *current-process*) ,old-state)))))) + (progn + (when ,state + (setf ,old-state (process-state *current-process*)) + (setf (process-state *current-process*) ,state)) + ,@body) + (setf (process-state *current-process*) ,old-state)))))) (defun make-condition-variable () (sb-thread:make-waitqueue)) (defun condition-wait (cv lock &optional timeout) (if timeout (handler-case - (sb-ext:with-timeout timeout - (sb-thread:condition-wait cv lock) - t) - (sb-ext:timeout (c) - (declare (ignore c)) - nil)) + (sb-ext:with-timeout timeout + (sb-thread:condition-wait cv lock) + t) + (sb-ext:timeout (c) + (declare (ignore c)) + nil)) (progn (sb-thread:condition-wait cv lock) t))) (defun condition-notify (cv) |