From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id +j2INjGGuGA+VwAAgWs5BA (envelope-from ) for ; Thu, 03 Jun 2021 09:35:13 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id EI8WMTGGuGA9CwAA1q6Kng (envelope-from ) for ; Thu, 03 Jun 2021 07:35:13 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 6FD6C1D479 for ; Thu, 3 Jun 2021 09:35:13 +0200 (CEST) Received: from localhost ([::1]:46432 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lohsm-0004eF-Ej for larch@yhetil.org; Thu, 03 Jun 2021 03:35:12 -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 Content-Transfer-Encoding: 8bit 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1622705713; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=x7wgIFFIIC4ZLslNkHJsd/aJl3jDiCBUxPc/qCjv6Pc=; b=Bbd0YHePK/bl/hxwbliDi0Wg5aVpQVJBtoc58uEQ8X9WQZeyo233cCJmyP6bzdAtpBQt6x HeKFQnBL7yWhLzbkDb4o/u2IMjxMjQrD+ICnfIstfYFFTCB1nffflY8GHbuVgERcEwUX57 n8sXVxw9+y6DLa2B9RjK0vsR6k/0FevF5Tq6hXINLLs/GRXTTZhA5eRKkxZIFEtvtiMYw1 JTq0aiKkaS/4qvWVkc7r2RKhu/QIrNXOTGGEhpwkkr35RdCL+V6KjNd+/fVpZEjEIQAqlE auVvvZYnEpnyeAgGewyyIUQ6aq16U7cSFF/tmb6FbbM5abaIGDqD74uMu+AG6g== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1622705713; a=rsa-sha256; cv=none; b=XyQtFLHIs2G/T/Pgrky0VS+GtE9pS50S1h02cbs4vW12PYYnXoaCAlR+D1NYbb6LJBLAXd 7iPcwKgkNbZHDsA41QbwC0sUancgO6i8BVLqbX7u+WsuUy6+BSJN3boNNLtdWu/ugEb+gY q1n3l7mvRIP4ZJHsJojTtir10zfFifmZ+ksdKcSUdSCwLs3Ig3Y0AERtkhZqGI/C9NEOm1 cEN2uvE6RLMsKorZFhcaze7pY7As2+f0w3q7vk38NErdu3QpJhdMwN2mU6W7dIRX7K/UIv Eo3l563jiL+meXsSRulIvwrdUlUgUHd0UyL/9KVUKvW4oVD7A2LmlRd6idQ/9w== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: 2.07 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 6FD6C1D479 X-Spam-Score: 2.07 X-Migadu-Scanner: scn0.migadu.com X-TUID: NSI+RIHTBNye * 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)))) -- 2.31.1