<div>I have had a little bit more of time to think about this.</div><div><br></div><div>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.</div>

<div><br></div><div>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.</div>

<div><br></div><div>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.</div>

<div><br></div><div>Perhaps one solution would be the following one:</div><div>* Ensure that libatomics is always compiled in.</div><div>* Ensure that all locks are non-recursive, error-checking mutexes.</div><div>* Make get/giveup-lock simpler, but deprecated.</div>

<div>* Code a with-lock function that follows more or less as the algorithm below</div><div><br></div><div>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.</div>

<div><br></div><div><div>(defun do-with-lock (lock code)</div><div>  (if (eq (lock-owner lock) this-thread)</div><div>      (error "Trying to lock non-recursive lock")</div><div>      (unwind-protect</div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span>   (progn</div>
<div><span class="Apple-tab-span" style="white-space:pre">      </span>     (cas (lock-owner lock) nil this-thread)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>     (when (eq (pthread_mutex_lock lock) :error)</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>       (signal error))</div><div><span class="Apple-tab-span" style="white-space:pre">       </span>     (funcall code))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>(without-interrupts</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>    (setf (lock-owner lock) nil)</div><div><span class="Apple-tab-span" style="white-space:pre">     </span>    (case (pthread_mutex_unlock lock)</div><div><span class="Apple-tab-span" style="white-space:pre">        </span>      ((nil :not-owned) nil)</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>      (t (signal error)))))))</div><div><br></div><div>(defun do-with-recursive-lock (lock code)</div><div>  (if (eq (lock-owner lock) this-thread)</div><div>

      (funcall code)</div><div>      (unwind-protect</div><div><span class="Apple-tab-span" style="white-space:pre">  </span>   (progn</div><div><span class="Apple-tab-span" style="white-space:pre">    </span>     (cas (lock-owner lock) nil this-thread)</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>     (when (eq (pthread_mutex_lock lock) :error)</div><div><span class="Apple-tab-span" style="white-space:pre">     </span>       (signal error))</div><div><span class="Apple-tab-span" style="white-space:pre">       </span>     (funcall code))</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>(without-interrupts</div><div><span class="Apple-tab-span" style="white-space:pre">  </span>    (setf (lock-owner lock) nil)</div><div><span class="Apple-tab-span" style="white-space:pre">     </span>    (case (pthread_mutex_unlock lock)</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>      ((nil :not-owned) nil)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>      (t (signal error)))))))</div><div><br></div></div>

-- <br>Instituto de Física Fundamental, CSIC<br>c/ Serrano, 113b, Madrid 28006 (Spain) <br><a href="http://juanjose.garciaripoll.googlepages.com" target="_blank">http://juanjose.garciaripoll.googlepages.com</a><br>