Let's start Scheme

2014-06-15

How to emulate pthread_cond_wait with SRFI-18

I was implementing multi thread queue like Gauche has but in pure Scheme with SRFI-18. Then I've got confused how to wait condition variable. If it's POSIX then you can use pthread_cond_wait. However it's SRFI-18 and it doesn't provide a procedure to wait condition variable directly. Well, in the end there are some example code which explains how to do it but at that moment I couldn't figure it out. So there may be some people who also have the same issue as me. (It's basically because of my lack of knowledge of multi threading and, well, if there aren't at least this could be my memo to remember...)

The answer was a combination of mutex-unlock! and mutex-lock!. I was always thinking that pthread_cond_wait or similar procedure is the only way to wait for a condition variable. I skipped reading this section (and caused my confusion...)
NOTE: mutex-unlock! is related to the "wait" operation on condition variables available in other thread systems. The main difference is that "wait" automatically locks mutex just after the thread is unblocked. This operation is not performed by mutex-unlock! and so must be done by an explicit call to mutex-lock!. This has the advantages that a different timeout and exception handler can be specified on the mutex-lock! and mutex-unlock! and the location of all the mutex operations is clearly apparent. A typical use with a condition variable is:
(I don't complain this is very confusing but don't you think?) So what I needed to do is instead of searching something that specifically says condition-wait! or something, I needed to use mutex-unlock! and mutex-lock!. Following piece of code is more concrete example;
(import (rnrs) (srfi :18))

(define-record-type (<foo> make-foo foo?)
  (fields (immutable mutex foo-mutex)
          (immutable cv    foo-cv)
          (mutable   count foo-count foo-count-set!))
  (protocol (lambda (p)
              (lambda ()
                (p (make-mutex)
                   (make-condition-variable)
                   0)))))

;; Utilities for above foo record
(define-syntax lock-foo!
  (syntax-rules ()
    ((_ foo) (mutex-lock! (foo-mutex foo)))))
(define-syntax unlock-foo!
  (syntax-rules ()
    ((_ foo) (mutex-unlock! (foo-mutex foo)))))
(define (with-locking-foo foo thunk)
  (dynamic-wind
      (lambda () (lock-foo! foo))
      thunk 
      (lambda () (unlock-foo! foo))))

(define-syntax wait-cv
  (syntax-rules ()
    ((_ foo)
     (let ((r (mutex-unlock! (foo-mutex foo) (foo-cv foo))))
       (display "unlocked! with cv") (newline)
       ;; mutex is not locked so lock it if you need it.
       (mutex-lock! (foo-mutex foo))
       r))))

(define-syntax notify-foo
  (syntax-rules ()
    ((_ foo)
     (condition-variable-broadcast! (foo-cv foo)))))

(let ()
  (define foo (make-foo))

  (define (producer)
    ;; increment count
    (with-locking-foo foo
     (lambda ()
       (display "Increment count!") (newline)
       (foo-count-set! foo 1)
       (notify-foo foo))))

  (define (consumer)
    ;; wait until the count is one
    (with-locking-foo foo 
     (lambda ()
       (let loop ()
         (cond ((zero? (foo-count foo))
                (display "It's zero need to wait!") (newline)
                (if (wait-cv foo)
                    (loop)
                    (error #f "something went wrong")))
               (else (foo-count foo)))))))

  (let ((ct (thread-start! (make-thread consumer)))
        (pt (make-thread producer)))
    ;; consumer is waiting but make sure
    (thread-sleep! 10)
    ;; let producer increment
    (thread-start! pt)
    (thread-join! pt)
    (display (thread-join! ct)) (newline)))

#|
It's zero need to wait!
Increment count!
unlocked! with cv
1
|#
This just tries to emulate pthread_cond_wait using mutex-unlock! and mutex-lock!. The wait-cv is the emulation macro. notify-foo assumes that given foo
's mutex is locked. It took couple of hours to figure out this simple thing for me...
I haven't met any case that this mutex model is convenient but if this how it is I need to get used to it. (though, my case was just the name confusion...)

No comments:

Post a Comment