From 05d5581ff71eb3b48773a5d46b612202de0492fb Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 22 Aug 2017 03:26:10 -0400
Subject: [PATCH] DRAFT: build: Compile scheme modules in batches.

---
 build-aux/compile-all.scm | 48 ++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 41 insertions(+), 7 deletions(-)

diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 147bb8019..96658e069 100644
--- a/build-aux/compile-all.scm
+++ b/build-aux/compile-all.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,7 @@
 
 (use-modules (system base target)
              (system base message)
+             (srfi srfi-1)
              (ice-9 match)
              (ice-9 threads)
              (guix build utils))
@@ -118,13 +120,45 @@
   ((_ . files)
    (let ((files (filter file-needs-compilation? files)))
      (for-each load-module-file files)
-     (let ((mutex (make-mutex)))
-       ;; Make sure compilation related modules are loaded before starting to
-       ;; compile files in parallel.
-       (compile #f)
-       (par-for-each (lambda (file)
-                       (compile-file* file mutex))
-                     files)))))
+     ;; Make sure compilation related modules are loaded before starting to
+     ;; compile files in parallel.
+     (compile #f)
+     ;; Flush all ports before entering the fork loop, to avoid flushing them
+     ;; more than once within the child processes created below.
+     (flush-all-ports)
+
+     ;; FIXME The following loop works around the apparent memory leak in the
+     ;; compiler of guile-2.2.2, where compiling scheme modules requires
+     ;; increasing amounts of memory, up to nearly 2 gigabytes when all guix
+     ;; sources are compiled within a single process.
+     ;;
+     ;; Ideally, we would simply apply 'par-for-each' to the entire set of
+     ;; files.  For now, to work around the memory leak, we spawn subprocesses
+     ;; to compile the files in batches of up to 20 files each.
+     (let fork-loop ((files files))
+       (unless (null? files)
+         (call-with-values (lambda ()
+                             (split-at files (min 20 (length files))))
+           (lambda (current-batch remaining-files)
+             ;; IMPORTANT: as noted in the Guile manual, it is unsafe to fork a
+             ;; process that has multiple threads running.  Here we avoid this
+             ;; difficulty by spawning threads only within the child processes,
+             ;; which never call fork.
+             (match (primitive-fork)
+               (0
+                ;; This is the child.  It spawns threads but never forks.
+                (let ((mutex (make-mutex)))
+                  (par-for-each (lambda (file)
+                                  (compile-file* file mutex))
+                                current-batch))
+                (primitive-exit))
+               (child-pid
+                ;; This is the parent.  It forks but never spawns threads.
+                (match (waitpid child-pid)
+                  ((_ . 0)
+                   (fork-loop remaining-files))
+                  ((_ . status)
+                   (primitive-exit (or (status:exit-val status) 1)))))))))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-target 'scheme-indent-function 1)
-- 
2.14.1