Tweak gc logging

This commit is contained in:
Christopher Baines 2025-07-08 07:24:41 +01:00
parent 8eb5c047b9
commit 401f916517

View file

@ -3406,10 +3406,46 @@ SKIP LOCKED")
;; instances have the data updated.
(fix-derivation-output-details-hash-encoding conn)
(add-hook! after-gc-hook
(lambda ()
(simple-format (current-error-port)
"after gc\n")))
(spawn-fiber
(lambda ()
(let loop ((last-gc-times
(or (assq-ref (gc-stats) 'times) 0))
(last-gc-time-taken
(assq-ref (gc-stats) 'gc-time-taken)))
(let* ((stats (gc-stats))
(gc-times (or (assq-ref stats 'gc-times) 0))
(gc-time-taken (assq-ref stats 'gc-time-taken)))
(when (> gc-times last-gc-times)
(let ((gc-time-taken
(assq-ref stats 'gc-time-taken))
(time-since-last
(/ (- gc-time-taken
last-gc-time-taken)
internal-time-units-per-second))
(gcs
(- gc-times
last-gc-times)))
(format (current-error-port)
"~d gc's (time taken: ~f, heap-allocated-since-gc: ~a MiB, heap size: ~a MiB, heap free: ~a MiB)\n"
gcs
(/ time-since-last
gcs)
(/ (assq-ref stats 'heap-allocated-since-gc)
(expt 2. 20))
(/ (assq-ref stats 'heap-size)
(expt 2. 20))
(/ (assq-ref stats 'heap-free-size)
(expt 2. 20)))))
(when
(perform-operation
(choice-operation
(wrap-operation (get-operation finished-channel)
(const #f))
(wrap-operation (sleep-operation 3)
(const #t))))
(loop gc-times
gc-time-taken))))))
(with-exception-handler
(lambda (exn)
@ -3432,27 +3468,6 @@ SKIP LOCKED")
(with-postgresql-transaction
conn
(lambda (conn)
(spawn-fiber
(lambda ()
(while (perform-operation
(choice-operation
(wrap-operation (get-operation finished-channel)
(const #f))
(wrap-operation (sleep-operation 20)
(const #t))))
(let ((stats (gc-stats)))
(simple-format
(current-error-port)
"process-job 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))))))))
(match (select-job-for-update conn id)
(((id commit source git-repository-id))