From 03870da81922ccb6cc1a91976487f2d3f7da0d81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 28 Jun 2017 10:13:45 +0200 Subject: Add (guix profiling). * guix/profiling.scm: New file. * Makefile.am (MODULES): Add it. * guix/store.scm (record-operation): Use 'profiled?' and 'register-profiling-hook!'. --- guix/profiling.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 guix/profiling.scm (limited to 'guix/profiling.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 +;;; +;;; 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 . + +(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))) -- cgit v1.2.3