2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
|
(first (car loadavg))
(next (cadr loadavg))
(adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
;; numcpus (or could be
;; maxload) is zero,
;; crude fallback is to
;; at least use 1
(loadjmp (- first next))
;; add some randomness to the time to break any alignment
;; where netbatch dumps many jobs to machines simultaneously
(adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)
(/ (- 1000 count) 10)
waitdelay)
(- first adjmaxload) )) )))
;; let's let the user know once in a long while that load checking
;; is happening but not constantly report it
(if (> (random 100) 75) ;; about 25% of the time
(debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
", load: " first ", adjmaxload: " adjmaxload ", loadjmp: " loadjmp))
(cond
((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
(> num-tries 0))
(debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load " first ", we'll sleep 10s and try " num-tries " more times.")
(thread-sleep! 10)
(common:wait-for-cpuload maxload-in numcpus-in waitdelay
count: count remote-host: remote-host force-maxload: force-maxload num-tries: (- num-tries 1)))
((and (> first adjmaxload)
(> count 0))
(debug:print-info 0 *default-log-port*
"server start delayed " adjwait
" seconds due to load " first
" exceeding max of " adjmaxload
" on server " (or remote-host (get-host-name))
" (normalized load-limit: " maxload ") " (if msg msg ""))
(thread-sleep! adjwait)
(common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
((and (> loadjmp numcpus)
(> count 0))
(debug:print-info 0 *default-log-port* "waiting " adjwait " seconds due to load jump " loadjmp " > numcpus " numcpus (if msg msg ""))
(thread-sleep! adjwait)
(common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
(else
(if (> num-tries 0)
(debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") " is acceptable at " first " continuing.")
(debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") ", "first" could not be retrieved. Giving up and continuing."))))))
(define (get-uname . params)
(let* ((uname-res (process:cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
(uname #f))
(if (null? (car uname-res))
"unknown"
|
|
>
>
|
|
|
>
>
>
|
>
>
|
|
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
|
(first (car loadavg))
(next (cadr loadavg))
(adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
;; numcpus (or could be
;; maxload) is zero,
;; crude fallback is to
;; at least use 1
(loadjmp (- first (if (> next (* numcpus 0.7))
0
next))) ;; we will force a conservative calculation any time next is large.
;; add some randomness to the time to break any alignment
;; where netbatch dumps many jobs to machines simultaneously
(adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)
(/ (- 1000 count) 10)
waitdelay)
(- first adjmaxload) )) )))
;; let's let the user know once in a long while that load checking
;; is happening but not constantly report it
(if (common:low-noise-print 30 (conc "cpuload" (or remote-host "localhost"))) ;; (> (random 100) 75) ;; about 25% of the time
(debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
", load: " first ", adjmaxload: " adjmaxload ", loadjmp: " loadjmp))
(cond
((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
(> num-tries 0))
(debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load " first ", we'll sleep 10s and try " num-tries " more times.")
(thread-sleep! 10)
(common:wait-for-cpuload maxload-in numcpus-in waitdelay
count: count remote-host: remote-host force-maxload: force-maxload num-tries: (- num-tries 1)))
((and (> first adjmaxload)
(> count 0))
(debug:print-info 0 *default-log-port*
"Delaying " adjwait
" seconds due to load " first
" exceeding max of " adjmaxload
" on server " (or remote-host (get-host-name))
" (normalized load-limit: " maxload ") " (if msg msg ""))
(thread-sleep! adjwait)
(common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
((and (> loadjmp (cond
((> numcpus 8)(/ numcpus 4))
((> numcpus 4)(/ numcpus 2))
(else 0.5)))
(> count 0))
(debug:print-info 0 *default-log-port* "waiting " adjwait " seconds due to load jump " loadjmp " > numcpus " numcpus
(if msg (conc " " msg) ""))
(thread-sleep! adjwait)
(common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
(else
(if (> num-tries 0)
(if (common:low-noise-print 30 (conc (round first) "-load-acceptable-" (or remote-host "localhost")))
(debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") " is acceptable at " first " continuing."))
(debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") ", "first" could not be retrieved. Giving up and continuing."))))))
(define (get-uname . params)
(let* ((uname-res (process:cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
(uname #f))
(if (null? (car uname-res))
"unknown"
|