From ad93a780d37397f7f4e6d971ca96301553acb446 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 24 Nov 2022 12:28:19 +0000
Subject: [PATCH] Improve the inferior cleanup when computing package
 derivations

---
 .../jobs/load-new-guix-revision.scm           | 41 +++++++++++++------
 1 file changed, 28 insertions(+), 13 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 03a47fc..f60eaad 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -859,7 +859,34 @@ WHERE job_id = $1")
                  (expt 2. 20))))
 
      (format (current-error-port)
-             "inferior heap: ~a MiB used (~a MiB heap)~%"
+             "inferior heap before cleanup: ~a MiB used (~a MiB heap)~%"
+             (round
+              (/ (inferior-eval
+                  '(let ((stats (gc-stats)))
+                     (- (assoc-ref stats 'heap-size)
+                        (assoc-ref stats 'heap-free-size)))
+                  inf)
+                 (expt 2. 20)))
+             (round
+              (/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
+                 (expt 2. 20))))
+     (catch
+       'match-error
+       (lambda ()
+         (inferior-eval '(invalidate-derivation-caches!) inf))
+       (lambda (key . args)
+         (simple-format
+          (current-error-port)
+          "warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
+
+     ;; 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)) inf)
+
+     (inferior-eval '(gc) inf)
+
+     (format (current-error-port)
+             "inferior heap after cleanup: ~a MiB used (~a MiB heap)~%"
              (round
               (/ (inferior-eval
                   '(let ((stats (gc-stats)))
@@ -874,19 +901,7 @@ WHERE job_id = $1")
      (let ((derivations
             (with-time-logging
                 (simple-format #f "getting derivations for ~A" system-target-pair)
-              (catch
-                'match-error
-                (lambda ()
-                  (inferior-eval '(invalidate-derivation-caches!) inf))
-                (lambda (key . args)
-                  (simple-format
-                   (current-error-port)
-                   "warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
               (inferior-eval-with-store inf store (proc packages (list system-target-pair))))))
-
-       ;; 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)) inf)
        derivations))
    (append supported-system-pairs
            supported-system-cross-build-pairs)))