From 2441ce21653cff078b938b638bb7193c4e8cb043 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 27 Mar 2023 14:26:20 +0100
Subject: Instrument the size of some Guix managed hash tables

In case any of these are a factor in the occasional high memory use.
---
 .../agent-messaging/http/server.scm                |  7 ++++-
 guix-build-coordinator/utils.scm                   | 36 ++++++++++++++++++++++
 2 files changed, 42 insertions(+), 1 deletion(-)

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)
-- 
cgit v1.2.3