From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id yPzcMPFyfmJpeQAAbAwnHQ (envelope-from ) for ; Fri, 13 May 2022 17:02:09 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id QAOvMPFyfmKxWwAA9RJhRA (envelope-from ) for ; Fri, 13 May 2022 17:02:09 +0200 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 E89513DCEB for ; Fri, 13 May 2022 17:02:08 +0200 (CEST) Received: from localhost ([::1]:38846 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1npWnv-0000uj-QT for larch@yhetil.org; Fri, 13 May 2022 11:02:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:35244) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1npWnq-0000tW-6q for guix-patches@gnu.org; Fri, 13 May 2022 11:02:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50642) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1npWnp-0000xT-US for guix-patches@gnu.org; Fri, 13 May 2022 11:02:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1npWnp-0008Ak-Of for guix-patches@gnu.org; Fri, 13 May 2022 11:02:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#55398] [PATCH 1/3] store: 'mcached' users can specify a cache ID. References: <20220513145947.11951-1-ludo@gnu.org> In-Reply-To: <20220513145947.11951-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: Fri, 13 May 2022 15:02:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55398 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 55398@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 55398-submit@debbugs.gnu.org id=B55398.165245406531285 (code B ref 55398); Fri, 13 May 2022 15:02:01 +0000 Received: (at 55398) by debbugs.gnu.org; 13 May 2022 15:01:05 +0000 Received: from localhost ([127.0.0.1]:44529 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1npWmv-00088W-22 for submit@debbugs.gnu.org; Fri, 13 May 2022 11:01:05 -0400 Received: from eggs.gnu.org ([209.51.188.92]:41696) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1npWmt-00087e-74 for 55398@debbugs.gnu.org; Fri, 13 May 2022 11:01:03 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34260) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1npWmn-0000qc-UG; Fri, 13 May 2022 11:00:57 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=5wv6zWEPreUQYSoydtDQrXQzrNheqrjDBwn/ng5IOYI=; b=fImItVdZQ3J3WK oH999c86DDBd3WziWblgrIjJtMVBGoPIMN4NV74aTn0FgGI4AFawcAmE1fyU11+LC4zT5WiGTzup+ tCaWytEMPv/OeLVxmIB/msWlJ4h5lxphIRKouLCDzAUQ0mgxrlljC7LncHexA5NynH4wMiTABBScY F/9157v6S9VtSiqVmq9OCi+58X+DjwgcZrGyeQiJ4ezhSGC6d7NOHyWfsndymPvHY7oU+Ju5OiZvQ F3DKHy5cKczAUC/3lbcPpoR8R1xMcH3lz8NCim4m+FgEuQbZ9s/O43fIulZILRn1b2ZZ/3Vn4c7US u4Zdhy3mfg5u6HqeMzow==; Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=44956 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 1npWmn-0002Q4-GF; Fri, 13 May 2022 11:00:57 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Fri, 13 May 2022 17:00:42 +0200 Message-Id: <20220513150044.11991-1-ludo@gnu.org> X-Mailer: git-send-email 2.36.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 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 X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1652454129; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: 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:dkim-signature; bh=5wv6zWEPreUQYSoydtDQrXQzrNheqrjDBwn/ng5IOYI=; b=iyG2xYvlvQrQUlFAxplcT52tGE9L/5TUJmhdLgX2mga8vs/blb1BOShDwwkkgNVpfz6bsv YVmdVxQm2L2IjInxbn0OAsk82DoOzYtYZJGc35wMyXCB++nA/U2z2lCJ3Bu0l4Al+bsO4z gQneBLed3sfvoHo3Gmac35YKhvH8seRCE7XpV78XOi/VXsYBfZcb0rprDdU2wsYs+sEo3R Vl5xI7vZVjcgE6diI8xPmzB4yLf3vRmfh77rxLP49ntsBAjHAqi/HPiVhFanfxJgWxBbqM hzFVfJgEX/6tc9AQBvdC4R2MNwoeoS9EIJ/pf4nUqPog6xs1ZcdXh3Y07kJlSg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1652454129; a=rsa-sha256; cv=none; b=pzRK5LzhuBgCC7/u7UKT/xp4HHtcxivwOBcmCtYXIrzcwUTbG1n/q5kTttjM44RNxObl2n KDJIPrWydmMXWrQf7bTPpkj5fx1ZAKrNrNo8Snfyo8rO/FsSFrnR++F0tltKJm7xMtrmw2 v9nGYTTlsMxOaMl+xIcCOVRPf0K6OCizSavjg6RMsrgYdfu9znQYe4OYNvXQo0xGnJQJWc SgHOWrv2AjZbe2uD+D+WTTDXgsJx6c/AAJGNxeBSxVikZBRSYYtPlM/gEl8HzaV1QZxd/T c9O2x4WuLL11gcCdtDSXhNJn47iQe99hpe17W4PNAFiR1Ceo6XRSHuNBu1vwig== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=fImItVdZ; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -3.23 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=fImItVdZ; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: E89513DCEB X-Spam-Score: -3.23 X-Migadu-Scanner: scn0.migadu.com X-TUID: iMOFS5IopaIY Users of 'mcached' can now specify a cache ID; furthermore, the cache hit rate is automatically recorded for all the caches accessed with 'mcached'. * guix/store.scm (%max-store-connection-caches) (%store-connection-cache-names): New variables. (recorder-for-cache): New procedure. (record-cache-lookup!): Add 'cache-id' parameter and rewrite in terms of 'recorder-for-cache'. (lookup-cached-object): Add 'cache-id' parameter and honor it. (%mcached): Add #:cache parameter and honor it. (mcached): Add '=>' keyword and corresponding clauses. --- guix/store.scm | 65 ++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 53 insertions(+), 12 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index 1d176fb99d..220901f6ce 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2022 Ludovic Courtès ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; Copyright © 2020 Florian Pelz @@ -1793,6 +1793,14 @@ (define-operation (clear-failed-paths (store-path-list items)) ;; the 'caches' vector of . (define %store-connection-caches (make-atomic-box 0)) +(define %max-store-connection-caches + ;; Maximum number of caches returned by 'allocate-store-connection-cache'. + 32) + +(define %store-connection-cache-names + ;; Mapping of cache ID to symbol. + (make-vector %max-store-connection-caches)) + (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 " @@ -1800,7 +1808,9 @@ (define (allocate-store-connection-cache name) (let ((previous (atomic-box-compare-and-swap! %store-connection-caches current (+ current 1)))) (if (= previous current) - current + (begin + (vector-set! %store-connection-cache-names current name) + current) (loop current))))) (define %object-cache-id @@ -1926,16 +1936,37 @@ (define (cache-lookup-recorder component title) (lambda (x y) #t))) -(define record-cache-lookup! - (cache-lookup-recorder "object-cache" "Store object cache")) +(define recorder-for-cache + (let ((recorders (make-vector %max-store-connection-caches))) + (lambda (cache-id) + "Return a procedure to record lookup stats for CACHE-ID." + (match (vector-ref recorders cache-id) + ((? unspecified?) + (let* ((name (symbol->string + (vector-ref %store-connection-cache-names cache-id))) + (description + (string-titlecase + (string-map (match-lambda + (#\- #\space) + (chr chr)) + name)))) + (let ((proc (cache-lookup-recorder name description))) + (vector-set! recorders cache-id proc) + proc))) + (proc proc))))) -(define-inlinable (lookup-cached-object object keys vhash-fold*) - "Return the cached object in the store connection corresponding to OBJECT +(define (record-cache-lookup! cache-id value cache) + "Record the lookup of VALUE in CACHE-ID, whose current value is CACHE." + (let ((record! (recorder-for-cache cache-id))) + (record! value cache))) + +(define-inlinable (lookup-cached-object cache-id object keys vhash-fold*) + "Return the object in store cache CACHE-ID corresponding to OBJECT 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-cache store %object-cache-id)) + (let* ((cache (store-connection-cache store cache-id)) ;; Escape as soon as we find the result. This avoids traversing ;; the whole vlist chain and significantly reduces the number of @@ -1949,40 +1980,50 @@ (define-inlinable (lookup-cached-object object keys vhash-fold*) result)))) #f object cache)))) - (record-cache-lookup! value cache) + (record-cache-lookup! cache-id value cache) (values value store)))) (define* (%mcached mthunk object #:optional (keys '()) #:key + (cache %object-cache-id) (vhash-cons vhash-consq) (vhash-fold* vhash-foldq*)) "Bind the monadic value returned by MTHUNK, which supposedly corresponds to OBJECT/KEYS, or return its cached value. Use VHASH-CONS to insert OBJECT into the cache, and VHASH-FOLD* to look it up." - (mlet %store-monad ((cached (lookup-cached-object object keys + (mlet %store-monad ((cached (lookup-cached-object cache object keys vhash-fold*))) (if cached (return cached) (>>= (mthunk) (lambda (result) (cache-object-mapping object keys result + #:cache cache #:vhash-cons vhash-cons)))))) (define-syntax mcached - (syntax-rules (eq? equal?) + (syntax-rules (eq? equal? =>) "Run MVALUE, which corresponds to OBJECT/KEYS, and cache it; or return the value associated with OBJECT/KEYS in the store's object cache if there is one." - ((_ eq? mvalue object keys ...) + ((_ eq? (=> cache) mvalue object keys ...) (%mcached (lambda () mvalue) object (list keys ...) + #:cache cache #:vhash-cons vhash-consq #:vhash-fold* vhash-foldq*)) - ((_ equal? mvalue object keys ...) + ((_ equal? (=> cache) mvalue object keys ...) (%mcached (lambda () mvalue) object (list keys ...) + #:cache cache #:vhash-cons vhash-cons #:vhash-fold* vhash-fold*)) + ((_ eq? mvalue object keys ...) + (mcached eq? (=> %object-cache-id) + mvalue object keys ...)) + ((_ equal? mvalue object keys ...) + (mcached equal? (=> %object-cache-id) + mvalue object keys ...)) ((_ mvalue object keys ...) (mcached eq? mvalue object keys ...)))) -- 2.36.0