Overview
| Comment: | Added storage of commands in the server thread hash, added debug prints when the max threads is exceeded |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.81 |
| Files: | files | file ages | folders |
| SHA1: |
2d46a2e3ec7c483707258306aec0058e |
| User & Date: | mmgraham on 2024-06-27 16:45:21 |
| Other Links: | branch diff | manifest | tags |
Context
|
2024-07-01
| ||
| 11:59 | Added CSCOPTS entry used for debugging check-in: 74949ef691 user: mrwellan tags: v1.81 | |
| 10:56 | Pulled in testcontrol panel improvements Leaf check-in: f8243ad180 user: mrwellan tags: v1.81-test-control-panel | |
|
2024-06-27
| ||
| 16:45 | Added storage of commands in the server thread hash, added debug prints when the max threads is exceeded check-in: 2d46a2e3ec user: mmgraham tags: v1.81 | |
|
2024-06-25
| ||
| 20:26 | Updated stepwise flow graph check-in: 24e3d80cf5 user: matt tags: v1.81 | |
Changes
Modified api.scm from [b08fe263c7] to [bf55d9f0a8].
| ︙ | ︙ | |||
153 154 155 156 157 158 159 |
tasks-set-state-given-param-key
))
(define *db-write-mutexes* (make-hash-table))
(define *server-signature* #f)
(define *api-threads* '())
| | | > > > > > > > > > > > > > > > | 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 |
tasks-set-state-given-param-key
))
(define *db-write-mutexes* (make-hash-table))
(define *server-signature* #f)
(define *api-threads* '())
(define (api:register-thread th-in command)
(set! *api-threads* (cons (list th-in (current-seconds) command) *api-threads*)))
(define (api:get-thread-command th-in)
(let ((thread-data (assoc th-in *api-threads*)))
(if thread-data
(third thread-data) ; Assuming the command is the third element in the list
#f))) ; Return #f if the thread is not found
(define (api:unregister-thread th-in)
(set! *api-threads* (filter (lambda (thdat)
(not (eq? th-in (car thdat))))
*api-threads*)))
(define (api:remove-dead-or-terminated)
(set! *api-threads* (filter (lambda (thdat)
(not (member (thread-state (car thdat)) '(terminated dead))))
*api-threads*)))
(define (api:get-count-threads-alive)
(length *api-threads*))
(define (api:get-threads)
(map (lambda (thdat)
(let ((thread (first thdat))
(timestamp (second thdat))
(command (third thdat)))
(format "\nThread: ~a, age: ~a, Command: ~a" thread (- (current-seconds) timestamp) command)))
*api-threads*))
(define *api:last-stats-print* 0)
(define *api-print-db-stats-mutex* (make-mutex))
(define (api:print-db-stats)
(debug:print-info 0 *default-log-port* "Started periodic db stats printer")
(let loop ()
(mutex-lock! *api-print-db-stats-mutex*)
|
| ︙ | ︙ | |||
194 195 196 197 198 199 200 |
;; reads/writes to current in/out port
;;
(define (api:tcp-dispatch-request-make-handler 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)
| | | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 |
;; reads/writes to current in/out port
;;
(define (api:tcp-dispatch-request-make-handler 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) (car indat))
(let* ((result
(let* ((numthreads (api:get-count-threads-alive))
(delay-wait (if (> numthreads 10)
(- numthreads 10)
0))
(normal-proc (lambda (cmd run-id params)
(case cmd
|
| ︙ | ︙ | |||
226 227 228 229 230 231 232 | ((ping) #t) ;; we are fine (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 | | < < | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 |
((ping) #t) ;; we are fine
(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)
'busy)
(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)
(if (eq? cmd 'ping)
(normal-proc cmd run-id params)
;; numthreads must be greater than 5 for busy
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [3b34f09355] to [2d80f8e52f].
| ︙ | ︙ | |||
324 325 326 327 328 329 330 331 332 333 334 335 336 337 | (debug:print 0 *default-log-port* "Server is loaded, delaying "delay-wait" seconds") (thread-sleep! delay-wait))))) (case status ((busy) ;; result will be how long the server wants you to delay (let* ((raw-dly (if (number? result) result 0.1)) (dly (+ raw-dly (/ attemptnum 10)))) ;; (* raw-dly (/ attemptnum 2)))) (debug:print 0 *default-log-port* "WARNING: server for "dbfname" is busy, cmd is "cmd", will try again in "dly" seconds. This is attempt "(- attemptnum 1)) (thread-sleep! dly) (tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe server-start-proc))) ((loaded) (debug:print 0 *default-log-port* "WARNING: server for "dbfname" is loaded, slowing queries.") (tt:backoff-incr (tt-conn-host conn)(tt-conn-port conn)) result) ;; (tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe)) (else | > | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 |
(debug:print 0 *default-log-port* "Server is loaded, delaying "delay-wait" seconds")
(thread-sleep! delay-wait)))))
(case status
((busy) ;; result will be how long the server wants you to delay
(let* ((raw-dly (if (number? result) result 0.1))
(dly (+ raw-dly (/ attemptnum 10)))) ;; (* raw-dly (/ attemptnum 2))))
(debug:print 0 *default-log-port* "WARNING: server for "dbfname" is busy, cmd is "cmd", will try again in "dly" seconds. This is attempt "(- attemptnum 1))
(debug:print 0 *default-log-port* errmsg)
(thread-sleep! dly)
(tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe server-start-proc)))
((loaded)
(debug:print 0 *default-log-port* "WARNING: server for "dbfname" is loaded, slowing queries.")
(tt:backoff-incr (tt-conn-host conn)(tt-conn-port conn))
result) ;; (tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe))
(else
|
| ︙ | ︙ |