From 63b0ce391f6ea79012fac893e933e39d7a16abbd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 6 Oct 2019 12:51:33 +0200
Subject: services: shepherd: Compile service files.

This reduces resident memory for PID 1 from 29.8MiB to 28.7MiB right
after boot on a bare-bones system (x86_64-linux).

* gnu/services/shepherd.scm (scm->go): New procedure.
(shepherd-configuration-file)[config]: Call it and use 'load-compiled'
instead of 'primitive-load'.
---
 gnu/services/shepherd.scm | 77 +++++++++++++++++++++++++++++------------------
 1 file changed, 47 insertions(+), 30 deletions(-)

diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 45c67e04eb..08bb33039c 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -255,6 +255,22 @@ stored."
                                    #~(#$name #$doc #$proc)))
                                 (shepherd-service-actions service))))))))
 
+(define (scm->go file)
+  "Compile FILE, which contains code to be loaded by shepherd's config file,
+and return the resulting '.go' file."
+  (with-extensions (list shepherd)
+    (computed-file (string-append (basename (scheme-file-name file) ".scm")
+                                  ".go")
+                   #~(begin
+                       (use-modules (system base compile))
+
+                       ;; Do the same as the Shepherd's 'load-in-user-module'.
+                       (let ((env (make-fresh-user-module)))
+                         (module-use! env (resolve-interface '(oop goops)))
+                         (module-use! env (resolve-interface '(shepherd service)))
+                         (compile-file #$file #:output-file #$output
+                                       #:env env))))))
+
 (define (shepherd-configuration-file services)
   "Return the shepherd configuration file for SERVICES."
   (assert-valid-graph services)
@@ -269,36 +285,37 @@ stored."
           ;; than a kernel panic.
           (call-with-error-handling
             (lambda ()
-              (apply register-services (map primitive-load '#$files))
-
-              ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around
-              ;; it.
-              (setenv "PATH" "/run/current-system/profile/bin")
-
-              (format #t "starting services...~%")
-              (for-each (lambda (service)
-                          ;; In the Shepherd 0.3 the 'start' method can raise
-                          ;; '&action-runtime-error' if it fails, so protect
-                          ;; against it.  (XXX: 'action-runtime-error?' is not
-                          ;; exported is 0.3, hence 'service-error?'.)
-                          (guard (c ((service-error? c)
-                                     (format (current-error-port)
-                                             "failed to start service '~a'~%"
-                                             service)))
-                            (start service)))
-                        '#$(append-map shepherd-service-provision
-                                       (filter shepherd-service-auto-start?
-                                               services)))
-
-              ;; Hang up stdin.  At this point, we assume that 'start' methods
-              ;; that required user interaction on the console (e.g.,
-              ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
-              ;; completed.  User interaction becomes impossible after this
-              ;; call; this avoids situations where services wrongfully lead
-              ;; PID 1 to read from stdin (the console), which users may not
-              ;; have access to (see <https://bugs.gnu.org/23697>).
-              (redirect-port (open-input-file "/dev/null")
-                             (current-input-port))))))
+              (apply register-services
+                     (map load-compiled '#$(map scm->go files)))))
+
+          ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around
+          ;; it.
+          (setenv "PATH" "/run/current-system/profile/bin")
+
+          (format #t "starting services...~%")
+          (for-each (lambda (service)
+                      ;; In the Shepherd 0.3 the 'start' method can raise
+                      ;; '&action-runtime-error' if it fails, so protect
+                      ;; against it.  (XXX: 'action-runtime-error?' is not
+                      ;; exported is 0.3, hence 'service-error?'.)
+                      (guard (c ((service-error? c)
+                                 (format (current-error-port)
+                                         "failed to start service '~a'~%"
+                                         service)))
+                        (start service)))
+                    '#$(append-map shepherd-service-provision
+                                   (filter shepherd-service-auto-start?
+                                           services)))
+
+          ;; Hang up stdin.  At this point, we assume that 'start' methods
+          ;; that required user interaction on the console (e.g.,
+          ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
+          ;; completed.  User interaction becomes impossible after this
+          ;; call; this avoids situations where services wrongfully lead
+          ;; PID 1 to read from stdin (the console), which users may not
+          ;; have access to (see <https://bugs.gnu.org/23697>).
+          (redirect-port (open-input-file "/dev/null")
+                         (current-input-port))))
 
     (scheme-file "shepherd.conf" config)))
 
-- 
cgit v1.2.3