1 ;;; tinymsg, a GNU Guile messages module for communicating threads
2 ;;; Copyright (C) 2015 by Javier Sancho Fernandez <jsf at jsancho dot org>
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;;; GNU General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
18 (define-module (tinymsg)
19 #:use-module (ice-9 q)
20 #:use-module (ice-9 threads)
21 #:use-module (ice-9 vlist)
22 #:use-module (srfi srfi-9)
23 #:export (send-message
29 (define-record-type <msgbox>
30 (make-msgbox mutex condvar queue)
33 (condvar msgbox-condvar)
36 (define msgboxes vlist-null)
37 (define msgboxes-mutex (make-recursive-mutex))
39 (define (new-msgbox name)
40 "Create a new msgbox for receiving messages"
41 (with-mutex msgboxes-mutex
42 (let ((msgbox (make-msgbox (make-mutex) (make-condition-variable) (make-q))))
43 (set! msgboxes (vhash-cons name msgbox msgboxes))
46 (define (get-msgbox name)
47 "Get a msgbox or create a new one if doesn't exists"
48 (with-mutex msgboxes-mutex
49 (let ((msgbox (vhash-assoc name msgboxes)))
53 (new-msgbox name))))))
55 (define (send-message to message)
56 "Get msgbox from destination and queue the message"
57 (let ((msgbox (get-msgbox to)))
58 (with-mutex (msgbox-mutex msgbox)
59 (enq! (msgbox-queue msgbox) message)
60 (signal-condition-variable (msgbox-condvar msgbox))))
63 (define (receive-message name)
64 "Get msgbox and retrieve a message without waiting"
65 (let ((msgbox (get-msgbox name)))
66 (with-mutex (msgbox-mutex msgbox)
67 (let ((queue (msgbox-queue msgbox)))
68 (if (not (q-empty? queue))
71 (define (wait-message name)
72 "Get msgbox and wait for a message"
73 (let ((msgbox (get-msgbox name)))
74 (let ((mutex (msgbox-mutex msgbox))
75 (condvar (msgbox-condvar msgbox))
76 (queue (msgbox-queue msgbox)))
78 (if (or (not (q-empty? queue))
79 (wait-condition-variable condvar mutex))
82 (define (flush-messages name)
83 "Print all messages from the msgbox"
84 (let ((msgbox (get-msgbox name)))
85 (with-mutex (msgbox-mutex msgbox)
86 (let flush ((queue (msgbox-queue msgbox)))
87 (cond ((not (q-empty? queue))
88 (format #t "~a got ~a~%" name (deq! queue))