From fahree at gmail.com  Tue Nov 22 09:28:06 2005
From: fahree at gmail.com (=?ISO-8859-1?Q?Far=E9?=)
Date: Tue, 22 Nov 2005 04:28:06 -0500
Subject: [erlisp-devel] Various
Message-ID: <653bea160511220128k6e79c1fci@mail.gmail.com>

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)
     , at 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)