ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pull: Limit memory usage when compiling.

Browse source 
Reported by Arne Babenhauserheide <arne.babenhauserheide@kit.edu>.

* guix/scripts/pull.scm (unpack)[builder](compile-file*): Change to run
  'compile-file' in a child process.  This limits memory usage; before
  that memory usage was proportional to the number of files to compile.
This commit is contained in:
Ludovic Courtès 2013-12-14 00:40:15 +01:00
parent 98a046cd25
commit 0c2e1dd45d
1 changed files with 21 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
guix/scripts/pull.scm
View file

@ -60,38 +60,28 @@ (define builder
(tarball (assoc-ref %build-inputs "tarball"))) (tarball (assoc-ref %build-inputs "tarball")))
(define* (compile-file* file #:key output-file (opts '())) (define* (compile-file* file #:key output-file (opts '()))
;; Like 'compile-file', but remove any (guix …) and (gnu …) modules ;; Like 'compile-file', but in a separate process, to work around
;; created during the process as an ugly workaround for
;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness, ;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness,
;; but is overly conservative and very slow. ;; but is overly conservative and very slow. The solution
;; initially implemented (and described in the bug above) was
(define (module-directory+file module) ;; slightly faster but consumed memory proportional to the number
;; Return the directory for MODULE, like the 'dir-hint' in ;; of modules, which quickly became unacceptable.
;; boot-9.scm. (match (primitive-fork)
(match (module-name module) (0
((beginning ... last) (catch #t
(values (string-concatenate (lambda ()
(map (lambda (elt) (compile-file file
(string-append (symbol->string elt) #:output-file output-file
file-name-separator-string)) #:opts opts)
beginning)) (primitive-exit 0))
(symbol->string last))))) (lambda (key . args)
(print-exception (current-error-port) #f key args)
(define (clear-module-tree! root) (primitive-exit 1))))
;; Delete all the modules under ROOT. (pid
(hash-for-each (lambda (name module) (match (waitpid pid)
(module-remove! root name) ((_ . status)
(let-values (((dir name) (unless (zero? (status:exit-val status))
(module-directory+file module))) (error "failed to compile file" file status)))))))
(set-autoloaded! dir name #f))
(clear-module-tree! module))
(module-submodules root))
(hash-clear! (module-submodules root)))
(compile-file file #:output-file output-file #:opts opts)
(for-each (compose clear-module-tree! resolve-module)
'((guix) (gnu))))
(setenv "PATH" (string-append tar "/bin:" gzip "/bin")) (setenv "PATH" (string-append tar "/bin:" gzip "/bin"))