Reorganized boot.

[sam.git] / sam.scm

diff --git a/sam.scm b/sam.scm
index c3dcbe6..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)
@@ -79,7 +81,6 @@
   (define local-queue (make-fifo))
 
   (define (send-message address . message)
-    (print "send-message: Sending " message " to " address)
     (apply (if (address-local? address)
                send-local-message
                send-network-message)
@@ -96,7 +97,7 @@
           (uri (address->uri address))
           (packet (with-output-to-string
                     (lambda ()
-                      (print (cons address message))))))
+                      (write (cons address message))))))
       (udp-bind! s #f 0)
       (udp-connect! s
                     (uri-host uri)
@@ -104,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)
@@ -115,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
@@ -131,7 +136,6 @@
          (udp-bind! s #f sam-port)
          (let loop ()
            (let-values (((n str) (udp-recv s 1024)))
-             (print "network-listener: Received " n " bytes over network: " str)
              (match (with-input-from-string str read)
                ((address message ...)
                 (apply send-message (cons address message)))
@@ -157,41 +161,40 @@
       res))
 
   (define (start-console)
-    (let loop ()
-      (let ((reader (next-reader)))
-        (print "console: received next reader: " 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)))