[PATCH 3/4] guix: Add schedule module.

[PATCH 3/4] guix: Add schedule module.

[Deck Pickard]

[-- Attachment #1: Type: text/plain, Size: 4161 bytes --]

* guix/schedule.scm: New file. To handle --cores and --max-jobs
options in 'guix build'.
* Makefile.am (MODULES): Add *this.
---
Makefile.am | 1 +
guix/schedule.scm | 102
++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 103 insertions(+)
create mode 100644 guix/schedule.scm

diff --git a/Makefile.am b/Makefile.am
index 5c4ce90..1806a05 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -56,6 +56,7 @@ MODULES = \
guix/ftp-client.scm \
guix/http-client.scm \
guix/gnupg.scm \
+ guix/schedule.scm \
guix/store.scm \
guix/svn-download.scm \
guix/ui.scm \
diff --git a/guix/schedule.scm b/guix/schedule.scm
new file mode 100644
index 0000000..26c7b6b
--- /dev/null
+++ b/guix/schedule.scm
@@ -0,0 +1,102 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Nebulieu <nebu@kipple>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix schedule)
+ #:use-module (guix records)
+ #:export (schedule?
+ schedule
+ schedule-name
+ schedule-max-cores
+ schedule-max-jobs
+ schedule-override-cores?
+ schedule-override-jobs?
+
+ make-schedule-sane))
+
+(define-record-type* <schedule>
+ schedule make-schedule
+ schedule?
+ (name schedule-name ; symbol
+ (default 'serial))
+ (max-cores schedule-max-cores ; non-negative integer
+ (default 0)) ; use all available horse-power
+ (max-jobs schedule-max-jobs ; non-negative integer
+ (default 1)) ; there can be only one
+ ;; unused, for now, rethink "unified" override
+ (override-cores? schedule-override-cores? ; boolean
+ (default #t))
+ (override-jobs? schedule-override-jobs? ; boolean
+ (default #t)))
+
+; will rather need one `make-schedule-with-name` and switch on 'symbol
+(define (make-schedule-serial)
+ (schedule))
+; redundant for now...
+
+; macro?
+(define (real-schedule symname cores jobs
+ override-c override-j)
+ (schedule
+ (name symname)
+ (max-cores cores)
+ (max-jobs jobs)
+ (override-cores? override-c)
+ (override-jobs? override-j)))
+
+; better name?
+(define (>1 num)
+ (if (< num 1)
+ 1
+ num))
+
+;; TODO: increase number of jobs with spare cores??? perhaps in
real-schedule
+(define* (make-schedule-sane #:key max-cores max-jobs)
+ (let ((sym-name 'serial-sane)
+ ;; should overriding one override both (think: yes, e.g.
+ ;; setting cores to max with guix-daemon default [max-jobs = 0]
+ ;; will again lead to the N^2 phenomenon...
+ (override-cores (and max-cores #t))
+ (override-jobs (and max-jobs #t))
+ ;; scheduling needs be centralized (think: override always)
+ (max-threads (min (current-processor-count)
+ (total-processor-count))))
+ (let ((default-max-cores (>1 (- max-threads 1)))
+ (default-max-jobs 1)
+ (validate (lambda (arg default)
+ (if (or (not arg)
+ (not (integer? arg)))
+ default
+ (or (and (= arg 0) max-threads)
+ (and (< arg 0) default)
+ arg)))))
+ ;; perhaps we shouldn't be so symmetrical?
+ (let ((cores (validate max-cores default-max-cores))
+ (jobs (validate max-jobs default-max-jobs)))
+ ;; cut-off
+ (let loop ((c (min cores max-threads))
+ (j (min jobs max-threads)))
+ (let ((threads (* c j)))
+ (if (<= threads max-threads)
+ (real-schedule sym-name c j
+ override-cores override-jobs)
+ ;; maximize cores at the cost of jobs...
+ (let ((j- (>1 (- j 1))))
+ (if (<= (* c j-) max-threads)
+ (real-schedule sym-name c j-
+ override-cores override-jobs)
+ (loop (>1 (- c 1)) j-))))))))))
-- 
2.1.2

[-- Attachment #2: Type: text/html, Size: 4823 bytes --]