Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -223,10 +223,35 @@
              (begin
                #;(common:telemetry-log (conc "api-out:"(->string cmd))
                payload: `((params . ,params)
                (ok-res . #f)))
                (vector #t res))))))))
+
+;; indat is (cmd run-id params meta)
+(define (api:tcp-dispatch-request dbstruct indat) ;; cmd run-id params)
+  (set! *api-process-request-count* (+ *api-process-request-count* 1))
+  (match (deserialize indat)
+    ((cmd run-id params meta)
+     (let* ((status  (cond
+		      ((> *api-process-request-count* 50) 'busy)
+		      ((> *api-process-request-count* 25) 'loaded)
+		      (else 'ok)))
+	    (errmsg  (case status
+		       ((busy)   (conc "Server overloaded, "*api-process-request-count*" threads in flight"))
+		       ((loaded) (conc "Server loaded, "*api-process-request-count*" threads in flight"))
+		       (else     #f)))
+	    (result  (case status
+		       ((busy) #f)
+		       (else (api:dispatch-request dbstruct cmd run-id params))))
+	    (payload (list status errmsg result '()))
+	    (pdat    (serialize payload)))
+       (set! *api-process-request-count* (- *api-process-request-count* 1))
+       pdat))
+    (else
+     (let* ((msg (conc "(deserialize indat)="(deserialize indat)", indat="indat)))
+       (assert #f "FATAL: failed to deserialize indat "msg)))))
+       
 
 (define (api:dispatch-request dbstruct cmd run-id params)
   (case cmd
     ;;===============================================
     ;; READ/WRITE QUERIES

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -941,11 +941,11 @@
       (case (rmt:transport-mode)
 	((http)(http-transport:launch))
 	((tcp)
 	 (debug:print 0 *default-log-port* "INFO: Running using tcp method.")
 	 (if run-id
-	     (tt:start-server tl run-id dbfname api:dispatch-request)
+	     (tt:start-server tl run-id dbfname api:tcp-dispatch-request)
 	     (begin
 	       (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
 	       (exit 1))))
 	(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
       (set! *didsomething* #t)))

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -84,14 +84,10 @@
 
 ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
 ;;
 (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
 
-  #;(common:telemetry-log (conc "rmt:"(->string cmd))
-                        payload: `((rid . ,rid)
-                                   (params . ,params)))
-  
   (if (> attemptnum 2)
       (debug:print 0 *default-log-port* "INFO: attemptnum in rmt:send-receive is " attemptnum))
   
   (cond
    ((> attemptnum 2) (thread-sleep! 0.05))
@@ -100,13 +96,14 @@
 
   ;; I'm turning this off, it may make sense to move it
   ;; into http-transport-handler
   (if (and (> attemptnum 5) (= 0 (modulo attemptnum 15)))  
       (begin
+	(debug:print 0 *default-log-port* "ERROR: can't connect to server, trying to start a server.")
 	(server:run *toppath*)
 	(thread-sleep! 3)))
-
+  
   ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote
   ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds.
   ;; 3. do the query, if on homehost use local access
   ;;
   (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value

Index: tcp-transportmod.scm
==================================================================
--- tcp-transportmod.scm
+++ tcp-transportmod.scm
@@ -136,16 +136,24 @@
   ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
   (let* ((conn (tt:client-connect-to-server ttdat dbfname run-id))) ;; (hash-table-ref/default (tt-conns ttdat) dbfname #f)))
     (if conn
 	;; have connection, call the server
 	(let* ((res (tt:send-receive ttdat conn cmd run-id params)))
-	  (cond
-	   ((member res '(busy starting))
-	    (thread-sleep! 1)
-	    (tt:handler  ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
-	   (else
-	    res)))
+	  ;; res is (status errmsg result meta)
+	  (match res
+	    ((status errmsg result meta)
+	     (case status
+	       ((busy)
+		(debug:print 0 *default-log-port* "WARNING: server is overloaded, will try again in few seconds.")
+		(thread-sleep! 2)
+		(tt:handler  ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
+	       ((loaded)
+		(debug:print 0 *default-log-port* "WARNING: server is loaded, will try again in a second.")
+		(thread-sleep! 1)
+		(tt:handler  ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
+	       (else
+		result)))))
 	(begin
 	  (thread-sleep! 1) ;; give it a rest and try again
 	  (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))
 
 	;; no conn yet, find and or start and find a server
@@ -256,10 +264,12 @@
   (let loop ()
     (if (< (- (current-seconds) (tt-last-access ttdat)) 10)
 	(begin
 	  (thread-sleep! 2)
 	  (loop))))
+  (if (tt-cleanup-proc ttdat)
+      ((tt-cleanup-proc ttdat)))
   (debug:print 0 *default-log-port* "INFO: Server timed out, exiting."))
 
 ;; ;; given an already set up uconn start the cmd-loop
 ;; ;;
 ;; (define (tt:cmd-loop ttdat)