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 machine or other
5 ;; machines via the network.
20 (chicken process-context)
32 (define sam-host "localhost")
33 (define sam-port 8000)
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)
52 (with-output-to-string
53 (lambda () (write address))))
54 (define (string->address str)
55 (with-input-from-string str read))
57 (define (address-local? address)
58 (and (equal? (address-host address) sam-host)
59 (equal? (address-port address) sam-port)))
61 (define actor-table (make-hash-table))
63 (define (make-actor beh)
64 (let* ((address (make-local-address))
65 (id (address-id address)))
66 (hash-table-set! actor-table id beh)
69 (define (deliver-message address . message)
70 (if trace (print "Delivering to " address ": " message))
71 (let ((id (address-id address)))
72 (let ((behaviour (hash-table-ref/default actor-table id '())))
74 (print "Warning: discarded message" message " to unknown actor " address)
75 (match (apply (hash-table-ref actor-table id) (cons address message))
76 ('done (hash-table-delete! actor-table id))
78 (new-beh (hash-table-set! actor-table id new-beh)))))))
82 (define local-queue-mutex (make-mutex "message queue"))
83 (define message-available-mutex (make-mutex "message available"))
84 (mutex-lock! message-available-mutex #f #f)
85 (define local-queue (make-fifo))
87 (define (send-message address . message)
88 (apply (if (address-local? address)
91 (cons address message)))
93 (define (send-local-message address . message)
94 (mutex-lock! local-queue-mutex)
95 (fifo-push local-queue (cons address message))
96 (mutex-unlock! message-available-mutex)
97 (mutex-unlock! local-queue-mutex))
99 (define (send-network-message address . message)
100 (let ((s (udp-open-socket))
101 (packet (with-output-to-string
103 (write (cons address message))))))
106 (address-host address)
107 (address-port address))
109 (udp-close-socket s)))
111 (define (send-message-later address time . message)
115 (apply send-message (cons address message)))))
117 (define (next-local-message)
119 (mutex-lock! message-available-mutex #f #f)
120 (mutex-lock! local-queue-mutex)
121 (set! res (fifo-pop local-queue))
122 (if (not (fifo-empty? local-queue))
123 (mutex-unlock! message-available-mutex))
124 (mutex-unlock! local-queue-mutex)
127 (define (start-scheduler)
129 (apply deliver-message (next-local-message))
135 (define (start-network-listener)
138 (let ((s (udp-open-socket*)))
139 (udp-bind! s #f sam-port)
141 (let-values (((n str) (udp-recv s 65536)))
142 (match (with-input-from-string str read)
143 ((address message ...)
144 (apply send-message (cons address message)))
146 (print "Warning: received badly formatted message string '" str "'"))))
151 (define reader-queue-mutex (make-mutex "reader queue"))
152 (define reader-available-mutex (make-mutex "reader available"))
153 (mutex-lock! reader-available-mutex #f #f)
154 (define reader-queue (make-fifo))
156 (define (next-reader)
158 (mutex-lock! reader-available-mutex #f #f)
159 (mutex-lock! reader-queue-mutex)
160 (set! res (fifo-pop reader-queue))
161 (if (not (fifo-empty? reader-queue))
162 (mutex-unlock! reader-available-mutex))
163 (mutex-unlock! reader-queue-mutex)
166 (define (start-console)
170 (let ((reader (next-reader)))
171 (##sys#thread-block-for-i/o! (current-thread) 0 #t)
173 (send-message reader (read-line)))
176 ;; System initialization
178 (define (system-beh self . message)
182 (print "## System actor received shutdown message.")
186 (('print strings ...)
187 (apply print strings)
191 (mutex-lock! reader-queue-mutex)
192 (fifo-push reader-queue reader)
193 (mutex-unlock! reader-available-mutex)
194 (mutex-unlock! reader-queue-mutex)
197 (define (boot-sam host port main-beh)
201 (start-network-listener)
202 (send-message (make-actor main-beh) (make-actor system-beh))