295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
(if convert (lazy-convert inval) inval))))
(else f))))
(filter (lambda (x)
(not (string-match "^\\s*" x)))
val-list))
'())))
(define (get-cpu-load)
(let* ((load-info (with-input-from-file "/proc/loadavg" read-lines)))
(map string->number (string-split load-info))))
(define *current-host-cores* #f)
(define (get-current-host-cores)
(or *current-host-cores*
(let ((cpu-info (with-input-from-file "/proc/cpuinfo" read-lines)))
(let loop ((lines cpu-info))
|
|
|
|
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
(if convert (lazy-convert inval) inval))))
(else f))))
(filter (lambda (x)
(not (string-match "^\\s*" x)))
val-list))
'())))
(define (commonmod:get-cpu-load)
(let* ((load-info (with-input-from-file "/proc/loadavg" read-lines)))
(map string->number (string-split (car load-info)))))
(define *current-host-cores* #f)
(define (get-current-host-cores)
(or *current-host-cores*
(let ((cpu-info (with-input-from-file "/proc/cpuinfo" read-lines)))
(let loop ((lines cpu-info))
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(conc "ps -def | egrep \""processname"\" |wc -l")
(lambda ()
(string->number (read-line)))))
;; get the normalized (i.e. load / numcpus) for *this* host
;;
(define (get-normalized-cpu-load)
(/ (get-cpu-load)(get-current-host-cores)))
;;======================================================================
;; testsuite and area utilites
;;======================================================================
(define (get-testsuite-name toppath configdat)
(or (lookup configdat "setup" "area-name")
|
|
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
(conc "ps -def | egrep \""processname"\" |wc -l")
(lambda ()
(string->number (read-line)))))
;; get the normalized (i.e. load / numcpus) for *this* host
;;
(define (get-normalized-cpu-load)
(/ (commonmod:get-cpu-load)(get-current-host-cores)))
;;======================================================================
;; testsuite and area utilites
;;======================================================================
(define (get-testsuite-name toppath configdat)
(or (lookup configdat "setup" "area-name")
|