store: Memoize 'built-in-builders' call directly in <store-connection>.

The caching strategy introduced in
40cc850aeb was ineffective since we
regularly start from an empty object cache.  For example, "guix build
inkscape -n" would make 241 'built-in-builders' RPCs.

* guix/store.scm (<store-connection>)[built-in-builders]: New field.
(open-connection): Adjust '%make-store-connection' call accordingly.
(port->connection): Likewise.
(built-in-builders): Rename to...
(%built-in-builders):  ... this.
(built-in-builders): New procedure.
* guix/download.scm (built-in-builders*): Remove 'mcached' call.
This commit is contained in:
Ludovic Courtès 2019-04-16 10:26:46 +02:00
parent b744862704
commit 3961edf230
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 34 additions and 23 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
@ -415,11 +415,7 @@
(object->string %content-addressed-mirrors))) (object->string %content-addressed-mirrors)))
(define built-in-builders* (define built-in-builders*
(let ((proc (store-lift built-in-builders))) (store-lift built-in-builders))
(lambda ()
"Return, as a monadic value, the list of built-in builders supported by
the daemon; cache the return value."
(mcached (proc) built-in-builders))))
(define* (built-in-download file-name url (define* (built-in-download file-name url
#:key system hash-algo hash #:key system hash-algo hash

View File

@ -368,7 +368,9 @@
(ats-cache store-connection-add-to-store-cache) (ats-cache store-connection-add-to-store-cache)
(atts-cache store-connection-add-text-to-store-cache) (atts-cache store-connection-add-text-to-store-cache)
(object-cache store-connection-object-cache (object-cache store-connection-object-cache
(default vlist-null))) ;vhash (default vlist-null)) ;vhash
(built-in-builders store-connection-built-in-builders
(default (delay '())))) ;promise
(set-record-type-printer! <store-connection> (set-record-type-printer! <store-connection>
(lambda (obj port) (lambda (obj port)
@ -557,13 +559,17 @@ for this connection will be pinned. Return a server object."
(write-int cpu-affinity port))) (write-int cpu-affinity port)))
(when (>= (protocol-minor v) 11) (when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) port)) (write-int (if reserve-space? 1 0) port))
(let ((conn (%make-store-connection port (letrec* ((built-in-builders
(protocol-major v) (delay (%built-in-builders conn)))
(protocol-minor v) (conn
output flush (%make-store-connection port
(make-hash-table 100) (protocol-major v)
(make-hash-table 100) (protocol-minor v)
vlist-null))) output flush
(make-hash-table 100)
(make-hash-table 100)
vlist-null
built-in-builders)))
(let loop ((done? (process-stderr conn))) (let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn))) (or done? (process-stderr conn)))
conn))))))))) conn)))))))))
@ -578,13 +584,17 @@ already taken place on PORT and that we're just continuing on this established
connection. Use with care." connection. Use with care."
(let-values (((output flush) (let-values (((output flush)
(buffering-output-port port (make-bytevector 8192)))) (buffering-output-port port (make-bytevector 8192))))
(%make-store-connection port (define connection
(protocol-major version) (%make-store-connection port
(protocol-minor version) (protocol-major version)
output flush (protocol-minor version)
(make-hash-table 100) output flush
(make-hash-table 100) (make-hash-table 100)
vlist-null))) (make-hash-table 100)
vlist-null
(delay (%built-in-builders connection))))
connection))
(define (store-connection-version store) (define (store-connection-version store)
"Return the protocol version of STORE as an integer." "Return the protocol version of STORE as an integer."
@ -1371,13 +1381,13 @@ that there is no guarantee that the order of the resulting list matches the
order of PATHS." order of PATHS."
substitutable-path-list)) substitutable-path-list))
(define built-in-builders (define %built-in-builders
(let ((builders (operation (built-in-builders) (let ((builders (operation (built-in-builders)
"Return the built-in builders." "Return the built-in builders."
string-list))) string-list)))
(lambda (store) (lambda (store)
"Return the names of the supported built-in derivation builders "Return the names of the supported built-in derivation builders
supported by STORE." supported by STORE. The result is memoized for STORE."
;; Check whether STORE's version supports this RPC and built-in ;; Check whether STORE's version supports this RPC and built-in
;; derivation builders in general, which appeared in Guix > 0.11.0. ;; derivation builders in general, which appeared in Guix > 0.11.0.
;; Return the empty list if it doesn't. Note that this RPC does not ;; Return the empty list if it doesn't. Note that this RPC does not
@ -1388,6 +1398,11 @@ supported by STORE."
(builders store) (builders store)
'())))) '()))))
(define (built-in-builders store)
"Return the names of the supported built-in derivation builders
supported by STORE."
(force (store-connection-built-in-builders store)))
(define-operation (optimize-store) (define-operation (optimize-store)
"Optimize the store by hard-linking identical files (\"deduplication\".) "Optimize the store by hard-linking identical files (\"deduplication\".)
Return #t on success." Return #t on success."