Update examples

* examples/memcached-client.scm:
* examples/memcached-server.scm:
* examples/ping-client.scm:
* examples/ping-server.scm: Update for newest run-fibers.

4 files changed, 31 insertions, 39 deletions

diff --git a/examples/memcached-client.scm b/examples/memcached-client.scm
index d9d0330..6d4ec0e 100644
--- a/examples/memcached-client.scm
+++ b/examples/memcached-client.scm
@@ -19,15 +19,12 @@
 
 (use-modules (rnrs bytevectors)
              (fibers)
+             (fibers channels)
              (ice-9 binary-ports)
              (ice-9 textual-ports)
              (ice-9 rdelim)
              (ice-9 match))
 
-(define (set-nonblocking! port)
-  (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
-  (setvbuf port 'block 1024))
-
 (define (server-error port msg . args)
   (close-port port)
   (apply error msg args))
@@ -104,8 +101,9 @@
                       (addrinfo:socktype addrinfo)
                       (addrinfo:protocol addrinfo))))
     ;; Disable Nagle's algorithm.  We buffer ourselves.
-    (setsockopt port IPPROTO_TCP TCP_NODELAY 0)
-    (set-nonblocking! port)
+    (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
+    (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
+    (setvbuf port 'block 1024)
     (connect port (addrinfo:addr addrinfo))
     port))
 
@@ -129,12 +127,17 @@
   ;; The getaddrinfo call blocks, unfortunately.  Call it once before
   ;; spawning clients.
   (let ((addrinfo (car (getaddrinfo "localhost" (number->string 11211)))))
-    (let lp ((n 0))
-      (when (< n num-clients)
-        (spawn-fiber
-         (lambda ()
-           (client-loop addrinfo n num-connections)))
-        (lp (1+ n))))))
+    (for-each
+     get-message
+     (map (lambda (n)
+            (let ((ch (make-channel)))
+              (spawn-fiber
+               (lambda ()
+                 (client-loop addrinfo n num-connections)
+                 (put-message ch 'done))
+               #:parallel? #t)
+              ch))
+          (iota num-clients)))))
 
 (run-fibers
  (lambda ()
diff --git a/examples/memcached-server.scm b/examples/memcached-server.scm
index 26cca5d..3761cc0 100644
--- a/examples/memcached-server.scm
+++ b/examples/memcached-server.scm
@@ -24,16 +24,12 @@
              (ice-9 rdelim)
              (ice-9 match))
 
-(define (set-nonblocking! port)
-  (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
-  (setvbuf port 'block 1024))
-
 (define (make-default-socket family addr port)
   (let ((sock (socket PF_INET SOCK_STREAM 0)))
     (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
     (fcntl sock F_SETFD FD_CLOEXEC)
     (bind sock family addr port)
-    (set-nonblocking! sock)
+    (fcntl sock F_SETFL (logior O_NONBLOCK (fcntl sock F_GETFL)))
     sock))
 
 (define (client-error port msg . args)
@@ -103,6 +99,9 @@
     (put-string port "STORED\r\n")))
 
 (define (client-loop port addr store)
+  ;; Disable Nagle's algorithm.  We buffer ourselves.
+  (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
+  (setvbuf port 'block 1024)
   (let loop ()
     ;; TODO: Restrict read-line to 512 chars.
     (let ((line (read-line port)))
@@ -120,16 +119,13 @@
              (loop)))
           (else (client-error port "Bad command line" line))))))))
 
-;; todo: accept and connect
 (define (socket-loop socket store)
   (let loop ()
-    (match (accept socket)
+    (match (accept socket SOCK_NONBLOCK)
       ((client . addr)
-       (set-nonblocking! client)
-       ;; Disable Nagle's algorithm.  We buffer ourselves.
-       (setsockopt client IPPROTO_TCP TCP_NODELAY 0)
        (spawn-fiber
-        (lambda () (client-loop client addr store)))
+        (lambda () (client-loop client addr store))
+        #:parallel? #t)
        (loop)))))
 
 (define* (run-memcached #:key
@@ -140,7 +136,7 @@
                                   INADDR_LOOPBACK))
                         (port 11211)
                         (socket (make-default-socket family addr port)))
-  (listen socket 128)
+  (listen socket 1024)
   (sigaction SIGPIPE SIG_IGN)
   (socket-loop socket (make-hash-table)))
 
diff --git a/examples/ping-client.scm b/examples/ping-client.scm
index 8687656..a4f09bd 100644
--- a/examples/ping-client.scm
+++ b/examples/ping-client.scm
@@ -25,17 +25,14 @@
              (ice-9 rdelim)
              (ice-9 match))
 
-(define (set-nonblocking! port)
-  (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
-  (setvbuf port 'block 1024))
-
 (define (connect-to-server addrinfo)
   (let ((port (socket (addrinfo:fam addrinfo)
                       (addrinfo:socktype addrinfo)
                       (addrinfo:protocol addrinfo))))
     ;; Disable Nagle's algorithm.  We buffer ourselves.
-    (setsockopt port IPPROTO_TCP TCP_NODELAY 0)
-    (set-nonblocking! port)
+    (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
+    (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
+    (setvbuf port 'block 1024)
     (connect port (addrinfo:addr addrinfo))
     port))
 
diff --git a/examples/ping-server.scm b/examples/ping-server.scm
index d2873e3..cdc8519 100644
--- a/examples/ping-server.scm
+++ b/examples/ping-server.scm
@@ -23,19 +23,18 @@
              (ice-9 rdelim)
              (ice-9 match))
 
-(define (set-nonblocking! port)
-  (fcntl port F_SETFL (logior O_NONBLOCK (fcntl port F_GETFL)))
-  (setvbuf port 'block 1024))
-
 (define (make-default-socket family addr port)
   (let ((sock (socket PF_INET SOCK_STREAM 0)))
     (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
     (fcntl sock F_SETFD FD_CLOEXEC)
     (bind sock family addr port)
-    (set-nonblocking! sock)
+    (fcntl sock F_SETFL (logior O_NONBLOCK (fcntl sock F_GETFL)))
     sock))
 
 (define (client-loop port addr store)
+  (setvbuf port 'block 1024)
+  ;; Disable Nagle's algorithm.  We buffer ourselves.
+  (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
   (let loop ()
     ;; TODO: Restrict read-line to 512 chars.
     (let ((line (read-line port)))
@@ -50,11 +49,8 @@
 
 (define (socket-loop socket store)
   (let loop ()
-    (match (accept socket)
+    (match (accept socket SOCK_NONBLOCK)
       ((client . addr)
-       (set-nonblocking! client)
-       ;; Disable Nagle's algorithm.  We buffer ourselves.
-       (setsockopt client IPPROTO_TCP TCP_NODELAY 0)
        (spawn-fiber (lambda () (client-loop client addr store))
                     #:parallel? #t)
        (loop)))))