chickadee » srfi-18 » mutex-lock!

mutex-lock! mutex #!optional timeout threadprocedure

If the mutex is currently locked, the current thread waits until the mutex is unlocked, or until the timeout is reached if timeout is supplied. If the timeout is reached, mutex-lock! returns #f. Otherwise, the state of the mutex is changed as follows:

  • if thread is #f the mutex becomes locked/not-owned,
  • otherwise, let T be thread (or the current thread if thread is not supplied),
    • if T is terminated the mutex becomes unlocked/abandoned,
    • otherwise mutex becomes locked/owned with T as the owner.

After changing the state of the mutex, an "abandoned mutex exception" is raised if the mutex was unlocked/abandoned before the state change, otherwise mutex-lock! returns #t. It is not an error if the mutex is owned by the current thread (but the current thread will have to wait).

    ; an implementation of a mailbox object of depth one; this
    ; implementation does not behave well in the presence of forced
    ; thread terminations using thread-terminate! (deadlock can occur
    ; if a thread is terminated in the middle of a put! or get! operation)
 
    (define (make-empty-mailbox)
      (let ((put-mutex (make-mutex)) ; allow put! operation
            (get-mutex (make-mutex))
            (cell #f))
 
        (define (put! obj)
          (mutex-lock! put-mutex #f #f) ; prevent put! operation
          (set! cell obj)
          (mutex-unlock! get-mutex)) ; allow get! operation
 
        (define (get!)
          (mutex-lock! get-mutex #f #f) ; wait until object in mailbox
          (let ((result cell))
            (set! cell #f) ; prevent space leaks
            (mutex-unlock! put-mutex) ; allow put! operation
            result))
 
        (mutex-lock! get-mutex #f #f) ; prevent get! operation
 
        (lambda (msg)
          (case msg
            ((put!) put!)
            ((get!) get!)
            (else (error "unknown message"))))))
 
    (define (mailbox-put! m obj) ((m 'put!) obj))
    (define (mailbox-get! m) ((m 'get!)))
 
    ; an alternate implementation of thread-sleep!
 
    (define (sleep! timeout)
      (let ((m (make-mutex)))
        (mutex-lock! m #f #f)
        (mutex-lock! m timeout #f)))
 
    ; a procedure that waits for one of two mutexes to unlock
 
    (define (lock-one-of! mutex1 mutex2)
      ; this procedure assumes that neither mutex1 or mutex2
      ; are owned by the current thread
      (let ((ct (current-thread))
            (done-mutex (make-mutex)))
        (mutex-lock! done-mutex #f #f)
        (let ((t1 (thread-start!
                   (make-thread
                    (lambda ()
                      (mutex-lock! mutex1 #f ct)
                      (mutex-unlock! done-mutex)))))
              (t2 (thread-start!
                   (make-thread
                    (lambda ()
                      (mutex-lock! mutex2 #f ct)
                      (mutex-unlock! done-mutex))))))
          (mutex-lock! done-mutex #f #f)
          (thread-terminate! t1)
          (thread-terminate! t2)
          (if (eq? (mutex-state mutex1) ct)
              (begin
                (if (eq? (mutex-state mutex2) ct)
                    (mutex-unlock! mutex2)) ; don't lock both
                mutex1)
              mutex2))))