receive-message.lisp

(defun receive-message (mailbox &key timeout)
  "Removes the oldest message from MAILBOX and returns it as the primary
value, and a secondary value of T. If MAILBOX is empty waits until a message
arrives.
If TIMEOUT is provided, and no message arrives within the specified interval,
returns primary and secondary value of NIL."
  (tagbody
     ;; Disable interrupts for keeping semaphore count in sync with
     ;; #msgs in the mailbox.
     (sb-sys:without-interrupts
       (sb-sys:allow-with-interrupts
         (or (wait-on-semaphore (mailbox-semaphore mailbox) :timeout timeout)
             (return-from receive-message (values nil nil))))
       (multiple-value-bind (value ok) (dequeue (mailbox-queue mailbox))
         (if ok
             (return-from receive-message (values value t))
             (go :error))))
   :error
     (sb-int:bug "Mailbox ~S empty after WAIT-ON-SEMAPHORE."
mailbox)))