diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-01-29 12:17:20 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-29 18:06:47 +0100 |
| commit | 23fecf8f3d2469a3de4f7ffae16224b0d21cc265 (patch) | |
| tree | ea97ae0bcebbca263ceb08e8c85b810d122b80fb | |
| parent | fcd1bc13bce741a96a315ed0b0d06dc8e88519f9 (diff) | |
| download | cuirass-23fecf8f3d2469a3de4f7ffae16224b0d21cc265.tar cuirass-23fecf8f3d2469a3de4f7ffae16224b0d21cc265.tar.gz | |
cuirass: Log resource usage statistics regularly.
* src/cuirass/logging.scm (log-monitoring-stats): New procedure.
* bin/cuirass.in (main): Add a fiber that calls it regularly.
| -rw-r--r-- | bin/cuirass.in | 8 | ||||
| -rw-r--r-- | src/cuirass/logging.scm | 15 |
2 files changed, 22 insertions, 1 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index 580c2be..5c11ff0 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -142,6 +142,14 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (run-cuirass-server db #:host host #:port port)))) #:parallel? #t) + (spawn-fiber + (essential-task + 'monitor exit-channel + (lambda () + (while #t + (log-monitoring-stats) + (sleep 600))))) + (primitive-exit (get-message exit-channel)))))) ;; Most of our code is I/O so preemption doesn't matter much (it diff --git a/src/cuirass/logging.scm b/src/cuirass/logging.scm index 9574b23..12d156c 100644 --- a/src/cuirass/logging.scm +++ b/src/cuirass/logging.scm @@ -19,10 +19,13 @@ (define-module (cuirass logging) #:use-module (srfi srfi-19) #:use-module (ice-9 format) + #:use-module (ice-9 threads) + #:use-module (ice-9 ftw) #:export (current-logging-port current-logging-procedure log-message - with-time-logging)) + with-time-logging + log-monitoring-stats)) (define current-logging-port (make-parameter (current-error-port))) @@ -61,3 +64,13 @@ (define-syntax-rule (with-time-logging name exp ...) "Log under NAME the time taken to evaluate EXP." (call-with-time-logging name (lambda () exp ...))) + +(define (log-monitoring-stats) + "Log info about useful metrics: heap size, number of threads, etc." + (log-message "heap: ~,2f MiB; threads: ~a; file descriptors: ~a" + (/ (assoc-ref (gc-stats) 'heap-size) (expt 2. 20)) + (length (all-threads)) + (length + (scandir "/proc/self/fd" + (lambda (file) + (not (member file '("." "..")))))))) |