summary refs log tree commit diff
path: root/gnu/system.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm18
1 files changed, 16 insertions, 2 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index 0489b9720d..01be1243fe 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -72,6 +72,7 @@
             operating-system-bootloader
             operating-system-services
             operating-system-essential-services
+            operating-system-default-essential-services
             operating-system-user-services
             operating-system-packages
             operating-system-host-name
@@ -108,6 +109,7 @@
             operating-system-boot-script
 
             system-linux-image-file-name
+            operating-system-with-gc-roots
 
             boot-parameters
             boot-parameters?
@@ -213,7 +215,8 @@
 
   (essential-services operating-system-essential-services ; list of services
                       (thunked)
-                      (default (essential-services this-operating-system)))
+                      (default (operating-system-default-essential-services
+                                this-operating-system)))
   (services operating-system-user-services        ; list of services
             (default %base-services))
 
@@ -463,7 +466,7 @@ value of the SYSTEM-SERVICE-TYPE service."
                 ("initrd" ,initrd)
                 ("locale" ,locale))))))   ;used by libc
 
-(define* (essential-services os)
+(define (operating-system-default-essential-services os)
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
 bookkeeping."
@@ -517,6 +520,17 @@ bookkeeping."
    (append (operating-system-user-services os)
            (operating-system-essential-services os))))
 
+(define (operating-system-with-gc-roots os roots)
+  "Return a variant of OS where ROOTS are registered as GC roots."
+  (operating-system
+    (inherit os)
+
+    ;; We use this procedure for the installation OS, which already defines GC
+    ;; roots.  Add ROOTS to those.
+    (services (cons (simple-service 'extra-root
+                                    gc-root-service-type roots)
+                    (operating-system-user-services os)))))
+
 
 ;;;
 ;;; /etc.