ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-03 09:58:57 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Generalize cache lookup recording.

Browse source 
* guix/store.scm (cache-lookup-recorder): New procedure.
(record-cache-lookup!): Define in terms of it.
This commit is contained in:
Ludovic Courtès 2021-05-28 17:45:11 +02:00
parent d9d7b9ec41
commit 0a3c723e07
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
guix/store.scm
View file

@ -69,6 +69,7 @@ (define-module (guix store)
nix-server-socket
current-store-protocol-version ;for internal use
cache-lookup-recorder ;for internal use
mcached
&store-error store-error?
@ -1898,21 +1899,24 @@ (define* (cache-object-mapping object keys result
(vhash-cons object (cons result keys)
(store-connection-cache store cache))))))
(define record-cache-lookup!
(if (profiled? "object-cache")
(define (cache-lookup-recorder component title)
"Return a procedure of two arguments to record cache lookups, hits, and
misses for COMPONENT. The procedure must be passed a Boolean indicating
whether the cache lookup was a hit, and the actual cache (a vhash)."
(if (profiled? component)
(let ((fresh 0)
(lookups 0)
(hits 0)
(size 0))
(register-profiling-hook!
"object-cache"
component
(lambda ()
(format (current-error-port) "Store object cache:
(format (current-error-port) "~a:
fresh caches: ~5@a
lookups: ~5@a
hits: ~5@a (~,1f%)
cache size: ~5@a entries~%"
fresh lookups hits
title fresh lookups hits
(if (zero? lookups)
100.
(* 100. (/ hits lookups)))
@ -1920,9 +1924,9 @@ (define record-cache-lookup!
(lambda (hit? cache)
(set! fresh
(if (eq? cache vlist-null)
(+ 1 fresh)
fresh))
(if (eq? cache vlist-null)
(+ 1 fresh)
fresh))
(set! lookups (+ 1 lookups))
(set! hits (if hit? (+ hits 1) hits))
(set! size (+ (if hit? 0 1)
@ -1930,6 +1934,9 @@ (define record-cache-lookup!
(lambda (x y)
#t)))
(define record-cache-lookup!
(cache-lookup-recorder "object-cache" "Store object cache"))
(define-inlinable (lookup-cached-object object keys vhash-fold*)
"Return the cached object in the store connection corresponding to OBJECT
and KEYS; use VHASH-FOLD* to look for OBJECT in the cache. KEYS is a list of