Ludovic Courtès <l...@gnu.org> writes:
> Clément Lassieur <clem...@lassieur.org> skribis:
>
>> Gábor Boskovits <boskov...@gmail.com> writes:
>>
>>> Hello Clément,
>>>
>>> Do you have any idea what has gone wrong here?
>>
>> Yes, I think Fibers channels aren't thread-safe.
>
> It’s always a possibility but that seems unlikely.
Indeed, I spoke too soon :-)
The bug is here:
--8<---------------cut here---------------start------------->8---
(define (make-critical-section . args)
"Return a channel used to implement a critical section. That channel can
then be passed to 'join-critical-section', which will ensure sequential
ordering. ARGS are the arguments of the critical section.
Critical sections are implemented by passing the procedure to execute to a
dedicated fiber."
(let ((channel (make-channel)))
(spawn-fiber
(lambda ()
(let loop ()
(match (get-message channel)
((? procedure? proc)
(put-message channel (apply proc args))))
(loop))))
channel))
(define (call-with-critical-section channel proc)
"Call PROC in the critical section corresponding to CHANNEL. Return the
result of PROC."
(put-message channel proc)
(get-message channel))
--8<---------------cut here---------------end--------------->8---
Say I have 2 concurrent fibers (F1 and F2) wanting to serialize
messages through the critical section.
- F1-PUT-MESSAGE puts F1-MESSAGE to CRITICAL-SECTION
- CRITICAL-SECTION gets F1-MESSAGE, which unblocks F1-PUT-MESSAGE
- F1-GET-MESSAGE is called and blocks
- F2-PUT-MESSAGE puts F2-MESSAGE, and the only receiver available
is... F1-GET-MESSAGE, because CRITICAL-SECTION is busy
- F2-GET-MESSAGE is called and block
- CRITICAL-SECTION is done handling F1-MESSAGE, and put
F1-MESSAGE-MODIFIED to... F2-GET-MESSAGE.
F2-MESSAGE is a procedure, whereas F1-MESSAGE-MODIFIED is a list, which
causes the (map f F2-MESSAGE) error.
A solution could be to use two channels, in and out:
--8<---------------cut here---------------start------------->8---
(define (make-critical-section . args)
"Return a pair of channels used to implement a critical section. It can
then be passed to 'with-critical-section', which will ensure sequential
ordering. ARGS are the arguments of the critical section.
Critical sections are implemented by passing the procedure to execute to a
dedicated fiber."
(let ((channel-in (make-channel))
(channel-out (make-channel)))
(spawn-fiber
(lambda ()
(let loop ()
(match (get-message channel-in)
((? procedure? proc)
(put-message channel-out (apply proc args))))
(loop))))
(cons channel-in channel-out)))
(define (call-with-critical-section channel proc)
"Call PROC in the critical section corresponding to CHANNEL. Return the
result of PROC."
(match channel
((channel-out . channel-in)
(begin
(put-message channel-out proc)
(get-message channel-in)))))
--8<---------------cut here---------------end--------------->8---
WDYT?
Clément
