diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/profiling.scm | 52 | ||||
| -rw-r--r-- | guix/store.scm | 19 |
3 files changed, 62 insertions, 10 deletions
diff --git a/Makefile.am b/Makefile.am index ddbf7a7984..85b9ab36d2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -102,6 +102,7 @@ MODULES = \ guix/http-client.scm \ guix/gnupg.scm \ guix/elf.scm \ + guix/profiling.scm \ guix/store.scm \ guix/cvs-download.scm \ guix/svn-download.scm \ diff --git a/guix/profiling.scm b/guix/profiling.scm new file mode 100644 index 0000000000..753fc6c22e --- /dev/null +++ b/guix/profiling.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix profiling) + #:use-module (ice-9 match) + #:export (profiled? + register-profiling-hook!)) + +;;; Commentary: +;;; +;;; Basic support for Guix-specific profiling. +;;; +;;; Code: + +(define profiled? + (let ((profiled + (or (and=> (getenv "GUIX_PROFILING") string-tokenize) + '()))) + (lambda (component) + "Return true if COMPONENT profiling is active." + (member component profiled)))) + +(define %profiling-hooks + ;; List of profiling hooks. + (map (match-lambda + ("after-gc" after-gc-hook) + ((or "exit" #f) exit-hook)) + (or (and=> (getenv "GUIX_PROFILING_EVENTS") string-tokenize) + '("exit")))) + +(define (register-profiling-hook! component thunk) + "Register THUNK as a profiling hook for COMPONENT, a string such as +\"rpc\"." + (when (profiled? component) + (for-each (lambda (hook) + (add-hook! hook thunk)) + %profiling-hooks))) diff --git a/guix/store.scm b/guix/store.scm index f336df85cc..e6e45ba89c 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -25,6 +25,7 @@ #:use-module (guix base16) #:use-module (guix base32) #:use-module (guix hash) + #:use-module (guix profiling) #:autoload (guix build syscalls) (terminal-columns) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) @@ -794,16 +795,14 @@ bytevector) as its internal buffer, and a thunk to flush this output port." (define record-operation ;; Optionally, increment the number of calls of the given RPC. - (let ((profiled (or (and=> (getenv "GUIX_PROFILING") string-tokenize) - '()))) - (if (member "rpc" profiled) - (begin - (add-hook! exit-hook show-rpc-profile) - (lambda (name) - (let ((count (or (hashq-ref %rpc-calls name) 0))) - (hashq-set! %rpc-calls name (+ count 1))))) - (lambda (_) - #t)))) + (if (profiled? "rpc") + (begin + (register-profiling-hook! "rpc" show-rpc-profile) + (lambda (name) + (let ((count (or (hashq-ref %rpc-calls name) 0))) + (hashq-set! %rpc-calls name (+ count 1))))) + (lambda (_) + #t))) (define-syntax operation (syntax-rules () |