diff options
| -rw-r--r-- | examples/memcached-client.scm | 27 | ||||
| -rw-r--r-- | examples/memcached-server.scm | 20 | ||||
| -rw-r--r-- | examples/ping-client.scm | 9 | ||||
| -rw-r--r-- | examples/ping-server.scm | 14 |
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))))) |