The Lambda Lab
/
projects
/
sam.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Reorganized boot.
[sam.git]
/
sam.scm
diff --git
a/sam.scm
b/sam.scm
index
29da169
..
110a55c
100644
(file)
--- a/
sam.scm
+++ b/
sam.scm
@@
-4,11
+4,10
@@
;; with actors on the same machine or other machines via the network.
(module sam
;; with actors on the same machine or other machines via the network.
(module sam
- (init-sam
- start-console
- send-message
+ (boot-sam
make-actor
make-actor
- system)
+ send-message
+ send-message-later)
(import scheme
(chicken base)
(import scheme
(chicken base)
@@
-24,6
+23,8
@@
udp
fifo)
udp
fifo)
+ (define trace #f)
+
;; Actors
(define sam-host "localhost")
;; Actors
(define sam-host "localhost")
@@
-62,6
+63,7
@@
address))
(define (deliver-message address . message)
address))
(define (deliver-message address . message)
+ (if trace (print "Delivering to " address ": " message))
(let ((id (address-id address)))
(let ((behaviour (hash-table-ref/default actor-table id '())))
(if (null? behaviour)
(let ((id (address-id address)))
(let ((behaviour (hash-table-ref/default actor-table id '())))
(if (null? behaviour)
@@
-103,6
+105,12
@@
(udp-send s packet)
(udp-close-socket s)))
(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)
(define (next-local-message)
(let ((res #f))
(mutex-lock! message-available-mutex #f #f)
@@
-114,11
+122,9
@@
res))
(define (start-scheduler)
res))
(define (start-scheduler)
- (thread-start!
- (lambda ()
- (let loop ()
- (apply deliver-message (next-local-message))
- (loop)))))
+ (let loop ()
+ (apply deliver-message (next-local-message))
+ (loop)))
;; Network
;; Network
@@
-155,40
+161,40
@@
res))
(define (start-console)
res))
(define (start-console)
- (let loop ()
- (let ((reader (next-reader)))
- (##sys#thread-block-for-i/o! (current-thread) 0 #t)
- (thread-yield!)
- (send-message reader (read-line)))
- (loop)))
+ (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
;; System initialization
- (define (make-system-actor)
- (make-actor (lambda (self . message)
- (match message
-
- (('shutdown)
- (print "## System actor received shutdown message.")
- (exit 0)
- 'done)
+ (define (system-beh self . message)
+ (match message
- (('print strings ...)
- (apply print strings)
- 'sleep)
+ (('shutdown)
+ (print "## System actor received shutdown message.")
+ (exit 0)
+ 'done)
- (('read reader)
- (mutex-lock! reader-queue-mutex)
- (fifo-push reader-queue reader)
- (mutex-unlock! reader-available-mutex)
- (mutex-unlock! reader-queue-mutex)
- 'sleep)))))
+ (('print strings ...)
+ (apply print strings)
+ 'sleep)
- (define system #f)
+ (('read reader)
+ (mutex-lock! reader-queue-mutex)
+ (fifo-push reader-queue reader)
+ (mutex-unlock! reader-available-mutex)
+ (mutex-unlock! reader-queue-mutex)
+ 'sleep)))
- (define (
init-sam host port
)
+ (define (
boot-sam host port main-beh
)
(set! sam-host host)
(set! sam-port port)
(set! sam-host host)
(set! sam-port port)
- (set! system (make-system-actor))
- (start-scheduler)
- (start-network-listener)))
+ (start-console)
+ (start-network-listener)
+ (send-message (make-actor main-beh) (make-actor system-beh))
+ (start-scheduler)))