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

Compute package derivations in chunks

Browse source 
This allows for keeping the inferiors and store connections around for a more
constant period, and allows closing the store connections and allowing the
guix-daemon to clear the WAL file if needed.
This commit is contained in:
Christopher Baines 2024-07-19 19:45:07 +01:00
parent ed4ba8eb95
commit 7df7fd3e52
1 changed files with 121 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -405,7 +405,7 @@
(append supported-system-pairs
supported-system-cross-build-pairs))
(define (inferior-package-derivations store inf system target)
(define (inferior-package-derivations store inf system target start-index count)
(define proc
`(lambda (store)
(define system-target-pair
@ -511,8 +511,12 @@
(/ (assoc-ref stats 'heap-size)
(expt 2. 20)))))
(vector-map
(lambda (_ package)
(let ((vec (list->vector
(iota ,count ,start-index))))
(vector-map!
(lambda (_ index)
(define package (vector-ref gds-inferior-packages index))
(catch
#t
(lambda ()
@ -567,7 +571,8 @@
key
args)
#f)))))
gds-inferior-packages)))
vec)
vec)))
(inferior-eval
'(when (defined? 'systems (resolve-module '(guix platform)))
@ -1449,10 +1454,9 @@
1
#:min-size 0))
(define package-ids-promise
(define packages-data-promise
(fibers-delay
(lambda ()
(let ((packages-data
(with-resource-from-pool inf-and-store-pool res
(match res
((inferior . inferior-store)
@ -1463,7 +1467,12 @@
(all-inferior-packages-data
inferior
packages
pkg-to-replacement-hash-table))))))))
pkg-to-replacement-hash-table)))))))))
(define package-ids-promise
(fibers-delay
(lambda ()
(let ((packages-data (fibers-force packages-data-promise)))
(with-resource-from-pool postgresql-connection-pool conn
(insert-packages conn packages-data))))))
@ -1524,6 +1533,13 @@
lint-warning-ids)))))))
(define (extract-and-store-package-derivations)
(define packages-count
(vector-length
(assq-ref (fibers-force packages-data-promise)
'names)))
(define chunk-size 3000)
(fibers-for-each
(match-lambda
((system . target)
@ -1535,10 +1551,15 @@
(sleep 30)
(loop (stat:size (stat "/var/guix/db/db.sqlite-wal")))))
(let ((derivations-vector
(with-resource-from-pool inf-and-store-pool res
(let ((derivations-vector (make-vector packages-count)))
(with-time-logging
(simple-format #f "getting derivations for ~A" (cons system target))
(let loop ((start-index 0))
(if (>= (+ start-index chunk-size) packages-count)
(let* ((remaining-count
(- packages-count start-index))
(chunk
(with-resource-from-pool inf-and-store-pool res
(match res
((inferior . inferior-store)
(ensure-gds-inferior-packages-defined! inferior)
@ -1547,7 +1568,29 @@
inferior-store
inferior
system
target)))))))
target
start-index
remaining-count))))))
(vector-copy! derivations-vector
start-index
chunk))
(let ((chunk
(with-resource-from-pool inf-and-store-pool res
(match res
((inferior . inferior-store)
(ensure-gds-inferior-packages-defined! inferior)
(inferior-package-derivations
inferior-store
inferior
system
target
start-index
chunk-size))))))
(vector-copy! derivations-vector
start-index
chunk)
(loop (+ start-index chunk-size))))))
(let ((package-ids (fibers-force package-ids-promise)))
(with-resource-from-pool postgresql-connection-pool conn