Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -6,10 +6,12 @@
 ;; 
 ;;  This program is distributed WITHOUT ANY WARRANTY; without even the
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 ;;======================================================================
+
+(use srfi-69 posix)
 
 (declare (unit api))
 (declare (uses rmt))
 (declare (uses db))
 (declare (uses tasks))
@@ -122,148 +124,154 @@
      (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
    (if (not (vector? dat))                    ;; it is an error to not receive a vector
        (vector #f #f "remote must be called with a vector")       
        (vector                                   ;; return a vector + the returned data structure
 	#t 
-	(let ((cmd    (vector-ref dat 0))
-	      (params (vector-ref dat 1)))
-	  (case (if (symbol? cmd)
-		    cmd
-		    (string->symbol cmd))
-
-	    ;;===============================================
-	    ;; READ/WRITE QUERIES
-	    ;;===============================================
-
-	    ;; SERVERS
-	    ((start-server)                    (apply server:kind-run params))
-	    ((kill-server)                     (set! *server-run* #f))
-
-	    ;; TESTS
-	    ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
-	    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
-	    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
-	    ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
-	    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
-	    ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
-	    ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
-	    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))
-
-	    ;; RUNS
-	    ((register-run)                 (apply db:register-run dbstruct params))
-	    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
-	    ((delete-run)                   (apply db:delete-run dbstruct params))
-	    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
-	    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
-	    ((update-run-stats)             (apply db:update-run-stats dbstruct params))
-	    ((set-var)                      (apply db:set-var dbstruct params))
-
-	    ;; STEPS
-	    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
-
-	    ;; TEST DATA
-	    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
-	    ((csv->test-data)               (apply db:csv->test-data dbstruct params))
-
-	    ;; MISC
-	    ((sync-inmem->db)               (let ((run-id (car params)))
-					      (db:sync-touched dbstruct run-id force-sync: #t)))
-	    ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
-
-	    ;; TESTMETA
-	    ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
-	    ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
-            ((get-tests-tags)            (db:get-tests-tags dbstruct))
-
-	    ;; TASKS
-	    ((tasks-add)                 (apply tasks:add dbstruct params))   
-	    ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
-	    ((tasks-get-last)            (apply tasks:get-last dbstruct params))
-
-	    ;; ARCHIVES
-	    ;; ((archive-get-allocations)   
-	    ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
-	    ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
-	    ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
-
-	    ;;======================================================================
-	    ;; READ ONLY QUERIES
-	    ;;======================================================================
-
-	    ;; KEYS
-	    ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
-	    ((get-keys)                        (db:get-keys dbstruct))
-            ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server
-	    ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
-	    ((get-target)                      (apply db:get-target dbstruct params))
-	    ((get-targets)                     (db:get-targets dbstruct))
-
-	    ;; ARCHIVES
-	    ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
-	    
-	    ;; TESTS
-	    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
-	    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
-	    ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
-	    ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
-	    ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
-	    ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
-	    ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
-	    ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
-	    ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
-	    ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
-	    ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
-	    ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
-	    ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
-	    ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
-	    ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
-	    ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
-	    ((synchash-get)                    (apply synchash:server-get dbstruct params))
-	    ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
-
-	    ;; RUNS
-	    ((get-run-info)                 (apply db:get-run-info dbstruct params))
-	    ((get-run-status)               (apply db:get-run-status dbstruct params))
-	    ((set-run-status)               (apply db:set-run-status dbstruct params))
-	    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
-	    ((get-test-id)                  (apply db:get-test-id dbstruct params))
-	    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
-	    ((get-runs)                     (apply db:get-runs dbstruct params))
-	    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
-	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
-	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
-	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
-	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
-	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
-	    ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
-	    ((get-var)                      (apply db:get-var dbstruct params))
-	    ((get-run-stats)                (apply db:get-run-stats dbstruct params))
-
-	    ;; STEPS
-	    ((get-steps-data)               (apply db:get-steps-data dbstruct params))
-	    ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
-
-	    ;; TEST DATA
-	    ((read-test-data)               (apply db:read-test-data dbstruct params))
-
-	    ;; MISC
-            ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
-	    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
-	    ((login)                        (apply db:login dbstruct params))
-	    ((general-call)                 (let ((stmtname   (car params))
-						  (run-id     (cadr params))
-						  (realparams (cddr params)))
-					      (db:general-call dbstruct stmtname realparams)))
-	    ((sdb-qry)                      (apply sdb:qry params))
-	    ((ping)                         (current-process-id))
-
-	    ;; TESTMETA
-	    ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))
-
-	    ;; TASKS 
-	    ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))))))))
-
+	(let* ((cmd-in (vector-ref dat 0))
+	       (cmd    (if (symbol? cmd-in)
+			  cmd-in
+			  (string->symbol cmd-in)))
+	       (params (vector-ref dat 1))
+	       (start-t (current-milliseconds))
+	       (res    
+		(case cmd
+		  ;;===============================================
+		  ;; READ/WRITE QUERIES
+		  ;;===============================================
+
+		  ;; SERVERS
+		  ((start-server)                    (apply server:kind-run params))
+		  ((kill-server)                     (set! *server-run* #f))
+
+		  ;; TESTS
+		  ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
+		  ((delete-test-records)             (apply db:delete-test-records dbstruct params))
+		  ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
+		  ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
+		  ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
+		  ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
+		  ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
+		  ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))
+
+		  ;; RUNS
+		  ((register-run)                 (apply db:register-run dbstruct params))
+		  ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
+		  ((delete-run)                   (apply db:delete-run dbstruct params))
+		  ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
+		  ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
+		  ((update-run-stats)             (apply db:update-run-stats dbstruct params))
+		  ((set-var)                      (apply db:set-var dbstruct params))
+
+		  ;; STEPS
+		  ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
+
+		  ;; TEST DATA
+		  ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
+		  ((csv->test-data)               (apply db:csv->test-data dbstruct params))
+
+		  ;; MISC
+		  ((sync-inmem->db)               (let ((run-id (car params)))
+						    (db:sync-touched dbstruct run-id force-sync: #t)))
+		  ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
+
+		  ;; TESTMETA
+		  ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
+		  ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
+		  ((get-tests-tags)            (db:get-tests-tags dbstruct))
+
+		  ;; TASKS
+		  ((tasks-add)                 (apply tasks:add dbstruct params))   
+		  ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
+		  ((tasks-get-last)            (apply tasks:get-last dbstruct params))
+
+		  ;; ARCHIVES
+		  ;; ((archive-get-allocations)   
+		  ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
+		  ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
+		  ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
+
+		  ;;======================================================================
+		  ;; READ ONLY QUERIES
+		  ;;======================================================================
+
+		  ;; KEYS
+		  ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
+		  ((get-keys)                        (db:get-keys dbstruct))
+		  ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server
+		  ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
+		  ((get-target)                      (apply db:get-target dbstruct params))
+		  ((get-targets)                     (db:get-targets dbstruct))
+
+		  ;; ARCHIVES
+		  ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
+		  
+		  ;; TESTS
+		  ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
+		  ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
+		  ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
+		  ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
+		  ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
+		  ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
+		  ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
+		  ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
+		  ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
+		  ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
+		  ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
+		  ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
+		  ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
+		  ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
+		  ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
+		  ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
+		  ((synchash-get)                    (apply synchash:server-get dbstruct params))
+		  ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
+
+		  ;; RUNS
+		  ((get-run-info)                 (apply db:get-run-info dbstruct params))
+		  ((get-run-status)               (apply db:get-run-status dbstruct params))
+		  ((set-run-status)               (apply db:set-run-status dbstruct params))
+		  ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
+		  ((get-test-id)                  (apply db:get-test-id dbstruct params))
+		  ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
+		  ((get-runs)                     (apply db:get-runs dbstruct params))
+		  ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
+		  ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
+		  ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
+		  ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
+		  ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
+		  ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
+		  ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
+		  ((get-var)                      (apply db:get-var dbstruct params))
+		  ((get-run-stats)                (apply db:get-run-stats dbstruct params))
+
+		  ;; STEPS
+		  ((get-steps-data)               (apply db:get-steps-data dbstruct params))
+		  ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
+
+		  ;; TEST DATA
+		  ((read-test-data)               (apply db:read-test-data dbstruct params))
+
+		  ;; MISC
+		  ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
+		  ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
+		  ((login)                        (apply db:login dbstruct params))
+		  ((general-call)                 (let ((stmtname   (car params))
+							(run-id     (cadr params))
+							(realparams (cddr params)))
+						    (db:general-call dbstruct stmtname realparams)))
+		  ((sdb-qry)                      (apply sdb:qry params))
+		  ((ping)                         (current-process-id))
+
+		  ;; TESTMETA
+		  ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))
+
+		  ;; TASKS 
+		  ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params)))))
+	  (let ((delta-t (- (current-milliseconds)
+			    start-t)))
+	    (hash-table-set! *db-api-call-time* cmd
+			     (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
+	  res)))))
 
 ;; http-server  send-response
 ;;                 api:process-request
 ;;                    db:*
 ;;

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -100,10 +100,11 @@
 (define *db-access-allowed*   #t) ;; flag to allow access
 (define *db-access-mutex*     (make-mutex))
 (define *db-transaction-mutex* (make-mutex))
 (define *db-cache-path*       #f)
 (define *db-with-db-mutex*    (make-mutex))
+(define *db-api-call-time*    (make-hash-table)) ;; hash of command => (list of times)
 
 ;; SERVER
 (define *my-client-signature* #f)
 (define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
 (define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
@@ -964,10 +965,20 @@
       #f ;; better than an exception for my needs
       (fold (lambda (a b)
 	      (if (comp a b) a b))
 	    (car lst)
 	    lst)))
+
+;; get min or max, use > for max and < for min, this works around the limits on apply
+;;
+(define (common:sum lst)
+  (if (null? lst)
+      0
+      (fold (lambda (a b)
+	      (+ a b))
+	    (car lst)
+	    lst)))
 
 ;; path list to hash-table tree
 ;;   ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c))))
 ;;
 (define (common:list->htree lst)

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -2008,10 +2008,25 @@
 	  (cons (list state status count) res))
 	'()
 	db
 	"SELECT state,status,count FROM run_stats WHERE run_id=? AND run_id IN (SELECT id FROM runs WHERE state NOT IN ('DELETED','deleted'));"
 	run-id))))
+
+(define (db:print-current-query-stats)
+  ;; generate stats from *db-api-call-time*
+  (let ((ordered-keys (sort (hash-table-keys *db-api-call-time*)
+			    (lambda (a b)
+			      (let ((sum-a (common:sum (hash-table-ref *db-api-call-time* a)))
+				    (sum-b (common:sum (hash-table-ref *db-api-call-time* b))))
+				(> sum-a sum-b))))))
+    (for-each
+     (lambda (cmd-key)
+       (let* ((dat  (hash-table-ref *db-api-call-time* cmd-key))
+	      (avg  (if (> (length dat) 0)
+			(/ (common:sum dat)(length dat)))))
+	 (debug:print-info 0 *default-log-port* cmd-key "\tavg: " avg " max: " (common:max dat) " min: " (common:min-max < dat) " num: " (length dat))))
+     ordered-keys)))
 
 (define (db:get-all-run-ids dbstruct)
   (db:with-db
    dbstruct
    #f

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -505,25 +505,28 @@
     ;;
     (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "shutting-down")
     (set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
     (portlogger:open-run-close portlogger:set-port port "released")
     (thread-sleep! 5)
-    (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
-    (debug:print-info 0 *default-log-port* "Number of cached writes   " *number-of-writes*)
-    (debug:print-info 0 *default-log-port* "Average cached write time "
-		      (if (eq? *number-of-writes* 0)
-			  "n/a (no writes)"
-			  (/ *writes-total-delay*
-			     *number-of-writes*))
-		      " ms")
-    (debug:print-info 0 *default-log-port* "Number non-cached queries "  *number-non-write-queries*)
-    (debug:print-info 0 *default-log-port* "Average non-cached time   "
-		      (if (eq? *number-non-write-queries* 0)
-			  "n/a (no queries)"
-			  (/ *total-non-write-delay* 
-			     *number-non-write-queries*))
-		      " ms")
+;; (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
+;; (debug:print-info 0 *default-log-port* "Number of cached writes   " *number-of-writes*)
+;; (debug:print-info 0 *default-log-port* "Average cached write time "
+;; 		      (if (eq? *number-of-writes* 0)
+;; 			  "n/a (no writes)"
+;; 			  (/ *writes-total-delay*
+;; 			     *number-of-writes*))
+;; 		      " ms")
+;; (debug:print-info 0 *default-log-port* "Number non-cached queries "  *number-non-write-queries*)
+;; (debug:print-info 0 *default-log-port* "Average non-cached time   "
+;; 		      (if (eq? *number-non-write-queries* 0)
+;; 			  "n/a (no queries)"
+;; 			  (/ *total-non-write-delay* 
+;; 			     *number-non-write-queries*))
+    ;; 		      " ms")
+
+    (db:print-current-query-stats)
+    
     (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
     (tasks:server-delete-record (db:delay-if-busy tdbdat) server-id " http-transport:keep-running complete")
     ;; if the .server file contained :myport then we can remove it
     (server:remove-dotserver-file *toppath* port)
     ;;(BB> "http-transport:server-shutdown -> exit")