242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
+
+
+
+
+
+
+
-
+
+
+
|
(else
(assert ok "FATAL: database file and run-id not aligned.")))))
(ttdat *server-info*)
(server-state (tt-state ttdat))
(maxthreads 20) ;; make this a parameter?
(status (cond
((> numthreads maxthreads)
(let* ((testsuite (common:get-testsuite-name))
(mtexe (common:find-local-megatest))
(proc (lambda ()
;; we are overloaded, try to start another server
(debug:print 0 *default-log-port* "Too many threads running, starting another server")
(tt:server-process-run *toppath* testsuite mtexe run-id))))
(set! *server-start-requests* (cons proc *server-start-requests*)))
'busy)
;; 'busy
'loaded ;; not ideal since the client will not backoff
)
(else 'ok)))
(errmsg (case status
((busy) (conc "Server overloaded, "numthreads" threads in flight, current cmd: " cmd "\n current threads: " (api:get-threads)))
((loaded) (conc "Server loaded, "numthreads" threads in flight"))
(else #f)))
(result (case status
((busy)
|
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
|
284
285
286
287
288
289
290
291
292
293
294
295
296
297
|
-
-
|
(else
(assert #f "FATAL: failed to deserialize indat "indat))))))
;; (set! *api-process-request-count* (- *api-process-request-count* 1))
;; (serialize payload)
(api:unregister-thread (current-thread))
result)))
(define *api-halt-writes* #f)
(define (api:dispatch-request dbstruct cmd run-id params)
(if (not *no-sync-db*)
(db:open-no-sync-db))
(let* ((start-time (current-milliseconds)))
|