X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=processes.lisp;h=7bdf018e6084324dec584bc1c104e613950928f4;hb=5c5adb1297021e440fa4943ef996c59ed9681178;hp=7017ce74e73d95f9cc8fe4fdd57e64d4919f5965;hpb=251043d4c96c996a35cd48c4452b03fbef2ea21a;p=kmrcl.git diff --git a/processes.lisp b/processes.lisp index 7017ce7..7bdf018 100644 --- a/processes.lisp +++ b/processes.lisp @@ -16,38 +16,46 @@ #+cmu (mp:make-process func :name name) #+lispworks (mp:process-run-function name nil func) #+sb-thread (sb-thread:make-thread func :name name) - #+openmcl (ccl:process-run-function name func) - #-(or allegro cmu lispworks sb-thread openmcl) (funcall func) + #+ccl (ccl:process-run-function name func) + #-(or allegro cmu lispworks sb-thread ccl) (funcall func) ) (defun destroy-process (process) #+cmu (mp:destroy-process process) #+allegro (mp:process-kill process) - #+sb-thread (sb-thread:destroy-thread process) + #+sb-thread (sb-thread:terminate-thread process) #+lispworks (mp:process-kill process) - #+openmcl (ccl:process-kill process) + #+ccl (ccl:process-kill process) ) (defun make-lock (name) + "Make a named process lock." + #+abcl (ext:make-thread-lock) #+allegro (mp:make-process-lock :name name) + #+ccl (ccl:make-lock name) #+cmu (mp:make-lock name) #+lispworks (mp:make-lock :name name) #+sb-thread (sb-thread:make-mutex :name name) - #+openmcl (ccl:make-lock name) - ) + #-(or lispworks abcl openmcl allegro sb-thread) + (declare (ignore name)) + #-(or abcl allegro ccl cmu lispworks sb-thread) + nil) + (defmacro with-lock-held ((lock) &body body) + #+abcl + `(ext:with-thread-lock (,lock) ,@body) #+allegro `(mp:with-process-lock (,lock) ,@body) + #+ccl + `(ccl:with-lock-grabbed (,lock) ,@body) #+cmu `(mp:with-lock-held (,lock) ,@body) #+lispworks `(mp:with-lock (,lock) ,@body) #+sb-thread `(sb-thread:with-recursive-lock (,lock) ,@body) - #+openmcl - `(ccl:with-lock-grabbed (,lock) ,@body) - #-(or allegro cmu lispworks sb-thread openmcl) + #-(or abcl allegro ccl cmu lispworks sb-thread) `(progn ,@body) ) @@ -59,16 +67,16 @@ `(mp:with-timeout (,seconds) ,@body) #+sb-thread `(sb-ext:with-timeout ,seconds ,@body) - #+openmcl + #+ccl `(ccl:process-wait-with-timeout "waiting" (* ,seconds ccl:*ticks-per-second*) #'(lambda () ,@body) nil) - #-(or allegro cmu sb-thread openmcl) + #-(or allegro cmu sb-thread ccl) `(progn ,@body) ) (defun process-sleep (n) + "Put thread to sleep for n seconds." #+allegro (mp:process-sleep n) #-allegro (sleep n)) -