profiling: Add a "gc" profiling component.

* guix/profiling.scm (show-gc-stats): New procedure.
<top level>: Call 'register-profiling-hook!'.
This commit is contained in:
Ludovic Courtès 2019-01-11 14:56:40 +01:00
parent eac7ed195b
commit 461d6c2eff
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,6 +18,7 @@
(define-module (guix profiling)
#:use-module (ice-9 match)
#:autoload (ice-9 format) (format)
#:export (profiled?
register-profiling-hook!))
@ -50,3 +51,25 @@ (define (register-profiling-hook! component thunk)
(for-each (lambda (hook)
(add-hook! hook thunk))
%profiling-hooks)))
(define (show-gc-stats)
"Display garbage collection statistics."
(define MiB (* 1024 1024.))
(define stats (gc-stats))
(format (current-error-port) "Garbage collection statistics:
heap size: ~,2f MiB
allocated: ~,2f MiB
GC times: ~a
time spent in GC: ~,2f seconds (~d% of user time)~%"
(/ (assq-ref stats 'heap-size) MiB)
(/ (assq-ref stats 'heap-total-allocated) MiB)
(assq-ref stats 'gc-times)
(/ (assq-ref stats 'gc-time-taken)
internal-time-units-per-second 1.)
(inexact->exact
(round (* (/ (assq-ref stats 'gc-time-taken)
(tms:utime (times)) 1.)
100)))))
(register-profiling-hook! "gc" show-gc-stats)