From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Fri, 30 Apr 2021 22:13:52 +0000 (+0200)
Subject: Reorganized boot.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=commitdiff_plain;h=38a62fdef7fe2929d7e0bba8a847a3e1cc50c177

Reorganized boot.
---

diff --git a/chat_client.scm b/chat_client.scm
index 60d0ee4..4bf02d8 100644
--- a/chat_client.scm
+++ b/chat_client.scm
@@ -3,10 +3,9 @@
         srfi-13
         (chicken process-context))
 
-(define client-beh
+(define (make-client-beh system)
   (let ((name "name")
         (recipients '()))
-    
     (lambda (self . message)
       (match message
         (('start)
@@ -67,6 +66,10 @@
       (send-message system 'read self)
       'sleep)))
 
+(define (main-beh self system)
+  (send-message (make-actor (make-client-beh system)) 'start)
+  'done)
+
 (define (print-usage)
   (print "Actor-driven chat client.\n")
   (print "Usage: chat_client -h")
@@ -83,9 +86,7 @@
     (((or "-n" "--hostname") hstr rest ...)
      (loop rest hstr port))
     (()
-     (init-sam host port)
-     (send-message (make-actor client-beh) 'start)
-     (start-console))
+     (boot-sam host port main-beh))
     (else
      (print "Unrecognised argument '" (car args) "'.\n")
      (print-usage))))
diff --git a/sam.scm b/sam.scm
index 29da169..110a55c 100644
--- 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)))
diff --git a/simple_test.scm b/simple_test.scm
index b1981d7..cd6149b 100644
--- a/simple_test.scm
+++ b/simple_test.scm
@@ -3,7 +3,7 @@
         (chicken process-context)
         srfi-18)
 
-(define (send-startup-messages)
+(define (main-beh self system)
   (send-message system 'print "Hello, what is your name?")
   (send-message system 'read
                 (make-actor (lambda (self . message)
@@ -13,10 +13,7 @@
                                  (send-message system 'print "Hello, " name "!")
                                  'done)))))
 
-  (thread-start!
-   (lambda ()
-     (thread-sleep! 10)
-     (send-message system 'print "Boo!"))))
+  (send-message-later system 10 'print "Boo!"))
 
 (let loop ((args (cdr (argv)))
            (host "localhost")
@@ -29,7 +26,5 @@
     (("--hostname" hstr rest ...)
      (loop rest hstr port))
     (()
-     (init-sam host port)
-     (print "-- Started SAM on " host ":" port " --\n")
-     (send-startup-messages)
-     (start-console))))
+     (print "-- Starting SAM on " host ":" port " --\n")
+     (boot-sam host port main-beh))))