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

Don't use the after-gc-hook for monitoring garbage collection

Browse source 
This seems to be happening not in the thread I expect, so avoid using the
hook.
This commit is contained in:
Christopher Baines 2025-06-29 23:22:31 +02:00
parent 90cec0d8ac
commit 4210699949
1 changed files with 24 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

45
scripts/guix-data-service.in
View file

@ -231,31 +231,34 @@
(set-thread-name "gc watcher") (set-thread-name "gc watcher")
(add-hook! (let loop ((last-gc-times
after-gc-hook (or (assq-ref (gc-stats) 'times) 0))
(let ((last-gc-time-taken (last-gc-time-taken
(assq-ref (gc-stats) 'gc-time-taken))) (assq-ref (gc-stats) 'gc-time-taken)))
(lambda () (let* ((stats (gc-stats))
(let* ((stats (gc-times (or (assq-ref stats 'gc-times) 0))
(gc-stats)) (gc-time-taken (assq-ref stats 'gc-time-taken)))
(gc-time-taken (when (> gc-times last-gc-times)
(let ((gc-time-taken
(assq-ref stats 'gc-time-taken)) (assq-ref stats 'gc-time-taken))
(time-since-last (time-since-last
(/ (- gc-time-taken (/ (- gc-time-taken
last-gc-time-taken) last-gc-time-taken)
internal-time-units-per-second))) internal-time-units-per-second))
(when (> time-since-last 0.1) (gcs
(format (current-error-port) (- gc-times
"after gc (additional time taken: ~f, times: ~d, heap-allocated-since-gc: ~d, heap size: ~d, heap free: ~d)\n" last-gc-times)))
time-since-last (format (current-error-port)
(assq-ref stats 'gc-times) "~d gc's (time taken: ~f, heap-allocated-since-gc: ~d, heap size: ~d, heap free: ~d)\n"
(assq-ref stats 'heap-allocated-since-gc) gcs
(assq-ref stats 'heap-size) (/ time-since-last
(assq-ref stats 'heap-free-size))) gcs)
(set! last-gc-time-taken (assq-ref stats 'heap-allocated-since-gc)
(assq-ref (gc-stats) 'gc-time-taken)))))) (assq-ref stats 'heap-size)
(while #t (assq-ref stats 'heap-free-size))))
(usleep 100000)))) (sleep 5)
(loop gc-times
gc-time-taken)))))
;; Provide some visual space between the startup output and the ;; Provide some visual space between the startup output and the
;; server starting ;; server starting