Re: packaging Bootstrap for Cuirass' web interface

[Clément Lassieur]

Ludovic Courtès <address@hidden> writes:

> Clément Lassieur <address@hidden> skribis:
>
>> Gábor Boskovits <address@hidden> 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