[no subject]

[Ludovic Courtès]

branch: master
commit 23fecf8f3d2469a3de4f7ffae16224b0d21cc265
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jan 29 12:17:20 2018 +0100

    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.
---
 bin/cuirass.in          |  8 ++++++++
 src/cuirass/logging.scm | 15 ++++++++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

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:address@hidden@} --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 '("." ".."))))))))