[Ecls-list] MP stability improvement

[Juan Jose Garcia-Ripoll]

I have had a little bit more of time to think about this.

There is apparently no lisp implementation out there that relies on
operating system mutexes or locks. The degree of control that is needed to
properly handle interrupts forces SBCL and CCL to use their own spinlocks
or to rely on futexes.

Indeed the code I posted before still has problems with interrupts,
specially if there are other threads out there still using get-lock or
giveup-lock, or the locks are recursive: they could be left in an unknown
state.

Further inspection also revealed that SBCL does not provide recursive
locks, but rather routines to lock a lock recursively. Get/release routines
in that implementation are deprecated and the macros rely on other
functions that do several tricks to ensure consistency across interrupts.

Perhaps one solution would be the following one:
* Ensure that libatomics is always compiled in.
* Ensure that all locks are non-recursive, error-checking mutexes.
* Make get/giveup-lock simpler, but deprecated.
* Code a with-lock function that follows more or less as the algorithm below

I believe this would still work in the Windows implementation, where locks
are always recursive, but it strongly relies on having libatomics compiled
in for CAS support.

(defun do-with-lock (lock code)
  (if (eq (lock-owner lock) this-thread)
      (error "Trying to lock non-recursive lock")
      (unwind-protect
   (progn
     (cas (lock-owner lock) nil this-thread)
     (when (eq (pthread_mutex_lock lock) :error)
       (signal error))
     (funcall code))
(without-interrupts
    (setf (lock-owner lock) nil)
    (case (pthread_mutex_unlock lock)
      ((nil :not-owned) nil)
      (t (signal error)))))))

(defun do-with-recursive-lock (lock code)
  (if (eq (lock-owner lock) this-thread)
      (funcall code)
      (unwind-protect
   (progn
     (cas (lock-owner lock) nil this-thread)
     (when (eq (pthread_mutex_lock lock) :error)
       (signal error))
     (funcall code))
 (without-interrupts
    (setf (lock-owner lock) nil)
    (case (pthread_mutex_unlock lock)
      ((nil :not-owned) nil)
      (t (signal error)))))))

-- 
Instituto de Física Fundamental, CSIC
c/ Serrano, 113b, Madrid 28006 (Spain)
http://juanjose.garciaripoll.googlepages.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/ecl-devel/attachments/20120211/42af1e24/attachment.html>