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))) ) )
_______________________________________________ Chicken-users mailing list Chicken-users@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-users
