Commit | Line | Data |
---|---|---|
03870da8 | 1 | ;;; GNU Guix --- Functional package management for GNU |
461d6c2e | 2 | ;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org> |
03870da8 LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix profiling) | |
20 | #:use-module (ice-9 match) | |
461d6c2e | 21 | #:autoload (ice-9 format) (format) |
03870da8 LC |
22 | #:export (profiled? |
23 | register-profiling-hook!)) | |
24 | ||
25 | ;;; Commentary: | |
26 | ;;; | |
27 | ;;; Basic support for Guix-specific profiling. | |
28 | ;;; | |
29 | ;;; Code: | |
30 | ||
31 | (define profiled? | |
32 | (let ((profiled | |
33 | (or (and=> (getenv "GUIX_PROFILING") string-tokenize) | |
34 | '()))) | |
35 | (lambda (component) | |
36 | "Return true if COMPONENT profiling is active." | |
37 | (member component profiled)))) | |
38 | ||
39 | (define %profiling-hooks | |
40 | ;; List of profiling hooks. | |
41 | (map (match-lambda | |
42 | ("after-gc" after-gc-hook) | |
43 | ((or "exit" #f) exit-hook)) | |
44 | (or (and=> (getenv "GUIX_PROFILING_EVENTS") string-tokenize) | |
45 | '("exit")))) | |
46 | ||
47 | (define (register-profiling-hook! component thunk) | |
48 | "Register THUNK as a profiling hook for COMPONENT, a string such as | |
49 | \"rpc\"." | |
50 | (when (profiled? component) | |
51 | (for-each (lambda (hook) | |
52 | (add-hook! hook thunk)) | |
53 | %profiling-hooks))) | |
461d6c2e LC |
54 | |
55 | (define (show-gc-stats) | |
56 | "Display garbage collection statistics." | |
57 | (define MiB (* 1024 1024.)) | |
58 | (define stats (gc-stats)) | |
59 | ||
60 | (format (current-error-port) "Garbage collection statistics: | |
61 | heap size: ~,2f MiB | |
62 | allocated: ~,2f MiB | |
63 | GC times: ~a | |
64 | time spent in GC: ~,2f seconds (~d% of user time)~%" | |
65 | (/ (assq-ref stats 'heap-size) MiB) | |
66 | (/ (assq-ref stats 'heap-total-allocated) MiB) | |
67 | (assq-ref stats 'gc-times) | |
68 | (/ (assq-ref stats 'gc-time-taken) | |
69 | internal-time-units-per-second 1.) | |
70 | (inexact->exact | |
71 | (round (* (/ (assq-ref stats 'gc-time-taken) | |
72 | (tms:utime (times)) 1.) | |
73 | 100))))) | |
74 | ||
75 | (register-profiling-hook! "gc" show-gc-stats) |