From: "Ludovic Courtès" <ludo@gnu.org>
To: 48806@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#48806] [PATCH 1/7] store: Support dynamic allocation of per-connection caches.
Date: Thu, 3 Jun 2021 09:33:55 +0200 [thread overview]
Message-ID: <20210603073401.13629-1-ludo@gnu.org> (raw)
In-Reply-To: <20210603072958.13424-1-ludo@gnu.org>
* guix/store.scm (<store-connection>)[object-cache]: Remove.
[caches]: New field.
(open-connection, port->connection): Adjust '%make-store-connection'
calls accordingly.
(%store-connection-caches, %object-cache-id): New variables.
(allocate-store-connection-cache, vector-set)
(store-connection-cache, set-store-connection-cache)
(set-store-connection-caches!, set-store-connection-cache!): New
procedures.
(cache-object-mapping): Add #:cache parameter.
(set-store-connection-object-cache!): Remove.
(lookup-cached-object): Use 'store-connection-cache'.
(run-with-store): Use 'store-connection-caches' and
'set-store-connection-caches!'.
---
guix/store.scm | 94 +++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 78 insertions(+), 16 deletions(-)
diff --git a/guix/store.scm b/guix/store.scm
index cf5d5eeccc..897062efff 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -36,6 +36,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module ((ice-9 control) #:select (let/ec))
+ #:use-module (ice-9 atomic)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
@@ -47,7 +48,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 popen)
- #:use-module (ice-9 threads)
+ #:autoload (ice-9 threads) (current-processor-count)
#:use-module (ice-9 format)
#:use-module (web uri)
#:export (%daemon-socket-uri
@@ -87,6 +88,11 @@
nix-protocol-error-message
nix-protocol-error-status
+ allocate-store-connection-cache
+ store-connection-cache
+ set-store-connection-cache
+ set-store-connection-cache!
+
hash-algo
build-mode
@@ -383,8 +389,8 @@
;; the session.
(ats-cache store-connection-add-to-store-cache)
(atts-cache store-connection-add-text-to-store-cache)
- (object-cache store-connection-object-cache
- (default vlist-null)) ;vhash
+ (caches store-connection-caches
+ (default '#())) ;vector
(built-in-builders store-connection-built-in-builders
(default (delay '())))) ;promise
@@ -586,6 +592,10 @@ for this connection will be pinned. Return a server object."
(write-int (if reserve-space? 1 0) port))
(letrec* ((built-in-builders
(delay (%built-in-builders conn)))
+ (caches
+ (make-vector
+ (atomic-box-ref %store-connection-caches)
+ vlist-null))
(conn
(%make-store-connection port
(protocol-major v)
@@ -593,7 +603,7 @@ for this connection will be pinned. Return a server object."
output flush
(make-hash-table 100)
(make-hash-table 100)
- vlist-null
+ caches
built-in-builders)))
(let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn)))
@@ -616,7 +626,9 @@ connection. Use with care."
output flush
(make-hash-table 100)
(make-hash-table 100)
- vlist-null
+ (make-vector
+ (atomic-box-ref %store-connection-caches)
+ vlist-null)
(delay (%built-in-builders connection))))
connection))
@@ -1799,6 +1811,57 @@ The result is always the empty list unless the daemon was started with
This makes sense only when the daemon was started with '--cache-failures'."
boolean)
+\f
+;;;
+;;; Per-connection caches.
+;;;
+
+;; Number of currently allocated store connection caches--things that go in
+;; the 'caches' vector of <store-connection>.
+(define %store-connection-caches (make-atomic-box 0))
+
+(define (allocate-store-connection-cache name)
+ "Allocate a new cache for store connections and return its identifier. Said
+identifier can be passed as an argument to "
+ (let loop ((current (atomic-box-ref %store-connection-caches)))
+ (let ((previous (atomic-box-compare-and-swap! %store-connection-caches
+ current (+ current 1))))
+ (if (= previous current)
+ current
+ (loop current)))))
+
+(define %object-cache-id
+ ;; The "object cache", mapping lowerable objects such as <package> records
+ ;; to derivations.
+ (allocate-store-connection-cache 'object-cache))
+
+(define (vector-set vector index value)
+ (let ((new (vector-copy vector)))
+ (vector-set! new index value)
+ new))
+
+(define (store-connection-cache store cache)
+ "Return the cache of STORE identified by CACHE, an identifier as returned by
+'allocate-store-connection-cache'."
+ (vector-ref (store-connection-caches store) cache))
+
+(define (set-store-connection-cache store cache value)
+ "Return a copy of STORE where CACHE has the given VALUE. CACHE must be a
+value returned by 'allocate-store-connection-cache'."
+ (store-connection
+ (inherit store)
+ (caches (vector-set (store-connection-caches store) cache value))))
+
+(define set-store-connection-caches! ;private
+ (record-modifier <store-connection> 'caches))
+
+(define (set-store-connection-cache! store cache value)
+ "Set STORE's CACHE to VALUE.
+
+This is a mutating version that should be avoided. Prefer the functional
+'set-store-connection-cache' instead, together with using %STORE-MONAD."
+ (vector-set! (store-connection-caches store) cache value))
+
\f
;;;
;;; Store monad.
@@ -1819,7 +1882,9 @@ This makes sense only when the daemon was started with '--cache-failures'."
(template-directory instantiations %store-monad)
(define* (cache-object-mapping object keys result
- #:key (vhash-cons vhash-consq))
+ #:key
+ (cache %object-cache-id)
+ (vhash-cons vhash-consq))
"Augment the store's object cache with a mapping from OBJECT/KEYS to RESULT.
KEYS is a list of additional keys to match against, for instance a (SYSTEM
TARGET) tuple. Use VHASH-CONS to insert OBJECT into the cache.
@@ -1828,10 +1893,10 @@ OBJECT is typically a high-level object such as a <package> or an <origin>,
and RESULT is typically its derivation."
(lambda (store)
(values result
- (store-connection
- (inherit store)
- (object-cache (vhash-cons object (cons result keys)
- (store-connection-object-cache store)))))))
+ (set-store-connection-cache
+ store cache
+ (vhash-cons object (cons result keys)
+ (store-connection-cache store cache))))))
(define record-cache-lookup!
(if (profiled? "object-cache")
@@ -1871,7 +1936,7 @@ and KEYS; use VHASH-FOLD* to look for OBJECT in the cache. KEYS is a list of
additional keys to match against, and which are compared with 'equal?'.
Return #f on failure and the cached result otherwise."
(lambda (store)
- (let* ((cache (store-connection-object-cache store))
+ (let* ((cache (store-connection-cache store %object-cache-id))
;; Escape as soon as we find the result. This avoids traversing
;; the whole vlist chain and significantly reduces the number of
@@ -2048,9 +2113,6 @@ the store."
;; when using 'gexp->derivation' and co.
(make-parameter #f))
-(define set-store-connection-object-cache!
- (record-modifier <store-connection> 'object-cache))
-
(define* (run-with-store store mval
#:key
(guile-for-build (%guile-for-build))
@@ -2070,8 +2132,8 @@ connection, and return the result."
(when (and store new-store)
;; Copy the object cache from NEW-STORE so we don't fully discard
;; the state.
- (let ((cache (store-connection-object-cache new-store)))
- (set-store-connection-object-cache! store cache)))
+ (let ((caches (store-connection-caches new-store)))
+ (set-store-connection-caches! store caches)))
result))))
\f
--
2.31.1
next prev parent reply other threads:[~2021-06-03 7:35 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-03 7:29 [bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching Ludovic Courtès
2021-06-03 7:33 ` Ludovic Courtès [this message]
2021-06-03 7:33 ` [bug#48806] [PATCH 2/7] store: Generalize cache lookup recording Ludovic Courtès
2021-06-03 7:33 ` [bug#48806] [PATCH 3/7] grafts: Record cache lookups for profiling Ludovic Courtès
2021-06-03 7:33 ` [bug#48806] [PATCH 4/7] grafts: Use SRFI-71 instead of SRFI-11 Ludovic Courtès
2021-06-03 7:33 ` [bug#48806] [PATCH 5/7] store: Remove 'references/substitutes' Ludovic Courtès
2021-06-03 7:34 ` [bug#48806] [PATCH 6/7] store: 'references/cached' now uses a per-session cache Ludovic Courtès
2021-06-03 7:34 ` [bug#48806] [PATCH 7/7] grafts: Cache the derivation/graft mapping for the whole session Ludovic Courtès
2021-06-03 11:59 ` [bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching Lars-Dominik Braun
2021-06-03 20:39 ` Ludovic Courtès
2021-06-08 7:34 ` bug#48806: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210603073401.13629-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=48806@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.