246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
(delay-wait (if (> newcount 10)
(- newcount 10)
0)))
(set! *api-process-request-count* newcount)
(set! *db-last-access* (current-seconds))
(match indat
((cmd run-id params meta)
(let* ((status (cond
((> newcount 30) 'busy)
((> newcount 15) 'loaded)
(else 'ok)))
(errmsg (case status
((busy) (conc "Server overloaded, "newcount" threads in flight"))
((loaded) (conc "Server loaded, "newcount" threads in flight"))
(else #f)))
(result (case status
((busy) (- newcount 29))
((loaded) #f)
(else
(case cmd
((ping) *server-signature*)
(else
(api:dispatch-request dbstruct cmd run-id params))))))
(meta `((wait . ,delay-wait)))
(payload (list status errmsg result meta)))
(set! *api-process-request-count* (- *api-process-request-count* 1))
(serialize payload)))
(else
(assert #f "FATAL: failed to deserialize indat "indat))))))
|
>
>
|
>
>
|
|
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
(delay-wait (if (> newcount 10)
(- newcount 10)
0)))
(set! *api-process-request-count* newcount)
(set! *db-last-access* (current-seconds))
(match indat
((cmd run-id params meta)
(let* ((ttdat *server-info*)
(server-state (tt-state ttdat))
(status (cond
((> newcount 30) 'busy)
((> newcount 15) 'loaded)
(else 'ok)))
(errmsg (case status
((busy) (conc "Server overloaded, "newcount" threads in flight"))
((loaded) (conc "Server loaded, "newcount" threads in flight"))
(else #f)))
(result (case status
((busy) (- newcount 29))
((loaded) #f)
(else
(case cmd
((ping) *server-signature*)
(else
(api:dispatch-request dbstruct cmd run-id params))))))
(meta (case cmd
((ping) `((sstate . ,server-state)))
(else `((wait . ,delay-wait)))))
(payload (list status errmsg result meta)))
(set! *api-process-request-count* (- *api-process-request-count* 1))
(serialize payload)))
(else
(assert #f "FATAL: failed to deserialize indat "indat))))))
|