cisco / ChezScheme

Chez Scheme
Apache License 2.0
6.95k stars 982 forks source link

Would there be any references for chez scheme multi-thread programming (except csug)? #675

Open ufo5260987423 opened 1 year ago

ufo5260987423 commented 1 year ago

I've translated a C language reader-writer lock into Chez Scheme. But it seems something wrong. Would there be something references? Or, how would lisp programmer process synchronization in general?

Also I've found this , but it did not help.

My reader-writer-lock implementation is like:

(import (chezscheme))

(define-record-type reader-writer-lock
    (fields 
    ;0 not locked
    ;-1 locked by writer
    ;>0 locked by reader 
        (mutable ref-count)
        (mutable waiting-reader-count)
        (mutable waiting-writer-count)
        (immutable mutex)
        (immutable read-condition)
        (immutable write-condition))
    (protocol
        (lambda (new)
            (lambda ()
            (new 0 0 0 (make-mutex) (make-condition) (make-condition))))))

(define-syntax with-lock-read
    (syntax-rules ()
        [(_ lock e0 e1 ...) 
            (let ([l lock])
                (dynamic-wind
                    (lambda() (reader-lock l))
                    (lambda() e0 e1 ...)
                    (lambda() (release-lock l))))]))

(define-syntax with-lock-write
    (syntax-rules ()
        [(_ lock e0 e1 ...) 
            (let ([l lock])
                (dynamic-wind
                    (lambda() (writer-lock l))
                    (lambda() e0 e1 ...)
                    (lambda() (release-lock l))))]))
;; something about reader-writer lock

However, it raised "variable ~:s is not bound"and (#{with-read-lock *top*:with-read-lock} with following code:

(let* ([v 0]
        [result '()]
        [lock (make-reader-writer-lock)]
        [write 
            (lambda ()
                (with-write-lock lock
                    (sleep (make-time 'time-duration 0 20))
                    (set! v (+ v 1))
                    (set! result (append result `("write" ,v)))
                    ))]
        [read 
            (lambda ()
                (with-read-lock lock 
                    (set! result (append result `("read" ,v)))))]
        [thread-pool (init-thread-pool 15 #t)])
        (let loop ([i 0])
            (if (< i 5)
                (begin
                    (thread-pool-add-job thread-pool write)
                    (loop (+ 1 i)))))
        (let loop ([i 0])
            (if (< i 10)
                (begin
                    (thread-pool-add-job thread-pool read)
                    (loop (+ 1 i)))))
        (sleep (make-time 'time-duration 0 30))
        ; (test-equal #t #t)
        (pretty-print result)
        (sleep (make-time 'time-duration 0 5))
    )
gwatt commented 1 year ago

For starters, you've defined your macros as with-lock-write and with-lock-read but attempted with-write-lock and with-read-lock. You also appear to be missing definitions for reader-lock, writer-lock, and release-lock

There is also an example of a parallel work queue in the docs: http://cisco.github.io/ChezScheme/csug9.5/threads.html#./threads:h9

ufo5260987423 commented 1 year ago

Thank you for your reply. But csug can't tell me more thing. My whole lock code is:

(library (scheme-langserver util synchronize)
    (export 
        make-reader-writer-lock
        with-lock-write
        with-lock-read

        reader-lock
        writer-lock
        release-lock)
    (import (chezscheme))

; https://www.cnblogs.com/fortunely/p/15778050.html#%E4%BD%BF%E7%94%A81%E4%B8%AAmutex--2%E4%B8%AA%E6%9D%A1%E4%BB%B6%E5%8F%98%E9%87%8F
(define-record-type reader-writer-lock
    (fields 
    ;0 not locked
    ;-1 locked by writer
    ;>0 locked by reader 
        (mutable ref-count)
        (mutable waiting-reader-count)
        (mutable waiting-writer-count)
        (immutable mutex)
        (immutable read-condition)
        (immutable write-condition))
    (protocol
        (lambda (new)
            (lambda ()
            (new 0 0 0 (make-mutex) (make-condition) (make-condition))))))

(define-syntax with-lock-read
    (syntax-rules ()
        [(_ lock e0 e1 ...) 
            (let ([l lock])
                (dynamic-wind
                    (lambda() (reader-lock l))
                    (lambda() e0 e1 ...)
                    (lambda() (release-lock l))))]))

(define-syntax with-lock-write
    (syntax-rules ()
        [(_ lock e0 e1 ...) 
            (let ([l lock])
                (dynamic-wind
                    (lambda() (writer-lock l))
                    (lambda() e0 e1 ...)
                    (lambda() (release-lock l))))]))

(define (reader-lock lock) 
    (with-mutex (reader-writer-lock-mutex lock)
        (let loop ()
            (if (or (< (reader-writer-lock-ref-count lock) 0)
                    (> (reader-writer-lock-waiting-writer-count lock) 0))
                (begin
                    (reader-writer-lock-waiting-reader-count-set! 
                        lock 
                        (+ (reader-writer-lock-waiting-reader-count lock) 1))

                    (condition-wait (reader-writer-lock-read-condition lock) (reader-writer-lock-mutex lock))

                    (reader-writer-lock-waiting-reader-count-set! 
                        lock 
                        (- (reader-writer-lock-waiting-reader-count lock) 1))
                    (loop))))
        (reader-writer-lock-ref-count-set! 
            lock 
            (+ (reader-writer-lock-ref-count lock) 1))))

(define (writer-lock lock) 
    (with-mutex (reader-writer-lock-mutex lock)
        (let loop ()
            (if (not (zero? (reader-writer-lock-ref-count lock)))
                (begin
                    (reader-writer-lock-waiting-writer-count-set! 
                        lock 
                        (+ (reader-writer-lock-waiting-writer-count lock) 1))

                    (condition-wait (reader-writer-lock-write-condition lock) (reader-writer-lock-mutex lock))

                    (reader-writer-lock-waiting-writer-count-set! 
                        lock 
                        (- (reader-writer-lock-waiting-writer-count lock) 1))
                    (loop))))
        (reader-writer-lock-ref-count-set! lock -1)))

(define (release-lock lock) 
    (with-mutex (reader-writer-lock-mutex lock)
        (if (> (reader-writer-lock-ref-count lock) 0)
            (reader-writer-lock-ref-count-set! 
                lock 
                (- (reader-writer-lock-ref-count lock) 1))
            (if (= (reader-writer-lock-ref-count lock) -1)
                (reader-writer-lock-ref-count-set! lock 0)
                (raise 'unknown-error)))

        (if (> (reader-writer-lock-waiting-writer-count lock) 0) 
            (if (zero? (reader-writer-lock-ref-count lock))
                (condition-signal (reader-writer-lock-write-condition lock)))
            (if (> (reader-writer-lock-waiting-reader-count lock) 0)
                (condition-broadcast (reader-writer-lock-read-condition lock))))))
)