[Chicken-users] SRFI-18 mutexes with timeouts behave differently from mutexes without timeouts

[Andy Bennett]

Hi,

I have a vector of resources. Each vector slot contains a record with
the resource fields and a mutex which is locked when that resource is in
use. My algorithm is to select a resource from the vector at random and
try to lock it. If that mutex is locked (i.e. the resource is in use)
then I want to try another one instead.

The initial version of the algorithm didn't have a timeout on the mutex:
if it was locked it just blocked and eventually locked the mutex when it
became unlocked.
The version with a timeout allowed another resource to be tried instead.
When I added a timeout weird things started happening so I made a
self-contained test case:

-----
(use srfi-18)

; a mutex.
; 2 threads trying to lock it with and without a timeout


(define m (make-mutex))
(define *timeout* #f)
(define *timeout* 1)

(define (proc)
  (let ((t (thread-name (current-thread))))
    (printf "~a: Trying\n" t)
    (if (mutex-lock! m *timeout*)
      (begin
        (printf "~a: Locked\n" t)
        (mutex-unlock! m)
        (proc))
      (begin
        (printf "~a: Couldn't lock\n" t)
        (proc)))))


(thread-start! (make-thread proc))
(thread-start! (make-thread proc))

(let loop () (thread-sleep! 10) (loop))
-----


I compiled and ran the code thusly:

csc t.scm && ./t


With *timeout* as #f, the two threads share the mutex:

-----
...
thread2: Trying
thread1: Locked
thread1: Trying
thread2: Locked
thread2: Trying
thread1: Locked
thread1: Trying
thread2: Locked
thread2: Trying
thread1: Locked
thread1: Trying
thread2: Locked
thread2: Trying
thread1: Locked
thread1: Trying
thread2: Locked
thread2: Trying
thread1: Locked
thread1: Trying
...
-----

With *timeout* as 1 they don't:

-----
...
thread1: Trying
thread1: Locked
thread1: Trying
thread1: Locked
thread1: Trying
thread1: Locked
thread2: Trying
thread1: Trying
thread2: Couldn't lock
thread2: Trying
thread1: Couldn't lock
thread1: Trying
thread2: Couldn't lock
thread2: Trying
thread1: Couldn't lock
thread1: Trying
...
-----

thread1 dominates for a while and then neither thread can lock the mutex.


If this was in C I'd be worrying about the volatility of my variables.


I was trying to keep things minimal rather than having a mutex and an
in-use flag for each resource. With the selection of different resources
if the attempted one is locked, it's difficult to know where to put the
condvar without putting the mutex around the vector as a whole.
Furthermore, in my original program, as soon as there's contention on
the mutex with a timeout I start to get #<condition:
(abandoned-mutex-exception)> and I'm not sure why: I'm not getting any
stack traces that would suggest threads are crashing and if my exception
handler were called then the mutex would be released. If the timeout is
#f then I do not get those exceptions.


Are mutexes supposed to be used in this way?
Would this be considered a bug in the mutex code or in mine?


Perhaps I should just use the Pool egg:
http://wiki.call-cc.org/eggref/4/pool



For reference, here's my original code:

-----
(define (select-instance instances)
  (let* ((n (random (vector-length instances)))
        (instance (vector-ref instances n)))
        (if (not (mutex-lock! (instance-in-use instance) ));0.001))
          (select-instance instances)
          (begin
            ; TODO: accounting
            (printf "Got instance ~a" n)
            instance))))

(define (release-instance instance)
  ;TODO : accounting
  (mutex-unlock! (instance-in-use instance)))

(define (fcgi-handler app)
  (let* ((app (alist-ref app fcgi-apps))
         (handler (car app))
         (instances (cdr app))
         (instance (select-instance instances))
         (s (socket af/unix sock/stream))
         )
    (handle-exceptions exn (begin
                             (release-instance instance)
                             (socket-close* s)
                             (abort exn))
                       (socket-connect s (unix-address (instance-socket 
instance)))
                       (let* ((req (current-request))
                              (len (header-value 'content-length 
(request-headers req) 0)))
                         (handler s req len)
                         (socket-close s)))
    (release-instance instance)))
-----





Regards,
@ndy

-- 
address@hidden
http://www.ashurst.eu.org/
0x7EBA75FF