(import (chicken io)
(chicken string)
+ (chicken port)
matchable
srfi-18 ; threads
srfi-69 ; hash-table
+ uuid ; ids for actors
+ uri-generic
udp
fifo)
;; Actors
-(define (make-machine host port)
- (cons host port))
-(define (machine-host m) (car m))
-(define (machine-port m) (cdr m))
-
-(define this-machine (make-machine "localhost" 1234))
-
-(define next-actor-id
- (let ((mutex (make-mutex "actor id mutex"))
- (next-id 1))
- (lambda ()
- (let ((res #f))
- (mutex-lock! mutex)
- (set! res next-id)
- (set! next-id (+ next-id 1))
- (mutex-unlock! mutex)
- res))))
-
-(define (address-id address) (car address))
-(define (address-machine address) (cdr address))
-(define (make-address id machine)
- (cons id machine))
+(define this-host "localhost")
+(define this-port 8000)
+
+(define (make-address host port id)
+ (make-uri #:scheme "actor"
+ #:host host
+ #:port port
+ #:path (list '/ id)))
+
+(define (make-local-address . args)
+ (make-address this-host
+ this-port
+ (if (null? args)
+ (uuid)
+ (car args))))
+
+(define (address-id address) (cadr (uri-path address)))
(define (address-local? address)
- (equal? (address-machine address)
- this-machine))
+ (and (equal? (uri-host address) this-host)
+ (equal? (uri-port address) this-port)))
(define actor-table (make-hash-table))
(define (make-actor beh)
- (let* ((id (next-actor-id)))
+ (let* ((address (make-local-address))
+ (id (address-id address)))
(hash-table-set! actor-table id beh)
- (make-address id this-machine)))
+ address))
(define (deliver-message address . message)
(let ((id (address-id address)))
(loop)))
+;; Network
+
+(define (start-network-listener)
+ (thread-start!
+ (lambda ()
+ (let ((s (udp-open-socket*)))
+ (udp-bind! s #f this-port)
+ (let loop ()
+ (let-values (((n str) (udp-recv s 1024)))
+ (print "Received " n " bytes over network: " str)
+ (match (with-input-from-string str read)
+ ((uri-str message ...)
+ (apply send-message (cons (uri-reference uri-str) message)))
+ (else
+ (print "Warning: received badly formatted message string '" str "'"))))
+ (loop))))))
+
;; System interface
(define system
(thread-start!
(lambda ()
- (thread-sleep! 10)
+ (thread-sleep! 120)
(send-message system 'shutdown)))
+(print (uri->string system))
+
(start-scheduler)
+(start-network-listener)
(start-console)
;; (thread-join! scheduler-thread)