Megatest

Check-in [7308f2111f]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:several tries later ...
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 7308f2111fcaed7ab9f2870af601d54676ae5169
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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
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

  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 

  )

(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))



(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-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)

	    (rmt:set-var "num-runners" 1)

	    (runs:dat-last-runners-count-set! rdat num-registered)
	    (runs:dat-run-skip-count-set! rdat 0))
	   ;; too many waits, decrement num-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))

	    ;; too many running, take a break
	   ((> num-registered last-runners-count)
	    (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... ")
	    (thread-sleep! time-to-wait)
	    (runs:dat-run-skip-count-set! rdat (+ (runs:dat-run-skip-count rdat) 1)))





	   ;; 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)))))))
  






















































































;; (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))








|
>

















|
>
|










>
|
>


|



|
>

|




|

|
>
>
>
>
>









|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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))
︙︙

This page was generated in about 0.11s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00