Re: RPC performance

[Ludovic Courtès]

address@hidden (Ludovic Courtès) skribis:

> There are several ways we can improve it, and over time we should try to
> implement all of them:
>
>   1. Buffer writes to the server socket (currently it’s terrible if you
>      look at the ‘write’ calls in ‘strace’).

Could you test the effect of the patch below?  It reduces the number of
‘write’ calls from 9.5K to 2.0K on “guix build python2-numpy”.

(It’s not acceptable as-is because it allocates a new port and
associated buffer at each RPC, meaning that on my laptop the cost in
user time slightly outweighs the cost in system time.)

Ludo’.

diff --git a/guix/store.scm b/guix/store.scm
index 2acab6b1a..47fa3447f 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -321,13 +321,15 @@
 ;; remote-store.cc
 
 (define-record-type <nix-server>
-  (%make-nix-server socket major minor
+  (%make-nix-server socket major minor buffer
                     ats-cache atts-cache)
   nix-server?
   (socket nix-server-socket)
   (major  nix-server-major-version)
   (minor  nix-server-minor-version)
 
+  (buffer nix-server-output-buffer)
+
   ;; Caches.  We keep them per-connection, because store paths build
   ;; during the session are temporary GC roots kept for the duration of
   ;; the session.
@@ -499,6 +501,7 @@ for this connection will be pinned.  Return a server 
object."
                       (let ((conn (%make-nix-server port
                                                     (protocol-major v)
                                                     (protocol-minor v)
+                                                    (make-bytevector 8192)
                                                     (make-hash-table 100)
                                                     (make-hash-table 100))))
                         (let loop ((done? (process-stderr conn)))
@@ -718,6 +721,41 @@ encoding conversion errors."
     (let loop ((done? (process-stderr server)))
       (or done? (process-stderr server)))))
 
+(define (buffering-output-port port buffer)
+  ;; Note: In Guile 2.2.2, custom binary output ports already have their own
+  ;; 4K internal buffer.
+  (define size
+    (bytevector-length buffer))
+
+  (define total 0)
+
+  (define (flush)
+    (put-bytevector port buffer 0 total)
+    (set! total 0))
+
+  (define (write bv offset count)
+    (if (zero? count)                             ;end of file
+        (flush)
+        (let loop ((offset offset)
+                   (count count)
+                   (written 0))
+          (cond ((= total size)
+                 (flush)
+                 (loop offset count written))
+                ((zero? count)
+                 written)
+                (else
+                 (let ((to-copy (min count (- size total))))
+                   (bytevector-copy! bv offset buffer total to-copy)
+                   (set! total (+ total to-copy))
+                   (loop (+ offset to-copy) (- count to-copy)
+                         (+ written to-copy))))))))
+
+  (let ((port (make-custom-binary-output-port "buffering-output-port"
+                                              write #f #f flush)))
+    (setvbuf port _IONBF)
+    port))
+
 (define %rpc-calls
   ;; Mapping from RPC names (symbols) to invocation counts.
   (make-hash-table))
@@ -755,11 +793,15 @@ encoding conversion errors."
     ((_ (name (type arg) ...) docstring return ...)
      (lambda (server arg ...)
        docstring
-       (let ((s (nix-server-socket server)))
+       (let* ((s (nix-server-socket server))
+              (buffered (buffering-output-port
+                         s (nix-server-output-buffer server))))
          (record-operation 'name)
-         (write-int (operation-id name) s)
-         (write-arg type arg s)
+         (write-int (operation-id name) buffered)
+         (write-arg type arg buffered)
          ...
+         (close-port buffered)
+
          ;; Loop until the server is done sending error output.
          (let loop ((done? (process-stderr server)))
            (or done? (loop (process-stderr server))))