Overview
| Comment: | several tries later ... |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
7308f2111fcaed7ab9f2870af601d546 |
| User & Date: | mrwellan on 2020-08-11 23:26:34 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-08-12
| ||
| 00:40 | Deficit based runner control check-in: 161115127c user: matt tags: v1.65 | |
|
2020-08-11
| ||
| 23:26 | several tries later ... check-in: 7308f2111f user: mrwellan tags: v1.65 | |
| 00:37 | Initial attempt at runner throttle. NOT WORKING QUITE RIGHT check-in: 5c5398b2f2 user: mrwellan tags: v1.65 | |
Changes
Modified api.scm from [70cdbd0f27] to [873dee2312].
| ︙ | ︙ | |||
213 214 215 216 217 218 219 220 221 222 223 224 225 226 |
((lock/unlock-run) (apply db:lock/unlock-run dbstruct params))
((update-run-event_time) (apply db:update-run-event_time dbstruct params))
((update-run-stats) (apply db:update-run-stats dbstruct params))
((set-var) (apply db:set-var dbstruct params))
((inc-var) (apply db:inc-var dbstruct params))
((dec-var) (apply db:dec-var dbstruct params))
((del-var) (apply db:del-var dbstruct params))
;; STEPS
((teststep-set-status!) (apply db:teststep-set-status! dbstruct params))
((delete-steps-for-test!) (apply db:delete-steps-for-test! dbstruct params))
;; TEST DATA
((test-data-rollup) (apply db:test-data-rollup dbstruct params))
| > | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 |
((lock/unlock-run) (apply db:lock/unlock-run dbstruct params))
((update-run-event_time) (apply db:update-run-event_time dbstruct params))
((update-run-stats) (apply db:update-run-stats dbstruct params))
((set-var) (apply db:set-var dbstruct params))
((inc-var) (apply db:inc-var dbstruct params))
((dec-var) (apply db:dec-var dbstruct params))
((del-var) (apply db:del-var dbstruct params))
((add-var) (apply db:add-var dbstruct params))
;; STEPS
((teststep-set-status!) (apply db:teststep-set-status! dbstruct params))
((delete-steps-for-test!) (apply db:delete-steps-for-test! dbstruct params))
;; TEST DATA
((test-data-rollup) (apply db:test-data-rollup dbstruct params))
|
| ︙ | ︙ |
Modified db.scm from [b0064c2033] to [05d7378293].
| ︙ | ︙ | |||
1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 | ;; (set! *last-global-delta-printed* *global-delta*))) (define (db:set-var dbstruct var val) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))) (define (db:del-var dbstruct var) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var)))) ;;====================================================================== ;; no-sync.db - small bits of data to be shared between servers | > > > > > | 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 | ;; (set! *last-global-delta-printed* *global-delta*))) (define (db:set-var dbstruct var val) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))) (define (db:add-var dbstruct var val) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "UPDATE metadat SET val=val+? WHERE var=?;" val var)))) (define (db:del-var dbstruct var) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var)))) ;;====================================================================== ;; no-sync.db - small bits of data to be shared between servers |
| ︙ | ︙ |
Modified rmt.scm from [c90382995e] to [db44f9a638].
| ︙ | ︙ | |||
814 815 816 817 818 819 820 821 822 823 824 825 826 827 | (define (rmt:inc-var varname) (rmt:send-receive 'inc-var #f (list varname))) (define (rmt:dec-var varname) (rmt:send-receive 'dec-var #f (list varname))) ;;====================================================================== ;; M U L T I R U N Q U E R I E S ;;====================================================================== ;; Need to move this to multi-run section and make associated changes (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f)) (let ((run-ids (rmt:get-all-run-ids))) | > > > | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 | (define (rmt:inc-var varname) (rmt:send-receive 'inc-var #f (list varname))) (define (rmt:dec-var varname) (rmt:send-receive 'dec-var #f (list varname))) (define (rmt:add-var varname value) (rmt:send-receive 'add-var #f (list varname value))) ;;====================================================================== ;; M U L T I R U N Q U E R I E S ;;====================================================================== ;; Need to move this to multi-run section and make associated changes (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f)) (let ((run-ids (rmt:get-all-run-ids))) |
| ︙ | ︙ |
Modified runs.scm from [d0362390bc] to [81d0b26380].
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | test-patts required-tests test-registry registry-mutex flags keyvals run-info all-tests-registry can-run-more-tests ((can-run-more-tests-count 0) : fixnum) (last-runners-check 0) ;; time when we last checked number of runners (last-runners-count #f) ;; (runner-registered #f) ;; have I registered myself? | | > | > | > | > | | > | | | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
test-patts required-tests test-registry
registry-mutex flags keyvals run-info all-tests-registry
can-run-more-tests
((can-run-more-tests-count 0) : fixnum)
(last-runners-check 0) ;; time when we last checked number of runners
(last-runners-count #f) ;;
(runner-registered #f) ;; have I registered myself?
(run-skip-count 0) ;; how many times have I skipped running sequentially
(runners-mgmt-mode 'rest-mode)
)
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
(define (runs:print-parallel-runners-state state num-registered last-registered skip-count)
(debug:print-info 0 *default-log-port* "runs:parallel-runners-mgmt, state=" state
", num-registered=" num-registered ", last-registered=" last-registered
", skip-count=" skip-count))
(define (runs:print-parallel-runners-state2 state num-registered last-runners-count skip-count)
(debug:print-info 0 *default-log-port* "runs:parallel-runners-mgmt, state=" state
", num-registered=" num-registered ", last-runners-count=" last-runners-count
", skip-count=" skip-count))
;; Second try
;;
(define (runs:parallel-runners-mgmt-2 rdat)
(let ((time-to-check 2.8) ;; 28
(time-to-wait 3.0))
(if (> (- (current-seconds) (runs:dat-last-runners-check rdat)) time-to-check) ;; time to check
(let* ((num-registered (or (rmt:get-var "num-runners") 0))
(last-runners-count (runs:dat-last-runners-count rdat))
(skip-count (runs:dat-run-skip-count rdat)))
(cond
;; first time in
((not last-runners-count)
(runs:print-parallel-runners-state2 "A" num-registered last-runners-count skip-count)
(if (eq? num-registered 0)
(rmt:set-var "num-runners" 1)
(rmt:inc-var "num-runners"))
(runs:dat-last-runners-count-set! rdat num-registered)
(runs:dat-run-skip-count-set! rdat 0))
;; too many waits, decrement num-runners, reset last-runners and continue on
((> (runs:dat-run-skip-count rdat) 3)
(runs:print-parallel-runners-state2 "B" num-registered last-runners-count skip-count)
(rmt:dec-var "num-runners")
(runs:dat-run-skip-count-set! rdat 0)
(runs:dat-last-runners-count-set! rdat num-registered))
;; too many running, take a break
((> num-registered last-runners-count) ;; (+ last-runners-count 1))
(runs:print-parallel-runners-state2 "C" num-registered last-runners-count skip-count)
(rmt:dec-var "num-runners")
(debug:print-info 0 *default-log-port*
"Too many running (" num-registered
"), last-count=" last-runners-count " waiting " time-to-wait " seconds ... ")
(thread-sleep! time-to-wait)
(runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1))
;; adjust down last-runners-count
(if (< num-registered last-runners-count)
(runs:dat-last-runners-set! rdat num-running))
(rmt:inc-var "num-runners")
)
;; we have been in waiting mode, do not increment again as we already did that
((> skip-count 0)
(runs:print-parallel-runners-state2 "D" num-registered last-runners-count skip-count)
(runs:dat-run-skip-count-set! rdat 0)
;; (runs:dat-last-runners-count-set! rdat num-registered)
)
;; skip count is zero, not too many running, this is transition into running
(else
(runs:print-parallel-runners-state2 "E" num-registered last-runners-count skip-count)
;; (rmt:inc-var "num-runners")
#;(runs:dat-run-skip-count-set! rdat 0)))))))
;; Third try, use a running average
;;
;; ADD A COUNT OF TIMES CYCLED THROUGH REST MODE
;;
;; runners-mgmt-mode
;;
(define (runs:parallel-runners-mgmt-3 rdat)
(let ((time-to-check 2.8) ;; 28
(time-to-wait 3.0))
(if (> (- (current-seconds) (runs:dat-last-runners-check rdat)) time-to-check) ;; time to check
(let* ((skip-count (runs:dat-run-skip-count rdat))
(mgmt-mode (runs:dat-runners-mgmt-mode rdat)) ;;
(num-registered (rmt:get-var "num-runners"))
(last-runners-count (if (runs:dat-last-runners-count rdat)
(runs:dat-last-runners-count rdat)
(or num-registered 1)))
(last-runners-ravg (/ (+ last-runners-count num-registered) 2)#;(if (> num-registered last-runners-count)
(/ (+ last-runners-count num-registered) 2)
(/ (+ (* num-registered 4) last-runners-count) 5) ;; slow on down
)) ;; running average
)
;; initialize and sanitize values if needed
(cond
((not num-registered) ;; first in, initialize to 1
(debug:print-info 0 *default-log-port* " adjusting num-runners up to 1, currently it is not defined")
(rmt:set-var "num-runners" 1))
((< num-registered 1) ;; this should not be, reset to 1 to make it less confusing
(debug:print-info 0 *default-log-port* " adjusting num-runners up to 1, currently it is " num-registered)
(rmt:set-var "num-runners" 1)))
(if (not (member mgmt-mode '(rest-mode work-mode)))
(begin
(debug:print-info 0 *default-log-port* " setting mgmt-mode to work-mode, currently it is " mgmt-mode)
(rmt:inc-var "num-runners")
(set! last-runners-ravg (+ last-runners-ravg 1))
(runs:dat-runners-mgmt-mode-set! rdat 'rest-mode)))
(runs:dat-last-runners-count-set! rdat last-runners-ravg)
;; to rest or not rest?
(if (and (< skip-count 5)
(> num-registered last-runners-count)) ;;(+ last-runners-ravg 0.5))) ;; there seem to be other runners out there
(begin ;; gonna rest
(debug:print-info 0 *default-log-port* "Too many running, num-registered=" num-registered ", ravg=" last-runners-ravg
", real num runners=" (rmt:get-var "num-runners") ", skip-count=" skip-count)
(if (eq? mgmt-mode 'work-mode)
(rmt:dec-var "num-runners"))
(runs:dat-runners-mgmt-mode-set! rdat 'rest-mode)
(runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1))
(thread-sleep! time-to-wait)
(runs:parallel-runners-mgmt-3 rdat)
)
(begin
(runs:dat-run-skip-count-set! rdat 0)
(if (eq? mgmt-mode 'rest-mode)
(rmt:inc-var "num-runners")) ;; going into work mode if not already in work mode
(runs:dat-runners-mgmt-mode-set! rdat 'work-mode)
(debug:print-info 0 *default-log-port* "All good, keep running, num-registered="
num-registered ", ravg=" last-runners-ravg ", mode=" mgmt-mode
", skip-count=" skip-count))
)))))
;; To test parallel-runners management start a repl:
;; megatest -repl
;; then run:
;; (runs:test-parallel-runners 60)
;;
(define (runs:test-parallel-runners duration #!optional (proc #f))
(let* ((rdat (make-runs:dat))
(rtime 0)
(startt (current-seconds))
(endt (+ startt duration)))
((or proc runs:parallel-runners-mgmt-3) rdat)
(let loop ()
(let* ((wstart (current-seconds)))
(if (< wstart endt)
(let* ((work-time (random 10)))
#;(debug:print-info 0 *default-log-port* "working for " work-time
" seconds. Total work: " rtime ", elapsed time: " (- wstart startt))
(thread-sleep! work-time)
(set! rtime (+ rtime work-time))
((or proc runs:parallel-runners-mgmt-3) rdat)
(loop)))))
(let* ((done-time (current-seconds)))
(debug:print-info 0 *default-log-port* "DONE: rtime=" rtime ", elapsed time=" (- done-time startt)
", ratio=" (/ rtime (- done-time startt))))))
;; (define (runs:parallel-runners-mgmt rdat)
;; (let ((time-to-check 2.8) ;; 28
;; (time-to-wait 3.0))
;; (if (> (- (current-seconds) (runs:dat-last-runners-check rdat)) time-to-check) ;; time to check
;; (let* ((num-registered (or (rmt:get-var "num-runners") 0))
;; (last-registered (or (rmt:get-var "runner-change-time") 0))
|
| ︙ | ︙ |