;;; tinymsg, a GNU Guile messages module for communicating threads ;;; Copyright (C) 2015 by Javier Sancho Fernandez ;;; ;;; This program is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation, either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . (define-module (tinymsg) #:use-module (ice-9 q) #:use-module (ice-9 threads) #:use-module (ice-9 vlist) #:use-module (srfi srfi-9) #:export (send-message receive-message wait-message flush-messages)) (define-record-type (make-msgbox mutex condvar queue) msgbox? (mutex msgbox-mutex) (condvar msgbox-condvar) (queue msgbox-queue)) (define msgboxes vlist-null) (define msgboxes-mutex (make-recursive-mutex)) (define (new-msgbox name) "Create a new msgbox for receiving messages" (with-mutex msgboxes-mutex (let ((msgbox (make-msgbox (make-mutex) (make-condition-variable) (make-q)))) (set! msgboxes (vhash-cons name msgbox msgboxes)) msgbox))) (define (get-msgbox name) "Get a msgbox or create a new one if doesn't exists" (with-mutex msgboxes-mutex (let ((msgbox (vhash-assoc name msgboxes))) (cond (msgbox (cdr msgbox)) (else (new-msgbox name)))))) (define (send-message to message) "Get msgbox from destination and queue the message" (let ((msgbox (get-msgbox to))) (with-mutex (msgbox-mutex msgbox) (enq! (msgbox-queue msgbox) message) (signal-condition-variable (msgbox-condvar msgbox)))) message) (define (receive-message name) "Get msgbox and retrieve a message without waiting" (let ((msgbox (get-msgbox name))) (with-mutex (msgbox-mutex msgbox) (let ((queue (msgbox-queue msgbox))) (if (not (q-empty? queue)) (deq! queue)))))) (define (wait-message name) "Get msgbox and wait for a message" (let ((msgbox (get-msgbox name))) (let ((mutex (msgbox-mutex msgbox)) (condvar (msgbox-condvar msgbox)) (queue (msgbox-queue msgbox))) (with-mutex mutex (if (or (not (q-empty? queue)) (wait-condition-variable condvar mutex)) (deq! queue)))))) (define (flush-messages name) "Print all messages from the msgbox" (let ((msgbox (get-msgbox name))) (with-mutex (msgbox-mutex msgbox) (let flush ((queue (msgbox-queue msgbox))) (cond ((not (q-empty? queue)) (format #t "~a got ~a~%" name (deq! queue)) (flush queue)))))))