1 ;; Simple Actor Machine
3 ;; A virtual machine which houses a population of actors which can
4 ;; communicate using messages with actors on the same host or other
5 ;; hosts via the network.
12 (chicken process-context)
27 (define sam-host "localhost")
28 (define sam-port 8000)
30 (define sam-version "0.1")
35 (define (make-address host port id)
38 (define (make-local-address . args)
39 (make-address sam-host
45 (define (address-id address)
47 (define (address-host address)
49 (define (address-port address)
51 (define (address->string address)
53 (make-uri #:scheme "actor"
54 #:host (address-host address)
55 #:port (address-port address)
56 #:path (list '/ (address-id address)))))
57 (define (string->address str)
58 (let ((uri (uri-reference str)))
59 (make-address (uri-host uri)
61 (cadr (uri-path uri)))))
63 (define (address-local? address)
64 (and (equal? (address-host address) sam-host)
65 (equal? (address-port address) sam-port)))
67 (define actor-table (make-hash-table))
69 (define (make-actor beh)
70 (let* ((address (make-local-address))
71 (id (address-id address)))
72 (hash-table-set! actor-table id beh)
75 (define (deliver-message address . message)
76 (if trace (print "Delivering to " address ": " message))
77 (let ((id (address-id address)))
78 (let ((behaviour (hash-table-ref/default actor-table id '())))
80 (print "## Warning: discarded message " message
81 " to unknown actor id " id)
83 (match (apply behaviour (cons address message))
84 ('done (hash-table-delete! actor-table id))
86 (new-beh (hash-table-set! actor-table id new-beh)))
88 (print "## Warning: actor id " id " crashed evaluating message " message)))))))
92 (define local-queue-mutex (make-mutex "message queue"))
93 (define message-available-mutex (make-mutex "message available"))
94 (mutex-lock! message-available-mutex #f #f)
95 (define local-queue (make-fifo))
97 (define (send-message address . message)
98 (apply (if (address-local? address)
100 send-network-message)
101 (cons address message)))
103 (define (send-local-message address . message)
104 (mutex-lock! local-queue-mutex)
105 (fifo-push local-queue (cons address message))
106 (mutex-unlock! message-available-mutex)
107 (mutex-unlock! local-queue-mutex))
109 (define (send-network-message address . message)
110 (let ((s (udp-open-socket))
111 (packet (with-output-to-string
113 (write (cons address message))))))
116 (address-host address)
117 (address-port address))
119 (udp-close-socket s)))
121 (define (send-message-later address time . message)
125 (apply send-message (cons address message)))))
127 (define (next-local-message)
129 (mutex-lock! message-available-mutex #f #f)
130 (mutex-lock! local-queue-mutex)
131 (set! res (fifo-pop local-queue))
132 (if (not (fifo-empty? local-queue))
133 (mutex-unlock! message-available-mutex))
134 (mutex-unlock! local-queue-mutex)
137 (define (start-scheduler)
139 (apply deliver-message (next-local-message))
145 (define (start-network-listener)
148 (let ((s (udp-open-socket*)))
149 (udp-bind! s #f sam-port)
151 (let-values (((n str) (udp-recv s 65536)))
152 (match (with-input-from-string str read)
153 ((address message ...)
154 (apply send-message (cons address message)))
156 (print "Warning: received badly formatted message string '" str "'"))))
161 (define reader-queue-mutex (make-mutex "reader queue"))
162 (define reader-available-mutex (make-mutex "reader available"))
163 (mutex-lock! reader-available-mutex #f #f)
164 (define reader-queue (make-fifo))
166 (define (next-reader)
168 (mutex-lock! reader-available-mutex #f #f)
169 (mutex-lock! reader-queue-mutex)
170 (set! res (fifo-pop reader-queue))
171 (if (not (fifo-empty? reader-queue))
172 (mutex-unlock! reader-available-mutex))
173 (mutex-unlock! reader-queue-mutex)
176 (define (start-console)
180 (let ((reader (next-reader)))
181 (##sys#thread-block-for-i/o! (current-thread) 0 #t)
183 (send-message reader (read-line)))
186 ;; System initialization
188 (define (system-beh self . message)
192 (print "## System actor received shutdown message.")
196 (('print strings ...)
197 (apply print strings)
201 (mutex-lock! reader-queue-mutex)
202 (fifo-push reader-queue reader)
203 (mutex-unlock! reader-available-mutex)
204 (mutex-unlock! reader-queue-mutex)
209 (start-network-listener)
210 (let ((system (make-actor system-beh))
214 (set! main (make-actor main-beh)))
216 (print "## Error starting main actor. Is main-beh defined?")
218 (send-message main system))
221 (define (print-usage)
222 (print "Simple Actor Machine v" sam-version "\n"
224 "Usage: sam -h|--help\n"
225 " sam [-n hostname] [-p port] source-file-1 [source-file-2 [...]] "))
228 (let loop ((args (cdr (argv))))
230 (((or "-h" "--help"))
232 (((or "-p" "--port") pstr rest ...)
233 (set! sam-port (string->number pstr))
235 (((or "-n" "--hostname") hstr rest ...)
238 (((? file-exists? filename) rest ...)
239 (print* "## Loading " filename "...")
244 (print "## Booting SAM\n")
247 (print "Unrecognised argument '" (car args) "'.\n")