Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -155,12 +155,18 @@
 
 (define *db-write-mutexes* (make-hash-table))
 (define *server-signature* #f)
 
 (define *api-threads* '())
-(define (api:register-thread th-in)
-  (set! *api-threads* (cons (cons th-in (current-seconds)) *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*)))
@@ -170,10 +176,19 @@
 				(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")
@@ -196,11 +211,11 @@
 (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))
+    (api:register-thread (current-thread) (car indat))
     (let* ((result 
 	    (let* ((numthreads (api:get-count-threads-alive))
 		   (delay-wait (if (> numthreads 10)
 				   (- numthreads 10)
 				   0))
@@ -228,17 +243,15 @@
 					  (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
-				       ((and (> numthreads maxthreads)
-					     (> (random 100) 70)) ;; allow a 30% probability to go through so we can figure out what is going wrong in main.db server.
+                                       ((> numthreads maxthreads)
 					'busy)
-				       ;; ((> numthreads 5) 'loaded) ;; this gets transmitted to the client which calls tt:backoff-incr to slow stuff down.
 				       (else 'ok)))
 			     (errmsg  (case status
-					((busy)   (conc "Server overloaded, "numthreads" threads in flight"))
+					((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)

Index: tcp-transportmod.scm
==================================================================
--- tcp-transportmod.scm
+++ tcp-transportmod.scm
@@ -326,10 +326,11 @@
 	     (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))