X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=processes.lisp;h=7bdf018e6084324dec584bc1c104e613950928f4;hp=5b2c09d2eb78714062db17c00b6a7d0c27cf80ff;hb=HEAD;hpb=efcefe2aeaafd80a1caa5596f3099b617a583699 diff --git a/processes.lisp b/processes.lisp index 5b2c09d..7bdf018 100644 --- a/processes.lisp +++ b/processes.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -6,8 +6,6 @@ ;;;; Purpose: Multiprocessing functions ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: June 2003 -;;;; -;;;; $Id$ ;;;; ************************************************************************* (in-package #:kmrcl) @@ -17,39 +15,47 @@ #+allegro (mp:process-run-function name func) #+cmu (mp:make-process func :name name) #+lispworks (mp:process-run-function name nil func) - #+sb-thread (sb-thread:make-thread func) - #+openmcl (ccl:process-run-function name func) - #-(or allegro cmu lispworks sb-thread openmcl) (funcall func) + #+sb-thread (sb-thread:make-thread func :name name) + #+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) ) @@ -61,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)) -