cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve the inferior cleanup when computing package derivations

Browse source
This commit is contained in:
Christopher Baines 2022-11-24 12:28:19 +00:00
parent ff6f87a3b9
commit ad93a780d3
1 changed files with 28 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

41
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -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)))