[Chicken-users] Receiving from multiple mailboxes

[megane]

Hi.

I've been toying with the mailbox egg. AFAIK there's currently no way to
wait messages from multiple mailboxes at the same time.

Is there a reason this is not supported?

I made a quick hack that seems to not break immediately. There's a new
procedure `mailbox-receive-many!' that takes a list of mailboxes and
returns a cons of the mailbox and the received message.

It's a bit slow, because every time the waiting thread resumes it has to
check all boxes it was waiting. And also it removes and adds the thread
to the mailbox queues every time the resume was a false alarm,
i.e. there were no messages in the mailboxes. This could be made more
efficient by devising a way to tell the thread which mailbox(es) have
messages in `ready-mailbox-thread!'.

I'm not suggesting this patch should be added. I'm asking whether this
functionality could be added if someone had the time.

Kind regards.

42d41
<     mailbox-receive-many!
354,421d352
< 
< (define (wait-mailbox-thread-many! loc mbs timout timout-value)
<   ;;Push current thread on mailbox waiting queue
<   (for-each
<    (lambda (mb)
<      (%mailbox-waiters-add! mb ($current-thread)))
<    mbs)
<   ;;Waiting action
<   (cond
<    (timout          ;Timeout wanted so sleep until something happens
<     (cond
<      ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
<       ;;Timedout, so no message
<       ;;Remove from wait queue
<       (for-each
<        (lambda (mb)
<        (%mailbox-waiters-delete! mb ($current-thread)))
<        mbs)
<           
<       ;;Indicate no available message
<       (if (not ($eq? timout-value NO-TOVAL-TAG)) timout-value
<         (begin
<           (thread-signal!
<            ($current-thread)
<            (make-mailbox-timeout-condition loc timout timout-value))
<           SEQ-FAIL-TAG ) ) )
<      (else
<       ;;Unblocked early
<       (for-each
<        (lambda (mb)
<        (%mailbox-waiters-delete! mb ($current-thread)))
<        mbs)
<       UNBLOCKED-TAG ) ) )
<    (else            ;No timeout so suspend until something delivered
<     (thread-suspend! ($current-thread))
<     ;;We're resumed
<     (for-each
<        (lambda (mb)
<        (%mailbox-waiters-delete! mb ($current-thread)))
<        mbs)
<     UNBLOCKED-TAG ) ) )
< 
< (define-syntax on-mailbox-available-many
<   (syntax-rules ()
<     ((_ ?loc ?mbs ?timout ?timout-value ?on-fn)
<      (let waiting ()
<        (let lp [(mbs* ?mbs)]
<        (cond
<         ((null? mbs*)
<          (let ((res (wait-mailbox-thread-many! ?loc ?mbs ?timout 
?timout-value)))
<            ;;When a thread ready then check mailbox again, could be empty.
<            (if ($eq? UNBLOCKED-TAG res) (waiting)
<                ;;else some sort of problem
<                res)))
<         ((not (%mailbox-queue-empty? (car mbs*)))
<          (?on-fn (car mbs*)))
<         (else
<          (lp (cdr mbs*)))))))))
< 
< (define (mailbox-receive-many! mbs #!optional timout (timout-value 
NO-TOVAL-TAG))
<   (for-each
<    (lambda (mb)
<     (%check-mailbox 'mailbox-receive-many! mb))
<    mbs)
<   (when timout (%check-timeout 'mailbox-receive-many! timout))
<   (on-mailbox-available-many 'mailbox-receive-many! mbs timout timout-value
<                            (lambda (mb)
<                             (cons mb (%mailbox-queue-remove! mb))) ) )