Megatest

Check-in [6fed2d60a6]
Login
Overview
Comment:Implemented server thread count throttling of launches, miminally tested.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.81-multi-server
Files: files | file ages | folders
SHA1: 6fed2d60a68968459638abf3eabc40c8bc3ed554
User & Date: mrwellan on 2024-07-08 10:24:18
Other Links: branch diff | manifest | tags
Context
2024-07-09
08:53
Merged from v1.81 and fixed conflicts Leaf check-in: dbc22912d1 user: mrwellan tags: v1.81-multi-server
2024-07-08
10:24
Implemented server thread count throttling of launches, miminally tested. check-in: 6fed2d60a6 user: mrwellan tags: v1.81-multi-server
06:01
wip (still broke) check-in: 00c25a6b53 user: matt tags: v1.81-multi-server
Changes

Modified tcp-transportmod.scm from [571bf1ec6b] to [f03b836e05].

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
				     (lambda (a b)
				       (let* ((load-a (tt:get-server-threads a))
					      (load-b (tt:get-server-threads b)))
					 (< load-a load-b))))))))
				     
	  ;; (let ((indx (max (random (- (length sdats) 1)) 0)))
	  ;;    (list-ref sdats indx)))))
	  (debug:print-info 1 *default-log-port* "found sdat " sdat" from sdats: "sdats)
          (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
	     (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
             (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
	     (let* ((host-port (conc host":"port))
		    (conn (make-tt-conn
			   host: host







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
				     (lambda (a b)
				       (let* ((load-a (tt:get-server-threads a))
					      (load-b (tt:get-server-threads b)))
					 (< load-a load-b))))))))
				     
	  ;; (let ((indx (max (random (- (length sdats) 1)) 0)))
	  ;;    (list-ref sdats indx)))))
	  ;; (debug:print-info 1 *default-log-port* "found sdat " sdat" from sdats: "sdats)
          (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
	     (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
             (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
	     (let* ((host-port (conc host":"port))
		    (conn (make-tt-conn
			   host: host
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

(define (tt:save-server-meta host port meta)
  (hash-table-set! *server-load* (conc host":"port) (cons meta (current-seconds))))

(define (tt:get-server-threads dat)
  (let* ((host (car  dat))
	 (port (cadr dat))
	 (dat  (tt:get-server-meta host port #t))
	 (meta (if dat (car dat) #f)))
    (if (list? meta)
	(or (alist-ref 'sload meta) 99998)
	99999))) ;; absurd number means don't use this one

;; lazy get, does not auto-refresh meta, this might be a problem
;;
(define (tt:get-server-meta host port #!optional (do-ping #f))
  (let* ((get-meta (lambda ()
		     (let* ((dat  (hash-table-ref/default *server-load* (conc host":"port) #f)))







|
|
|
|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

(define (tt:save-server-meta host port meta)
  (hash-table-set! *server-load* (conc host":"port) (cons meta (current-seconds))))

(define (tt:get-server-threads dat)
  (let* ((host (car  dat))
	 (port (cadr dat))
	 (dat  (tt:get-server-meta host port #t)))
    ;; (debug:print 0 *default-log-port* "host: "host" port: "port" dat: "dat)
    (if (list? dat)
	(or (alist-ref 'sload dat) 99998)
	99999))) ;; absurd number means don't use this one

;; lazy get, does not auto-refresh meta, this might be a problem
;;
(define (tt:get-server-meta host port #!optional (do-ping #f))
  (let* ((get-meta (lambda ()
		     (let* ((dat  (hash-table-ref/default *server-load* (conc host":"port) #f)))
321
322
323
324
325
326
327
328

329
330
331
332

333
334
335
336
337
338
339
340
  (if ttdat ;; if no server yet just pass on through
      (let* ((dbfname                 (dbmod:run-id->dbfname run-id))
	     (get-lowest-thread-load
	      (lambda ()
		(let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
		  (car (map tt:get-server-threads sdats))))))
	(if ttdat
	    (let loop ()

	      (if (> (get-lowest-thread-load) 5) ;; load is pretty high
		  (begin
		    (debug:print 0 *default-log-port* "Servers appear overloaded, waiting...")
		    (thread-sleep! 1)

		    (loop))))
	    (debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set")))))

(define (tt:ping host port server-id #!optional (tries-left 5))
  (let*  ((res      (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id
	  (try-again (lambda ()
		       (if (> tries-left 0)
			   (begin







|
>
|
|
|
|
>
|







321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
  (if ttdat ;; if no server yet just pass on through
      (let* ((dbfname                 (dbmod:run-id->dbfname run-id))
	     (get-lowest-thread-load
	      (lambda ()
		(let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
		  (car (map tt:get-server-threads sdats))))))
	(if ttdat
	    (let loop ((count 0))
	      (let* ((lowestload (get-lowest-thread-load)))
		(if (> lowestload 5) ;; load is pretty high
		    (begin
		      (debug:print 0 *default-log-port* "Servers appear overloaded with "lowestload" threads, waiting...")
		      (thread-sleep! 1)
		      (if (< count 10)
			  (loop (+ count 1)))))))
	    (debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set")))))

(define (tt:ping host port server-id #!optional (tries-left 5))
  (let*  ((res      (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id
	  (try-again (lambda ()
		       (if (> tries-left 0)
			   (begin