store: Buffer RPC writes.

For a command like:

  guix build python2-numpy -n

this reduces the number of 'write' syscalls from 9.5K to 2.0K.

* guix/store.scm (<nix-server>)[buffer, flush]: New fields.
(open-connection): Adjust accordingly.  Call 'buffering-output-port' to
compute the two new fields.
(write-buffered-output, buffering-output-port): New procedures.
(operation): Write to (nix-server-output-port server).  Call
'write-buffered-output'.
This commit is contained in:
Ludovic Courtès 2017-06-19 21:47:22 +02:00 committed by Ludovic Courtès
parent ec450c3642
commit e037e9dbec
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 59 additions and 4 deletions

View File

@ -322,12 +322,16 @@
(define-record-type <nix-server> (define-record-type <nix-server>
(%make-nix-server socket major minor (%make-nix-server socket major minor
buffer flush
ats-cache atts-cache) ats-cache atts-cache)
nix-server? nix-server?
(socket nix-server-socket) (socket nix-server-socket)
(major nix-server-major-version) (major nix-server-major-version)
(minor nix-server-minor-version) (minor nix-server-minor-version)
(buffer nix-server-output-port) ;output port
(flush nix-server-flush-output) ;thunk
;; Caches. We keep them per-connection, because store paths build ;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of ;; during the session are temporary GC roots kept for the duration of
;; the session. ;; the session.
@ -481,7 +485,11 @@ for this connection will be pinned. Return a server object."
(&nix-connection-error (file (or port uri)) (&nix-connection-error (file (or port uri))
(errno EPROTO)) (errno EPROTO))
(&message (message "build daemon handshake failed")))))) (&message (message "build daemon handshake failed"))))))
(let ((port (or port (connect-to-daemon uri)))) (let*-values (((port)
(or port (connect-to-daemon uri)))
((output flush)
(buffering-output-port port
(make-bytevector 8192))))
(write-int %worker-magic-1 port) (write-int %worker-magic-1 port)
(let ((r (read-int port))) (let ((r (read-int port)))
(and (eqv? r %worker-magic-2) (and (eqv? r %worker-magic-2)
@ -499,12 +507,18 @@ for this connection will be pinned. Return a server object."
(let ((conn (%make-nix-server port (let ((conn (%make-nix-server port
(protocol-major v) (protocol-major v)
(protocol-minor v) (protocol-minor v)
output flush
(make-hash-table 100) (make-hash-table 100)
(make-hash-table 100)))) (make-hash-table 100))))
(let loop ((done? (process-stderr conn))) (let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn))) (or done? (process-stderr conn)))
conn))))))))) conn)))))))))
(define (write-buffered-output server)
"Flush SERVER's output port."
(force-output (nix-server-output-port server))
((nix-server-flush-output server)))
(define (close-connection server) (define (close-connection server)
"Close the connection to SERVER." "Close the connection to SERVER."
(close (nix-server-socket server))) (close (nix-server-socket server)))
@ -718,6 +732,44 @@ encoding conversion errors."
(let loop ((done? (process-stderr server))) (let loop ((done? (process-stderr server)))
(or done? (process-stderr server))))) (or done? (process-stderr server)))))
(define (buffering-output-port port buffer)
"Return two value: an output port wrapped around PORT that uses BUFFER (a
bytevector) as its internal buffer, and a thunk to flush this output port."
;; 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))))))))
;; Note: We need to return FLUSH because the custom binary port has no way
;; to be notified of a 'force-output' call on itself.
(values (make-custom-binary-output-port "buffering-output-port"
write #f #f flush)
flush))
(define %rpc-calls (define %rpc-calls
;; Mapping from RPC names (symbols) to invocation counts. ;; Mapping from RPC names (symbols) to invocation counts.
(make-hash-table)) (make-hash-table))
@ -755,11 +807,14 @@ encoding conversion errors."
((_ (name (type arg) ...) docstring return ...) ((_ (name (type arg) ...) docstring return ...)
(lambda (server arg ...) (lambda (server arg ...)
docstring docstring
(let ((s (nix-server-socket server))) (let* ((s (nix-server-socket server))
(buffered (nix-server-output-port server)))
(record-operation 'name) (record-operation 'name)
(write-int (operation-id name) s) (write-int (operation-id name) buffered)
(write-arg type arg s) (write-arg type arg buffered)
... ...
(write-buffered-output server)
;; Loop until the server is done sending error output. ;; Loop until the server is done sending error output.
(let loop ((done? (process-stderr server))) (let loop ((done? (process-stderr server)))
(or done? (loop (process-stderr server)))) (or done? (loop (process-stderr server))))