Do more when cleaning inferiors

Not sure if this actually helps, but it might do.
This commit is contained in:
Christopher Baines 2024-11-08 12:59:08 +00:00
parent 7ffe82dfe3
commit 0c1e9ad4e4

View file

@ -1926,6 +1926,20 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(define chunk-size 1000) (define chunk-size 1000)
(define (inferior-cleanup inferior) (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 (catch
'match-error 'match-error
(lambda () (lambda ()
@ -1936,12 +1950,40 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(current-error-port) (current-error-port)
"warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n"))) "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 ;; Clean the cached store connections, as there are
;; caches associated with these that take up lots of ;; caches associated with these that take up lots of
;; memory ;; memory
(inferior-eval (inferior-eval
'(when (defined? '%store-table) '(when (defined? '%store-table)
(hash-clear! %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)) inferior))
(define (get-derivations system target) (define (get-derivations system target)