1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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-))))))))))
|