From patchwork Thu Jun 3 07:33:55 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 29819 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 82FD627BC83; Thu, 3 Jun 2021 08:35:13 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9105627BC78 for ; Thu, 3 Jun 2021 08:35:12 +0100 (BST) Received: from localhost ([::1]:46432 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lohsl-0004eF-NZ for patchwork@mira.cbaines.net; Thu, 03 Jun 2021 03:35:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58828) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lohsc-0004e0-OX for guix-patches@gnu.org; Thu, 03 Jun 2021 03:35:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:58709) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lohsc-0001sT-Fh for guix-patches@gnu.org; Thu, 03 Jun 2021 03:35:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lohsc-0001WU-E6 for guix-patches@gnu.org; Thu, 03 Jun 2021 03:35:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48806] [PATCH 1/7] store: Support dynamic allocation of per-connection caches. References: <20210603072958.13424-1-ludo@gnu.org> In-Reply-To: <20210603072958.13424-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 03 Jun 2021 07:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48806 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 48806@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 48806-submit@debbugs.gnu.org id=B48806.16227056845754 (code B ref 48806); Thu, 03 Jun 2021 07:35:02 +0000 Received: (at 48806) by debbugs.gnu.org; 3 Jun 2021 07:34:44 +0000 Received: from localhost ([127.0.0.1]:42005 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lohsJ-0001Uk-M6 for submit@debbugs.gnu.org; Thu, 03 Jun 2021 03:34:44 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36894) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lohsI-0001UN-KS for 48806@debbugs.gnu.org; Thu, 03 Jun 2021 03:34:43 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60208) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lohsD-0001Vh-Dx; Thu, 03 Jun 2021 03:34:37 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=57488 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lohsD-0005sA-5m; Thu, 03 Jun 2021 03:34:37 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 3 Jun 2021 09:33:55 +0200 Message-Id: <20210603073401.13629-1-ludo@gnu.org> X-Mailer: git-send-email 2.31.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/store.scm ()[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) + +;;; +;;; Per-connection caches. +;;; + +;; Number of currently allocated store connection caches--things that go in +;; the 'caches' vector of . +(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 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 '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)) + ;;; ;;; 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 or an , 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 '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))))