Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -92,17 +92,31 @@
 (define (rmt:send-receive cmd run-id params #!key (attemptnum 1)(ttdat #f))
   (assert (or (not run-id) (number? run-id)) "FATAL: run-id is required to be a number or #f")
   (assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")
   (let* ((areapath      *toppath*) ;; TODO - resolve from dbstruct to be compatible with multiple areas
 	 (readonly-mode (rmtmod:calc-ro-mode ttdat *toppath*))
-	 (testsuite     (common:get-testsuite-name)))
+	 (testsuite     (common:get-testsuite-name))
+	 (dbfname       (conc (dbfile:run-id->dbnum run-id)".db"))
+	 (dbdir         (conc areapath "/.mtdb")))
+    (if (and (not *journal-stats*)
+	     (file-exists? dbdir))
+	(tt:start-stats dbdir)) ;; fixme - find the right call to get the db directory
+    
+    ;; check the load on dbfname and add some delay using a droop curve of sorts
+    (if *journal-stats*
+	(let* ((stats (tt:get-journal-stats))
+	       (load  (or (alist-ref dbfname stats equal?) 0)))
+	  (if (> load 0)
+	      (let ((dely (* 10 load)))
+		(debug:print 0 *default-log-port* "Journal load "load" delaying queries "dely"s.")
+		(thread-sleep! dely)))))
+	
     (case (rmt:transport-mode)
       ((tcp)
        (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value
 	      (attemptnum    (+ 1 attemptnum))
 	      (mtexe         (common:find-local-megatest))
-	      (dbfname       (conc (dbfile:run-id->dbnum run-id)".db"))
 	      (ttdat         (rmt:set-ttdat areapath ttdat))
 	      (conn          (tt:get-conn ttdat dbfname))
 	      (is-main       (equal? dbfname "main.db")) ;; why not (not run-id) ?
 	      (server-start-proc (if is-main
 				     #f

Index: tcp-transportmod.scm
==================================================================
--- tcp-transportmod.scm
+++ tcp-transportmod.scm
@@ -1140,11 +1140,11 @@
   (count 0)
   (jcount (make-hash-table)) ;; 1.db => journal_count
   )
 
 ;; timeblk => jstats
-(define *journal-stats* (make-hash-table))
+(define *journal-stats* #f) ;; (make-hash-table))
 
 ;; monte-carlo-esque random sampling of journal files
 ;; for all the files:
 ;;   if .journal
 ;;      update stats +1 +1
@@ -1151,17 +1151,17 @@
 ;;      update stats +1  0
 ;;
 (define (tt:write-load-tracking dbdir)
   (let* ((cs    (current-seconds))
 	 (key   (inexact->exact (quotient cs 10)))
-	 (old   (- key 4)) ;; 4 x 10 seconds ago
+	 (old   (- key 5)) ;; 4 x 10 seconds ago
 	 (jstat (if (hash-table-exists? *journal-stats* key)
 		    (hash-table-ref *journal-stats* key )
 		    (let ((new (make-jstats)))
 		      (hash-table-set! *journal-stats* key new)
 		      new))))
-    ;; clear out records over 30s old
+    ;; clear out old records
     (for-each
      (lambda (key)
        (if (< key old)
 	   (hash-table-delete! *journal-stats* key)))
      (hash-table-keys *journal-stats*))
@@ -1177,14 +1177,63 @@
 	 (match parts
 	   ((_ dbfname)
 	    (hash-table-set! (jstats-jcount jstat) dbfname
 			     (+ (hash-table-ref/default (jstats-jcount jstat) dbfname 0) 1)
 			     ))
+	   (else #f)
 	   )))
      '()
      dbdir 
      )))
+
+(define *journal-stats-mutex* (make-mutex))
+
+(define (tt:journal-stats-run dbdir)
+  (if (not *journal-stats*)(set! *journal-stats* (make-hash-table)))
+  (let loop ()
+    (mutex-lock! *journal-stats-mutex*)
+    (tt:write-load-tracking dbdir)
+    (mutex-unlock! *journal-stats-mutex*)
+    (thread-sleep! (/ (random 1000) 100.0))
+    (loop)))
+
+;; call this to start a thread that is keeping the journal-stats up to date.
+(define (tt:start-stats dbdir)
+  (thread-start!
+   (make-thread
+    (lambda ()(tt:journal-stats-run dbdir)) "Journal stats collection thread")))
+
+(define (tt:get-journal-stats)
+  (let* ((result    (make-jstats))
+	 (hitcounts (jstats-jcount result)))
+    (if *journal-stats*
+	(begin
+	  (mutex-lock! *journal-stats-mutex*)
+	  (hash-table-for-each
+	   *journal-stats*
+	   (lambda (k v) ;; key jstats
+	     (let* ((count  (jstats-count v))
+		    (jcount (jstats-jcount v))) ;; dbfname => hit count
+	       (jstats-count-set! result
+				  (+ (jstats-count result)
+				     (jstats-count v)))
+	       (hash-table-for-each
+		jcount
+		(lambda (dbfname hit-count)
+		  (hash-table-set! hitcounts dbfname
+				   (+ hit-count
+				      (hash-table-ref/default hitcounts dbfname 0))))))))
+	  (mutex-unlock! *journal-stats-mutex*))
+	(debug:print 0 *default-log-port* "INFO: *journal-stats* not set."))
+    ;; convert to normalized alist
+    (let ((tot  (min (jstats-count result) 1)) ;; avoid divide by zero
+	  (hits (jstats-jcount result))) ;; 1.db => count
+      (hash-table-map
+       hits
+       (lambda (fname hitcount)
+	 (cons fname (/ hitcount tot)))))
+    ))
 
 ;; megatest> (import tcp-transportmod)
 ;; megatest> (tt:write-load-tracking ".mtdb")
 ;; megatest> (hash-table-keys *journal-stats*)
 ;; (172060297)