Grid Computing with clisp: http://grid.bmk.com.au/
Also, here's some SBCL code that implements a the basics required for properly handling user-level asynchronous signals. Notably lacking is integration into the event loop: calling (process-check-signals) before to receive things, and after being woken up from sleep if nothing was available at first.
(defun make-lock (name) (sb-thread:make-mutex :name name))
(defmacro with-lock-held ((lock &optional whostate) &body body) (declare (ignore whostate)) `(sb-thread:with-mutex (,lock) ,@body))
(defclass process () ((name :initform "" :initarg :name :type string :accessor process-name) (thread :initform nil :initarg :thread :accessor process-thread) (function :initform nil :initarg :function :accessor process-function) (lock :initform (make-lock "thread lock") :accessor process-lock) (signal :initform nil :accessor process-signal) (state :initform nil :initarg :state :accessor process-state)))
(defun make-process (name &rest initargs) (apply #'make-instance 'process :name name initargs))
(defvar *current-process* (make-process "Initial process" :thread sb-thread:*current-thread*)) (defun current-process () *current-process*)
(defun start-process (function &optional (process-name "Generic Process")) (let ((proc (make-process process-name :function function))) (setf (process-thread proc) (sb-thread:make-thread (process-starter proc))) proc))
(defun process-starter (process) #'(lambda () (let ((*current-process* process)) (loop for termination-reason = (catch 'process-termination (process-check-signals) (funcall (process-function process)) :end) do (ecase termination-reason (:reset) ;;; run the function once again ((:end :kill) (return))))))) ;;; be done
(defun process-check-signals () (let ((sig nil)) (with-lock-held ((process-lock *current-process*)) (rotatef sig (process-signal *current-process*))) (when sig (throw 'process-termination sig))))
(defun process-send-signal (process signal) (ecase signal ((:reset :kill) (with-lock-held ((process-lock process)) (let ((sig (process-signal process))) (setf (process-signal process) (max-process-signal sig signal))))) (:kill-on-the-spot ;; --- never do that you're sure the process is in a safe state (sb-thread:terminate-thread (process-thread process)))) (values))
(defconstant-equal +process-signals+ '(:reset :kill :kill-on-the-spot)) (defun max-process-signal (sig1 sig2) (if (member sig1 (member sig2 +process-signals+)) sig1 sig2))
;; A process will only handle an asynchronous signal at a safe point, ;; as declared by said process calling PROCESS-CHECK-SIGNALS. ;; Any attempt at killing a process when it isn't explicitly checking signals ;; is *UNSAFE*, unless it is somehow _guaranteed_ that the process ;; isn't holding any lock, isn't modifying some shared data-structure, ;; and including the heap meta-data (i.e. you lose if you kill a thread in the ;; middle of consing or otherwise while it is disabling garbage-collection). ;; This is valid for *any* Lisp implementation, including CMUCL and whatelse ;; (except that CMUCL's green thread model might avoid the CONSing/GC ;; part of the problem). Use Erlang for a language without this problem at all ;; (because its processes can't do any side-effect or sharing except ;; through its system-managed atomic message passing primitives). ;; See the mess that was thread.interrupt in Java and why it was discontinued. ;; We sorely miss some kind of application-extensible PCLSRing. -- fare ;; ;; GOLDEN RULE: thou shall not stop or interrupt a thread in any language ;; that uses any kind of shared memory. EVER. Because you may catch the thread ;; while it has its pants down, and then you're in deep trouble. ;; ;; BOTTOM LINE: if any process it meant to receive any of asynchronous signal ;; through PROCESS-PRESET, PROCESS-RESET or PROCESS-KILL, then it *must* ;; poll for signals with PROCESS-CHECK-SIGNALS at regular safe points. ;; (e.g. in its event loop). ;; ;; Note: if that was ever needed, we could possibly have a "safe to kill" flag ;; in the process structure, that the thread could raise when it's in a safe ;; mode with no locking, no data sharing, no consing. Then, signal senders ;; could check this flag, and if present, scrap the whole thread, and start ;; a new one if a function is to be (re)started.
(defun process-preset (process function &rest args) (setf (process-function process) #'(lambda () (apply function args))) (process-reset process))
(defun process-reset (process) (assert (process-function process)) (process-send-signal process :reset))
;; Words of wisdom from the SBCL source code: ;; A moderate degree of care is expected for use of interrupt-thread, ;; due to its nature: if you interrupt a thread that was holding ;; important locks then do something that turns out to need those ;; locks, you probably won't like the effect. (defun process-interrupt (process function) (when (process-thread process) (sb-thread:interrupt-thread (process-thread process) function)))
(defun process-kill (process) (process-send-signal process :kill))
[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ] Government's view of the economy could be summed up in a few short phrases : If it moves, tax it. If it keeps moving, regulate it. And if it stops moving, subsidize it. -- Ronald Reagan (1986)