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