diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-11-03 21:24:30 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-11-04 08:40:45 +0000 |
| commit | d310632f26bfbb9272a5f4019f66045256327702 (patch) | |
| tree | e053dc8fd1add1aba65f95f70fb8f6f93931605c | |
| parent | cee8868bfdeadbe8770f3ee9dc282ed8b1f36e29 (diff) | |
| download | data-service-d310632f26bfbb9272a5f4019f66045256327702.tar data-service-d310632f26bfbb9272a5f4019f66045256327702.tar.gz | |
Move the inferior cleanup to the end of each system+target
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 52 |
1 files changed, 32 insertions, 20 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index fa1d01a..0d09b54 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -620,19 +620,6 @@ '(define unsupported-cross-compilation-target-error? (const #f)) inf)) - (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-with-store/non-blocking inf store @@ -1939,6 +1926,25 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define chunk-size 1000) + (define (inferior-cleanup inferior) + (catch + 'match-error + (lambda () + (inferior-eval '(invalidate-derivation-caches!) + inferior)) + (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)) + inferior)) + (define (get-derivations system target) (let ((derivations-vector (make-vector packages-count))) (with-time-logging @@ -1955,13 +1961,19 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (lambda (inferior inferior-store) (ensure-gds-inferior-packages-defined! inferior) - (inferior-package-derivations - inferior-store - inferior - system - target - start-index - count))))) + (let ((result + (inferior-package-derivations + inferior-store + inferior + system + target + start-index + count))) + + (when last-chunk? + (inferior-cleanup inferior)) + + result))))) (vector-copy! derivations-vector start-index chunk) |