+ (fifo-push local-queue (cons address message))
+ (mutex-unlock! message-available-mutex)
+ (mutex-unlock! local-queue-mutex))
+
+ (define (send-network-message address . message)
+ (let ((s (udp-open-socket))
+ (uri (address->uri address))
+ (packet (with-output-to-string
+ (lambda ()
+ (write (cons address message))))))
+ (udp-bind! s #f 0)
+ (udp-connect! s
+ (uri-host uri)
+ (uri-port uri))
+ (udp-send s packet)
+ (udp-close-socket s)))
+
+ (define (send-message-later address time . message)
+ (thread-start!
+ (lambda ()
+ (thread-sleep! time)
+ (apply send-message (cons address message)))))
+
+ (define (next-local-message)
+ (let ((res #f))
+ (mutex-lock! message-available-mutex #f #f)
+ (mutex-lock! local-queue-mutex)
+ (set! res (fifo-pop local-queue))
+ (if (not (fifo-empty? local-queue))
+ (mutex-unlock! message-available-mutex))
+ (mutex-unlock! local-queue-mutex)
+ res))
+
+ (define (start-scheduler)
+ (let loop ()
+ (apply deliver-message (next-local-message))
+ (loop)))
+
+
+ ;; Network
+
+ (define (start-network-listener)
+ (thread-start!
+ (lambda ()
+ (let ((s (udp-open-socket*)))
+ (udp-bind! s #f sam-port)
+ (let loop ()
+ (let-values (((n str) (udp-recv s 1024)))
+ (match (with-input-from-string str read)
+ ((address message ...)
+ (apply send-message (cons address message)))
+ (else
+ (print "Warning: received badly formatted message string '" str "'"))))
+ (loop))))))
+
+ ;; System interface
+
+ (define reader-queue-mutex (make-mutex "reader queue"))
+ (define reader-available-mutex (make-mutex "reader available"))
+ (mutex-lock! reader-available-mutex #f #f)
+ (define reader-queue (make-fifo))
+
+ (define (next-reader)
+ (let ((res #f))
+ (mutex-lock! reader-available-mutex #f #f)
+ (mutex-lock! reader-queue-mutex)
+ (set! res (fifo-pop reader-queue))
+ (if (not (fifo-empty? reader-queue))
+ (mutex-unlock! reader-available-mutex))
+ (mutex-unlock! reader-queue-mutex)
+ res))
+
+ (define (start-console)
+ (thread-start!
+ (lambda ()
+ (let loop ()
+ (let ((reader (next-reader)))
+ (##sys#thread-block-for-i/o! (current-thread) 0 #t)
+ (thread-yield!)
+ (send-message reader (read-line)))
+ (loop)))))
+
+ ;; System initialization
+
+ (define (system-beh self . message)
+ (match message
+
+ (('shutdown)
+ (print "## System actor received shutdown message.")
+ (exit 0)
+ 'done)
+
+ (('print strings ...)
+ (apply print strings)
+ 'sleep)
+
+ (('read reader)
+ (mutex-lock! reader-queue-mutex)
+ (fifo-push reader-queue reader)
+ (mutex-unlock! reader-available-mutex)
+ (mutex-unlock! reader-queue-mutex)
+ 'sleep)))
+
+ (define (boot-sam host port main-beh)
+ (set! sam-host host)
+ (set! sam-port port)
+ (start-console)
+ (start-network-listener)
+ (send-message (make-actor main-beh) (make-actor system-beh))
+ (start-scheduler)))