X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=processes.lisp;fp=processes.lisp;h=22cde94ecc11f329591500fff403e1d7e024dc5a;hp=7017ce74e73d95f9cc8fe4fdd57e64d4919f5965;hb=f24004941eccdabb71485163d4bdf63ceea8dbf9;hpb=12026eac09e773e83887a6073d5a034979ce7043 diff --git a/processes.lisp b/processes.lisp index 7017ce7..22cde94 100644 --- a/processes.lisp +++ b/processes.lisp @@ -16,8 +16,8 @@ #+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) @@ -25,29 +25,37 @@ #+allegro (mp:process-kill process) #+sb-thread (sb-thread:destroy-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,19 @@ `(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)) + +