aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-build-coordinator/agent-messaging/http/server.scm7
-rw-r--r--guix-build-coordinator/utils.scm36
2 files changed, 42 insertions, 1 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 2928513..ceda10c 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -80,12 +80,17 @@ if there was no request body."
(get-gc-metrics-updater
(build-coordinator-metrics-registry build-coordinator)))
+ (define guix-memory-metrics-updater
+ (get-guix-memory-metrics-updater
+ (build-coordinator-metrics-registry build-coordinator)))
+
(define datastore-metrics-updater
(base-datastore-metrics-updater build-coordinator))
(define (update-managed-metrics!)
(call-with-delay-logging datastore-metrics-updater)
- (call-with-delay-logging gc-metrics-updater))
+ (call-with-delay-logging gc-metrics-updater)
+ (call-with-delay-logging guix-memory-metrics-updater))
(call-with-error-handling
(lambda ()
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index e633c05..5370d10 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -93,6 +93,7 @@
running-on-the-hurd?
get-gc-metrics-updater
+ get-guix-memory-metrics-updater
check-locale!))
@@ -1224,6 +1225,41 @@ again."
(metric-set metric value))))
metrics))))
+(define (get-guix-memory-metrics-updater registry)
+ (define %memoization-tables
+ (@@ (guix memoization) %memoization-tables))
+
+ (define memoization-table-entry-count-metric
+ (make-gauge-metric
+ registry "guix_memoization_table_entry_count"
+ #:labels '(procedure)))
+
+ (define %derivation-cache
+ (@@ (guix derivations) %derivation-cache))
+
+ (define derivation-cache-entry-count-metric
+ (make-gauge-metric
+ registry "guix_derivation_cache_entry_count"))
+
+ (lambda ()
+ (metric-set
+ derivation-cache-entry-count-metric
+ ;; hash-count doesn't work for weak tables?
+ (hash-fold (lambda (k v result)
+ (+ 1 result))
+ 0
+ %derivation-cache))
+
+ (hash-for-each
+ (lambda (proc table)
+ (metric-set
+ memoization-table-entry-count-metric
+ (hash-count (const #t) table)
+ #:label-values `((procedure . ,(simple-format
+ #f "~A"
+ proc)))))
+ %memoization-tables)))
+
(define (check-locale!)
(with-exception-handler
(lambda (exn)