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)
