Do more when cleaning inferiors
Not sure if this actually helps, but it might do.
This commit is contained in:
parent
7ffe82dfe3
commit
0c1e9ad4e4
1 changed files with 42 additions and 0 deletions
|
|
@ -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)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue