183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
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
|
+
+
+
+
+
+
+
+
+
+
-
+
|
(begin
(rmt:print-db-stats)
(set! *api:last-stats-print* (current-seconds))))
(mutex-unlock! *api-print-db-stats-mutex*)
(thread-sleep! 5)
(loop)))
(define (api:tcp-dispatch-request-make-handler-new dbstruct) ;; cmd run-id params)
;; put proc into in-queue
;; poll out-queue for result evey 25ms
;; time out with big message
#f
)
(define api:tcp-dispatch-request-make-handler api:tcp-dispatch-request-make-handler-old)
;; indat is (cmd run-id params meta)
;;
;; WARNING: Do not print anything in the lambda of this function as it
;; reads/writes to current in/out port
;;
(define (api:tcp-dispatch-request-make-handler dbstruct) ;; cmd run-id params)
(define (api:tcp-dispatch-request-make-handler-old dbstruct) ;; cmd run-id params)
(assert *toppath* "FATAL: api:tcp-dispatch-request-make-handler called but *toppath* not set.")
(if (not *server-signature*)
(set! *server-signature* (tt:mk-signature *toppath*)))
(lambda (indat)
(api:register-thread (current-thread))
(let* ((result
(let* ((numthreads (api:get-count-threads-alive))
|
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
-
+
|
((loaded) (conc "Server loaded, "numthreads" threads in flight"))
(else #f)))
(result (case status
((busy)
(if (eq? cmd 'ping)
(normal-proc cmd run-id params)
;; numthreads must be greater than 5 for busy
(* 0.1 (- numthreads maxthreads)) ;; was 15
(* 0.1 (- numthreads maxthreads)) ;; was 15 - return a number for the remote to delay
)) ;; (- numthreads 29)) ;; call back in as many seconds
((loaded)
;; (if (eq? (rmt:transport-mode) 'tcp)
;; (thread-sleep! 0.5))
(normal-proc cmd run-id params))
(else
(normal-proc cmd run-id params))))
|