| ︙ | | |
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
|
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
|
+
+
+
|
;; posix-extras
chicken.base
chicken.condition
chicken.file
chicken.file.posix
chicken.io
chicken.pathname
chicken.port
chicken.process
chicken.process-context
chicken.process-context.posix
chicken.sort
chicken.string
chicken.time
chicken.time.posix
matchable
md5
message-digest
pathname-expand
regex
regex-case
srfi-1
srfi-18
srfi-69
typed-records
system-information
debugprint
)))
;;======================================================================
;; CONTENTS
;;
;; config file utils
;; misc conversion, data manipulation functions
|
| ︙ | | |
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
|
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
|
-
-
-
+
+
+
+
+
+
|
(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 (commonmod:get-cpu-load)
(let* ((load-info (with-input-from-file "/proc/loadavg" read-lines))
(res (map string->number (string-split (car load-info)))))
(if (null? res)
#f ;; something is wrong
(car res))))
(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))
|
| ︙ | | |
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
-
+
|
(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)))
(/ (commonmod:get-cpu-load)(get-current-host-cores)))
;;======================================================================
;; testsuite and area utilites
;;======================================================================
(define (get-testsuite-name toppath configdat)
(or (lookup configdat "setup" "area-name")
|
| ︙ | | |
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
|
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
|
-
-
+
+
+
-
-
|
((m) 60) ;; minutes
((h) 3600)
((d) 86400)
((w) 604800)
((M) 2628000) ;; aproximately one month
((y) 31536000)
(else
0)))))))
;; (print "ERROR: can't parse timestring "tstr", component "part)
0)))))
(debug:print 0 *default-log-port* "ERROR: can't parse timestring "tstr", component "part", string: "(cadr match))))
(debug:print 0 *default-log-port* "ERROR: can't parse timestring "tstr", component "part))))
;; can't (yet) use debugprint. rely on -show-config for user to find errors
)))
|
| ︙ | | |