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
-    (init-sam
-     start-console
-     send-message
+    (boot-sam
      make-actor
-     system)
+     send-message
+     send-message-later)
 
   (import scheme
           (chicken base)
@@ -24,6 +23,8 @@
           udp
           fifo)
 
+  (define trace #f)
+
   ;; Actors
 
   (define sam-host "localhost")
@@ -62,6 +63,7 @@
       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)
@@ -103,6 +105,12 @@
       (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)
@@ -114,11 +122,9 @@
       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
@@ -155,40 +161,40 @@
       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
 
-  (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! 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)))