From 0c1e9ad4e466be19f992571ac4fecbbbe2237edf Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 8 Nov 2024 12:59:08 +0000
Subject: [PATCH] Do more when cleaning inferiors

Not sure if this actually helps, but it might do.
---
 .../jobs/load-new-guix-revision.scm           | 42 +++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 2511783..5f9e5b3 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1926,6 +1926,20 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
     (define chunk-size 1000)
 
     (define (inferior-cleanup inferior)
+      (inferior-eval
+       '(let ((stats (gc-stats)))
+          (simple-format
+           (current-error-port)
+           "cleaning up inferior (heap: ~a MiB used (~a MiB heap))~%"
+           (round
+            (/ (- (assoc-ref stats 'heap-size)
+                  (assoc-ref stats 'heap-free-size))
+               (expt 2. 20)))
+           (round
+            (/ (assoc-ref stats 'heap-size)
+               (expt 2. 20)))))
+       inferior)
+
       (catch
         'match-error
         (lambda ()
@@ -1936,12 +1950,40 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
            (current-error-port)
            "warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
 
+      ;; Generating derivations populates the derivation cache
+      (inferior-eval
+       '(hash-clear! (@@ (guix derivations) %derivation-cache))
+       inferior)
+
       ;; Clean the cached store connections, as there are
       ;; caches associated with these that take up lots of
       ;; memory
       (inferior-eval
        '(when (defined? '%store-table)
           (hash-clear! %store-table))
+       inferior)
+
+      (inferior-eval
+       '(hash-for-each
+         (lambda (key _)
+           ((@ (guix memoization) invalidate-memoization!) key))
+         (@@ (guix memoization) %memoization-tables))
+       inferior)
+
+      (inferior-eval '(gc) inferior)
+
+      (inferior-eval
+       '(let ((stats (gc-stats)))
+          (simple-format
+           (current-error-port)
+           "finished cleaning up inferior (heap: ~a MiB used (~a MiB heap))~%"
+           (round
+            (/ (- (assoc-ref stats 'heap-size)
+                  (assoc-ref stats 'heap-free-size))
+               (expt 2. 20)))
+           (round
+            (/ (assoc-ref stats 'heap-size)
+               (expt 2. 20)))))
        inferior))
 
     (define (get-derivations system target)