[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-users] Receiving from multiple mailboxes

From: megane
Subject: [Chicken-users] Receiving from multiple mailboxes
Date: Thu, 18 Oct 2012 13:11:52 +0300
User-agent: mu4e 0.9.9-dev4; emacs 24.1.1


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.
<     mailbox-receive-many!
< (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 
<            ;;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 
<   (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))) ) )

reply via email to

[Prev in Thread] Current Thread [Next in Thread]