[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: Improve the inferior cleanup when computing package derivations
From: |
Christopher Baines |
Subject: |
03/03: Improve the inferior cleanup when computing package derivations |
Date: |
Thu, 24 Nov 2022 07:38:11 -0500 (EST) |
cbaines pushed a commit to branch master
in repository data-service.
commit ad93a780d37397f7f4e6d971ca96301553acb446
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Nov 24 12:28:19 2022 +0000
Improve the inferior cleanup when computing package derivations
---
guix-data-service/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)))