ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-05 10:56:56 -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 nix-server-socket
current-store-protocol-version ;for internal use current-store-protocol-version ;for internal use
cache-lookup-recorder ;for internal use
mcached mcached
&store-error store-error? &store-error store-error?
@ -1898,21 +1899,24 @@ (define* (cache-object-mapping object keys result
(vhash-cons object (cons result keys) (vhash-cons object (cons result keys)
(store-connection-cache store cache)))))) (store-connection-cache store cache))))))
(define record-cache-lookup! (define (cache-lookup-recorder component title)
(if (profiled? "object-cache") "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) (let ((fresh 0)
(lookups 0) (lookups 0)
(hits 0) (hits 0)
(size 0)) (size 0))
(register-profiling-hook! (register-profiling-hook!
"object-cache" component
(lambda () (lambda ()
(format (current-error-port) "Store object cache: (format (current-error-port) "~a:
fresh caches: ~5@a fresh caches: ~5@a
lookups: ~5@a lookups: ~5@a
hits: ~5@a (~,1f%) hits: ~5@a (~,1f%)
cache size: ~5@a entries~%" cache size: ~5@a entries~%"
fresh lookups hits title fresh lookups hits
(if (zero? lookups) (if (zero? lookups)
100. 100.
(* 100. (/ hits lookups))) (* 100. (/ hits lookups)))
@ -1920,9 +1924,9 @@ (define record-cache-lookup!
(lambda (hit? cache) (lambda (hit? cache)
(set! fresh (set! fresh
(if (eq? cache vlist-null) (if (eq? cache vlist-null)
(+ 1 fresh) (+ 1 fresh)
fresh)) fresh))
(set! lookups (+ 1 lookups)) (set! lookups (+ 1 lookups))
(set! hits (if hit? (+ hits 1) hits)) (set! hits (if hit? (+ hits 1) hits))
(set! size (+ (if hit? 0 1) (set! size (+ (if hit? 0 1)
@ -1930,6 +1934,9 @@ (define record-cache-lookup!
(lambda (x y) (lambda (x y)
#t))) #t)))
(define record-cache-lookup!
(cache-lookup-recorder "object-cache" "Store object cache"))
(define-inlinable (lookup-cached-object object keys vhash-fold*) (define-inlinable (lookup-cached-object object keys vhash-fold*)
"Return the cached object in the store connection corresponding to OBJECT "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 and KEYS; use VHASH-FOLD* to look for OBJECT in the cache. KEYS is a list of