@@ -18,10 +18,12 @@
 
 ;;======================================================================
 
 (declare (unit commonmod))
 (declare (uses debugprint))
+(declare (uses mtargs))
+(declare (uses stml2))
 
 (use srfi-69)
 
 (module commonmod
 	*
@@ -30,11 +32,12 @@
 (cond-expand
  (chicken-4
   
   (import chicken
 	  ports
-	  
+	  (prefix base64 base64:)
+
 	  (prefix sqlite3 sqlite3:)
 	  data-structures
 	  extras
 	  files
 	  matchable
@@ -43,16 +46,21 @@
 	  pathname-expand
 	  posix
 	  posix-extras
 	  regex
 	  regex-case
+	  sparse-vectors
 	  srfi-1
+	  srfi-13
 	  srfi-18
 	  srfi-69
 	  typed-records
-
+	  z3
+	  
 	  debugprint
+	  stml2
+	  (prefix mtargs args:)
 	  )
   (use srfi-69))
  (chicken-5
   (import (prefix sqlite3 sqlite3:)
 	  ;; data-structures
@@ -124,10 +132,230 @@
 	(begin
 	  (hash-table-set! *common:denoise* key currtime)
 	  #t)
 	#f)))
 
+;; GLOBALS
+
+;; CONTEXTS
+(defstruct cxt
+  (taskdb #f)
+  (cmutex (make-mutex)))
+;; (define *contexts* (make-hash-table))
+;; (define *context-mutex* (make-mutex))
+
+;; ;; safe method for accessing a context given a toppath
+;; ;;
+;; (define (common:with-cxt toppath proc)
+;;   (mutex-lock! *context-mutex*)
+;;   (let ((cxt (hash-table-ref/default *contexts* toppath #f)))
+;;     (if (not cxt)
+;;         (set! cxt (let ((x (make-cxt)))(hash-table-set! *contexts* toppath x) x)))
+;;     (let ((cxt-mutex (cxt-mutex cxt)))
+;;       (mutex-unlock! *context-mutex*)
+;;       (mutex-lock! cxt-mutex)
+;;       (let ((res (proc cxt)))
+;;         (mutex-unlock! cxt-mutex)
+;;         res))))
+        
+;; A hash table that can be accessed by #{scheme ...} calls in
+;; config files. Allows communicating between confgs
+;;
+(define *user-hash-data* (make-hash-table))
+
+(define *db-keys* #f)
+
+(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
+(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
+(define *runconfigdat* #f)   ;; run configs data
+(define *configdat*    #f)   ;; megatest.config data
+(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
+;; (define *toppath*      #f) ;; moved to commonmod
+(define *already-seen-runconfig-info* #f)
+
+(define *test-meta-updated* (make-hash-table))
+(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
+(define *passnum*           0) ;; when running track calls to run-tests or similar
+;; (define *alt-log-file* #f)  ;; used by -log
+;; (define *common:denoise*    (make-hash-table)) ;; for low noise printing
+(define *time-zero* (current-seconds)) ;; for the watchdog
+(define *on-exit-procs* '()) ;; add procs to this list to be executed on exit
+(define *default-area-tag* "local")
+
+;; DATABASE
+;; task db
+(define *task-db*             #f) ;; (vector db path-to-db)
+(define *db-access-allowed*   #t) ;; flag to allow access
+;; (define *db-access-mutex*     (make-mutex)) ;; moved to dbfile
+;; (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 *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
+(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
+;; (define *max-cache-size*    0)
+(define *logged-in-clients* (make-hash-table))
+(define *server-id*         #f)
+;; (define *server-info*       #f)  ;; good candidate for easily convert to non-global
+(define *time-to-exit*      #f)
+(define *run-id*            #f)
+(define *server-kind-run*   (make-hash-table))
+(define *home-host*         #f)
+;; (define *total-non-write-delay* 0)
+(define *heartbeat-mutex*   (make-mutex))
+;; (define *api-process-request-count* 0)
+;; (define *max-api-process-requests* 0)
+(define *server-overloaded*  #f)
+
+;; client
+(define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 
+
+;; RPC transport
+(define *rpc:listener*      #f)
+
+;; KEY info
+(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
+(define *keys*              (make-hash-table)) ;; cache the keys here
+(define *keyvals*           (make-hash-table))
+(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
+(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
+(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
+(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
+
+(define *run-info-cache*     (make-hash-table)) ;; run info is stable, no need to reget
+(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
+(define *homehost-mutex*     (make-mutex))
+
+;; Miscellaneous
+(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers
+(define *numcpus-cache* (make-hash-table))
+
+;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
+(let-values (( (chicken-release-number chicken-major-version)
+               (apply values
+                      (map string->number
+                           (take
+                            (string-split (chicken-version) ".")
+                            2)))))
+  (let ((resolve-pathname-broken?
+         (or (> chicken-release-number 4)
+             (and (eq? 4 chicken-release-number) (> chicken-major-version 9)))))
+    (if resolve-pathname-broken?
+        (define ##sys#expand-home-path pathname-expand))))
+      
+(define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
+
+(define (common:get-this-exe-fullpath #!key (argv (argv)))
+  (let* ((this-script
+          (cond
+           ((and (> (length argv) 2)
+                 (string-match "^(.*/csi|csi)$" (car argv))
+                 (string-match "^-(s|ss|sx|script)$" (cadr argv)))
+            (caddr argv))
+           (else (car argv))))
+         (fullpath (realpath this-script)))
+    fullpath))
+
+;;======================================================================
+
+(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
+(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
+(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))
+
+(define (common:get-sync-lock-filepath)
+  (let* ((tmp-area     (common:make-tmpdir-name *toppath* ""))
+         (lockfile     (conc tmp-area "/megatest.db.lock")))
+    lockfile))
+
+(define *common:logpro-exit-code->status-sym-alist*
+  '( ( 0 . pass )
+     ( 1 . fail )
+     ( 2 . warn )
+     ( 3 . check )
+     ( 4 . waived )
+     ( 5 . abort )
+     ( 6 . skip )))
+
+(define (common:logpro-exit-code->status-sym exit-code)
+  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))
+
+(define (common:worse-status-sym ss1 ss2)
+  (let loop ((status-syms-remaining '(abort fail check skip warn waived pass)))
+    (cond
+     ((null? status-syms-remaining)
+      'fail)
+     ((eq? (car status-syms-remaining) ss1)
+      ss1)
+     ((eq? (car status-syms-remaining) ss2)
+      ss2)
+     (else
+      (loop (cdr status-syms-remaining))))))
+
+(define (common:steps-can-proceed-given-status-sym status-sym)
+  (if (member status-sym '(warn waived pass))
+      #t
+      #f))
+
+(define (status-sym->string status-sym)
+  (case status-sym
+      ((pass) "PASS")
+    ((fail) "FAIL")
+    ((warn) "WARN")
+    ((check) "CHECK")
+    ((waived) "WAIVED")
+    ((abort) "ABORT")
+    ((skip) "SKIP")
+    (else "FAIL")))
+
+(define (common:logpro-exit-code->test-status exit-code)
+  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))
+
+;; launching and hosts
+(defstruct host
+  (reachable    #f)
+  (last-update  0)
+  (last-used    0)
+  (last-cpuload 1))
+
+(define *host-loads*         (make-hash-table))
+
+;; cache environment vars for each run here
+(define *env-vars-by-run-id* (make-hash-table))
+
+;; Testconfig and runconfig caches. 
+(define *testconfigs*        (make-hash-table)) ;; test-name => testconfig
+(define *runconfigs*         (make-hash-table)) ;; target    => runconfig
+
+;; This is a cache of pre-reqs met, don't re-calc in cases where called with same params less than
+;; five seconds ago
+(define *pre-reqs-met-cache* (make-hash-table))
+
+;; cache of verbosity given string
+;;
+(define *verbosity-cache*    (make-hash-table))
+
+(define (common:clear-caches)
+  (set! *target*             (make-hash-table))
+  (set! *keys*               (make-hash-table))
+  (set! *keyvals*            (make-hash-table))
+  (set! *toptest-paths*      (make-hash-table))
+  (set! *test-paths*         (make-hash-table))
+  (set! *test-ids*           (make-hash-table))
+  (set! *test-info*          (make-hash-table))
+  (set! *run-info-cache*     (make-hash-table))
+  (set! *env-vars-by-run-id* (make-hash-table))
+  (set! *test-id-cache*      (make-hash-table)))
+
+;; Generic string database
+(define sdb:qry #f) ;; (make-sdb:qry)) ;;  'init #f)
+;; Generic path database
+(define *fdb* #f)
+
+(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
+
 ;; environment vars handy stuff from common.scm
 ;;
 (define getenv get-environment-variable)
 (define (safe-setenv key val)
   (if (or (substring-index "!" key)
@@ -471,58 +699,10 @@
 ;; get the normalized (i.e. load / numcpus) for *this* host
 ;;
 (define (get-normalized-cpu-load)
   (/ (commonmod:get-cpu-load)(get-current-host-cores)))
 
-;;======================================================================
-;; testsuite and area utilites
-;;======================================================================
-
-(define (get-testsuite-name toppath configdat)
-  (or (lookup configdat "setup" "area-name")
-      (lookup configdat "setup" "testsuite")
-      (get-environment-variable "MT_TESTSUITE_NAME")
-      (if (string? toppath)
-          (pathname-file toppath)
-          #f)))
-
-(define (get-area-path-signature toppath #!optional (short #f))
-  (let ((res (message-digest-string (md5-primitive) toppath)))
-    (if short
-	(substring res 0 4)
-	res)))
-
-(define (get-area-name configdat toppath #!optional (short #f))
-  ;; look up my area name in areas table (future)
-  ;; generate auto name
-  (conc (get-area-path-signature toppath short)
-	"-"
-	(get-testsuite-name toppath configdat)))
-
-;; need generic find-record-with-var-nmatching-val
-;;
-(define (path->area-record cfgdat path)
-  (let* ((areadat (get-cfg-areas cfgdat))
-	 (all     (filter (lambda (x)
-			    (let* ((keyvals (cdr x))
-				   (pth     (alist-ref 'path keyvals)))
-			      (equal? path pth)))
-			  areadat)))
-    (if (null? all)
-	#f
-	(car all)))) ;; return first match
-
-;; given a config return an alist of alists
-;;   area-name => data
-;;
-(define (get-cfg-areas cfgdat)
-  (let ((adat (get-section cfgdat "areas")))
-    (map (lambda (entry)
-	   `(,(car entry) . 
-	     ,(val->alist (cadr entry))))
-	 adat)))
-
 ;;======================================================================
 ;; time utils
 ;;======================================================================
 
 (define (common:human-time)
@@ -944,341 +1124,10 @@
   )
 )
 
   
 
-;; GLOBALS
-
-;; CONTEXTS
-(defstruct cxt
-  (taskdb #f)
-  (cmutex (make-mutex)))
-;; (define *contexts* (make-hash-table))
-;; (define *context-mutex* (make-mutex))
-
-;; ;; safe method for accessing a context given a toppath
-;; ;;
-;; (define (common:with-cxt toppath proc)
-;;   (mutex-lock! *context-mutex*)
-;;   (let ((cxt (hash-table-ref/default *contexts* toppath #f)))
-;;     (if (not cxt)
-;;         (set! cxt (let ((x (make-cxt)))(hash-table-set! *contexts* toppath x) x)))
-;;     (let ((cxt-mutex (cxt-mutex cxt)))
-;;       (mutex-unlock! *context-mutex*)
-;;       (mutex-lock! cxt-mutex)
-;;       (let ((res (proc cxt)))
-;;         (mutex-unlock! cxt-mutex)
-;;         res))))
-        
-;; A hash table that can be accessed by #{scheme ...} calls in
-;; config files. Allows communicating between confgs
-;;
-(define *user-hash-data* (make-hash-table))
-
-(define *db-keys* #f)
-
-(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
-(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
-(define *runconfigdat* #f)   ;; run configs data
-(define *configdat*    #f)   ;; megatest.config data
-(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
-;; (define *toppath*      #f) ;; moved to commonmod
-(define *already-seen-runconfig-info* #f)
-
-(define *test-meta-updated* (make-hash-table))
-(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
-(define *passnum*           0) ;; when running track calls to run-tests or similar
-;; (define *alt-log-file* #f)  ;; used by -log
-;; (define *common:denoise*    (make-hash-table)) ;; for low noise printing
-(define *default-log-port*  (current-error-port))
-(define *time-zero* (current-seconds)) ;; for the watchdog
-(define *on-exit-procs* '()) ;; add procs to this list to be executed on exit
-(define *default-area-tag* "local")
-
-;; DATABASE
-;; db access
-(define *db-last-access*      (current-seconds)) ;; last db access, used in server
-;; (define *db-write-access*     #t)
-;; db sync
-;; (define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
-(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
-;; (define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync*
-;; task db
-(define *task-db*             #f) ;; (vector db path-to-db)
-(define *db-access-allowed*   #t) ;; flag to allow access
-;; (define *db-access-mutex*     (make-mutex)) ;; moved to dbfile
-;; (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 *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
-(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
-;; (define *max-cache-size*    0)
-(define *logged-in-clients* (make-hash-table))
-(define *server-id*         #f)
-;; (define *server-info*       #f)  ;; good candidate for easily convert to non-global
-(define *time-to-exit*      #f)
-(define *run-id*            #f)
-(define *server-kind-run*   (make-hash-table))
-(define *home-host*         #f)
-;; (define *total-non-write-delay* 0)
-(define *heartbeat-mutex*   (make-mutex))
-;; (define *api-process-request-count* 0)
-;; (define *max-api-process-requests* 0)
-(define *server-overloaded*  #f)
-
-;; client
-(define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 
-
-;; RPC transport
-(define *rpc:listener*      #f)
-
-;; KEY info
-(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
-(define *keys*              (make-hash-table)) ;; cache the keys here
-(define *keyvals*           (make-hash-table))
-(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
-(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
-(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
-(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
-
-(define *run-info-cache*     (make-hash-table)) ;; run info is stable, no need to reget
-(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
-(define *homehost-mutex*     (make-mutex))
-
-;; Miscellaneous
-(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers
-(define *numcpus-cache* (make-hash-table))
-
-;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
-(let-values (( (chicken-release-number chicken-major-version)
-               (apply values
-                      (map string->number
-                           (take
-                            (string-split (chicken-version) ".")
-                            2)))))
-  (let ((resolve-pathname-broken?
-         (or (> chicken-release-number 4)
-             (and (eq? 4 chicken-release-number) (> chicken-major-version 9)))))
-    (if resolve-pathname-broken?
-        (define ##sys#expand-home-path pathname-expand))))
-      
-(define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
-
-(define (common:get-this-exe-fullpath #!key (argv (argv)))
-  (let* ((this-script
-          (cond
-           ((and (> (length argv) 2)
-                 (string-match "^(.*/csi|csi)$" (car argv))
-                 (string-match "^-(s|ss|sx|script)$" (cadr argv)))
-            (caddr argv))
-           (else (car argv))))
-         (fullpath (realpath this-script)))
-    fullpath))
-
-;;======================================================================
-
-(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
-(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
-(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))
-
-(define (common:get-sync-lock-filepath)
-  (let* ((tmp-area     (common:make-tmpdir-name *toppath* ""))
-         (lockfile     (conc tmp-area "/megatest.db.lock")))
-    lockfile))
-
-(define *common:logpro-exit-code->status-sym-alist*
-  '( ( 0 . pass )
-     ( 1 . fail )
-     ( 2 . warn )
-     ( 3 . check )
-     ( 4 . waived )
-     ( 5 . abort )
-     ( 6 . skip )))
-
-(define (common:logpro-exit-code->status-sym exit-code)
-  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))
-
-(define (common:worse-status-sym ss1 ss2)
-  (let loop ((status-syms-remaining '(abort fail check skip warn waived pass)))
-    (cond
-     ((null? status-syms-remaining)
-      'fail)
-     ((eq? (car status-syms-remaining) ss1)
-      ss1)
-     ((eq? (car status-syms-remaining) ss2)
-      ss2)
-     (else
-      (loop (cdr status-syms-remaining))))))
-
-(define (common:steps-can-proceed-given-status-sym status-sym)
-  (if (member status-sym '(warn waived pass))
-      #t
-      #f))
-
-(define (status-sym->string status-sym)
-  (case status-sym
-      ((pass) "PASS")
-    ((fail) "FAIL")
-    ((warn) "WARN")
-    ((check) "CHECK")
-    ((waived) "WAIVED")
-    ((abort) "ABORT")
-    ((skip) "SKIP")
-    (else "FAIL")))
-
-(define (common:logpro-exit-code->test-status exit-code)
-  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))
-
-;; 
-(defstruct remote
-
-  ;; transport to be used
-  ;; http              - use http-transport
-  ;; http-read-cached  - use http-transport for writes but in-mem cached for reads
-  (rmode            'http)
-  (hh-dat            (let ((res (or (server:choose-server *toppath* 'homehost)
-				    (cons #f #f))))
-		       (assert (pair? res)(conc "FATAL: hh-dat should be a pair, got "res))
-		       res))
-  (server-url        #f) ;; (server:check-if-running *toppath*) #f))
-  (server-id         #f)
-  (server-info       #f) ;; (if *toppath* (server:check-if-running *toppath*) #f))
-  (last-server-check 0)  ;; last time we checked to see if the server was alive
-  (connect-time      (current-seconds)) ;; when we first connected
-  (last-access       (current-seconds)) ;; last time we talked to server
-  ;; (conndat           #f) ;; iface port api-uri api-url api-req seconds server-id
-  (server-timeout    (server:expiration-timeout))
-  (force-server      #f)
-  (ro-mode           #f)  
-  (ro-mode-checked   #f) ;; flag that indicates we have checked for ro-mode
-
-  ;; conndat stuff
-  (iface             #f) ;; TODO: Consolidate this data with server-url and server-info above
-  (port              #f)
-  (api-url           #f)
-  (api-uri           #f)
-  (api-req           #f))
-
-;; launching and hosts
-(defstruct host
-  (reachable    #f)
-  (last-update  0)
-  (last-used    0)
-  (last-cpuload 1))
-
-(define *host-loads*         (make-hash-table))
-
-;; cache environment vars for each run here
-(define *env-vars-by-run-id* (make-hash-table))
-
-;; Testconfig and runconfig caches. 
-(define *testconfigs*        (make-hash-table)) ;; test-name => testconfig
-(define *runconfigs*         (make-hash-table)) ;; target    => runconfig
-
-;; This is a cache of pre-reqs met, don't re-calc in cases where called with same params less than
-;; five seconds ago
-(define *pre-reqs-met-cache* (make-hash-table))
-
-;; cache of verbosity given string
-;;
-(define *verbosity-cache*    (make-hash-table))
-
-(define (common:clear-caches)
-  (set! *target*             (make-hash-table))
-  (set! *keys*               (make-hash-table))
-  (set! *keyvals*            (make-hash-table))
-  (set! *toptest-paths*      (make-hash-table))
-  (set! *test-paths*         (make-hash-table))
-  (set! *test-ids*           (make-hash-table))
-  (set! *test-info*          (make-hash-table))
-  (set! *run-info-cache*     (make-hash-table))
-  (set! *env-vars-by-run-id* (make-hash-table))
-  (set! *test-id-cache*      (make-hash-table)))
-
-;; Generic string database
-(define sdb:qry #f) ;; (make-sdb:qry)) ;;  'init #f)
-;; Generic path database
-(define *fdb* #f)
-
-(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
-
-;;======================================================================
-;; V E R S I O N
-;;======================================================================
-
-(define (common:get-full-version)
-  (conc megatest-version "-" megatest-fossil-hash))
-
-(define (common:version-signature)
-  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
-
-;;======================================================================
-;; from metadat lookup MEGATEST_VERSION
-;;
-(define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB
-  (rmt:get-var "MEGATEST_VERSION"))
-
-(define (common:get-last-run-version-number)
-  (string->number 
-   (substring (common:get-last-run-version) 0 6)))
-
-(define (common:set-last-run-version)
-  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))
-
-;;======================================================================
-;; postive number if megatest version > db version
-;; negative number if megatest version < db version
-(define (common:version-db-delta)
-  (- megatest-version (common:get-last-run-version-number)))
-
-(define (common:version-changed?)
-  (not (equal? (common:get-last-run-version)
-               (common:version-signature))))
-
-
-;; From 1.70 to 1.80, db's are compatible.
-
-(define (common:api-changed?)
-  (let* (
-    (megatest-major-version (substring (->string megatest-version) 0 4))
-    (run-major-version (substring (conc (common:get-last-run-version)) 0 4))
-   )
-   (and (not (equal? megatest-major-version "1.80"))
-     (not (equal? megatest-major-version megatest-run-version)))
-  )
-)
-
-;;======================================================================
-;; Move me elsewhere ...
-;; RADT => Why do we meed the version check here, this is called only if version misma
-;;
-(define (common:cleanup-db dbstruct #!key (full #f))
-  (case (rmt:transport-mode)
-    ((http)
-     (apply db:multi-db-sync 
-	    dbstruct
-	    'schema
-	    'killservers
-	    'adj-target
-	    'new2old
-	    '(dejunk)
-	    ))
-    ((tcp nfs)
-     (apply db:multi-db-sync 
-	    dbstruct
-	    'schema
-	    'killservers
-	    'adj-target
-	    'new2old
-	    '(dejunk)
-	    )))
-  (if (common:api-changed?)
-      (common:set-last-run-version)))
-
 (define (common:snapshot-file filepath #!key (subdir  ".") )
   (if (file-exists? filepath)
       (let* ((age-sec  (lambda (file)
                          (if (file-exists? file)
                              (- (current-seconds) (file-modification-time file))
@@ -1355,144 +1204,10 @@
           (copy daysfile wksfile)
           (copy hrsfile daysfile))
         #t)
       #f))
 
-;;======================================================================
-;; Rotate logs, logic: 
-;;                 if > 500k and older than 1 week:
-;;                     remove previous compressed log and compress this log
-;; WARNING: This proc operates assuming that it is in the directory above the
-;;          logs directory you wish to log-rotate.
-;;
-(define (common:rotate-logs)
-  (let* ((all-files (make-hash-table))
-	 (stats     (make-hash-table))
-	 (inc-stat  (lambda (key)
-		      (hash-table-set! stats key (+ (hash-table-ref/default stats key 0) 1))))
-	(max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "600")))) ;; name -> age
-    (if (not (directory-exists? "logs"))(create-directory "logs"))
-    (directory-fold 
-     (lambda (file rem)
-       (handle-exceptions
-	exn
-	(begin
-	  (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore. exn=" exn)
-	  (debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-	  ;; (print-call-chain (current-error-port)) ;; 
-	  )
-	(let* ((fullname  (conc "logs/" file))
-	       (mod-time  (file-modification-time fullname))
-	       (file-age  (- (current-seconds) mod-time))
-	       (file-old  (> file-age (* 48 60 60)))
-	       (file-big  (> (file-size fullname) 200000)))
-	  (hash-table-set! all-files file mod-time)
-	  (if (or (and (string-match "^.*.log" file)
-		       file-old
-		       file-big)
-		  (and (string-match "^server-.*.log" file)
-		       file-old))
-	      (let ((gzfile (conc fullname ".gz")))
-		(if (common:file-exists? gzfile)
-		    (begin
-		      (debug:print-info 0 *default-log-port* "removing " gzfile)
-		      (delete-file* gzfile)
-		      (hash-table-delete!  all-files gzfile) ;; needed?
-		      ))
-		(debug:print-info 0 *default-log-port* "compressing " file)
-		(system (conc "gzip " fullname))
-		(inc-stat "gzipped")
-		(hash-table-set! all-files (conc file ".gz") file-age)  ;; add the .gz file and remove the base file
-		(hash-table-delete! all-files file)
-		)
-	      (if (and (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
-		       (file-exists? fullname)) ;; just in case it was gzipped - will get it next time
-		  (handle-exceptions
-		   exn
-		   #f
-		   (if (directory? fullname)
-		       (begin
-			 (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
-			 (inc-stat "directories"))
-		       (begin
-			 (delete-file* fullname)
-			 (inc-stat "deleted")))
-		   (hash-table-delete! all-files file)))))))
-     '()
-     "logs")
-    (for-each
-     (lambda (category)
-       (let ((quant (hash-table-ref/default stats category 0)))
-	 (if (> quant 0)
-	     (debug:print-info 0 *default-log-port* category " log files: " quant))))
-     `("deleted" "gzipped" "directories"))
-    (let ((num-logs (hash-table-size all-files)))
-      (if (> num-logs max-allowed) ;; because NFS => don't let number of logs exceed 300
-	  (let ((files (take (sort (hash-table-keys all-files)
-				   (lambda (a b)
-				     (< (hash-table-ref all-files a)(hash-table-ref all-files b))))
-			     (- num-logs max-allowed))))
-	    (for-each
-	     (lambda (file)
-	       (let* ((fullname (conc "logs/" file)))
-		 (if (directory? fullname)
-		     (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
-		     (handle-exceptions
-		      exn
-		      (debug:print-error 0 *default-log-port* "failed to remove " fullname ", exn=" exn)
-		      (delete-file* fullname)))))
-	     files)
-	    (debug:print-info 0 *default-log-port* "Deleted " (length files) " files from logs, keeping " max-allowed " files."))))))
-
-;;======================================================================
-;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
-;; Do NOT check if not on homehost!
-;;
-(define (common:exit-on-version-changed)
-  (if (and *toppath*              ;; do nothing if *toppath* not yet provided
-	   (common:on-homehost?))
-      (if (common:api-changed?)
-	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
-                 (dbfile  (conc (get-environment-variable "MT_RUN_AREA_HOME") ".mtdb/main.db"))
-                 (read-only (not (file-write-access? dbfile)))
-                 (dbstruct (db:setup))) ;; (db:setup-db *dbstruct-dbs* *toppath* #f))) ;;  #t)))
-	    (debug:print 0 *default-log-port*
-			 "WARNING: Version mismatch!\n"
-			 "   expected: " (common:version-signature) "\n"
-			 "   got:      " (common:get-last-run-version))
-            (cond
-             ((get-environment-variable "MT_SKIP_DB_MIGRATE") #t)
-             ((and (common:file-exists? mtconf) (common:file-exists? dbfile) (not read-only)
-                   (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
-              (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
-              (handle-exceptions
-               exn
-               (begin
-                 (debug:print 0 *default-log-port* "Failed to switch versions. exn=" exn)
-                 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-                 (print-call-chain (current-error-port))
-                 (exit 1))
-               (common:cleanup-db dbstruct)))
-             ((not (common:file-exists? mtconf))
-              (debug:print 0 *default-log-port* "   megatest.config does not exist in this area.  Cannot proceed with megatest version migration.")
-              (exit 1))
-             ((not (common:file-exists? dbfile))
-              (debug:print 0 *default-log-port* "   .mtdb/main.db does not exist in this area.  Cannot proceed with megatest version migration.")
-              (exit 1))
-             ((not (eq? (current-user-id)(file-owner mtconf)))
-              (debug:print 0 *default-log-port* "   You do not own .mtdb/main.db in this area.  Cannot proceed with megatest version migration.")
-              (exit 1))
-             (read-only
-              (debug:print 0 *default-log-port* "   You have read-only access to this area.  Cannot proceed with megatest version migration.")
-              (exit 1))
-             (else
-              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
-              (exit 1)))))))
-;;======================================================================
-;;      (begin
-;;	(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
-;;	(exit 1))))
 
 ;;======================================================================
 ;; S P A R S E   A R R A Y S
 ;;======================================================================
 
@@ -1517,27 +1232,10 @@
 	(sparse-vector-set! row y val)
 	(let ((new-row (make-sparse-vector)))
 	  (sparse-vector-set! a x new-row)
 	  (sparse-vector-set! new-row y val)))))
 
-;;======================================================================
-;; L O C K E R S   A N D   B L O C K E R S 
-;;======================================================================
-
-;; block further accesses to databases. Call this before shutting db down
-(define (common:db-block-further-queries)
-  (mutex-lock! *db-access-mutex*)
-  (set! *db-access-allowed* #f)
-  (mutex-unlock! *db-access-mutex*))
-
-(define (common:db-access-allowed?)
-  (let ((val (begin
-	       (mutex-lock! *db-access-mutex*)
-	       *db-access-allowed*
-	       (mutex-unlock! *db-access-mutex*))))
-    val))
-
 ;;======================================================================
 ;; U S E F U L   S T U F F
 ;;======================================================================
 
 ;; convert things to an alist or assoc list, #f gets converted to ""
@@ -1731,20 +1429,10 @@
 
 (define (assoc/default key lst . default)
   (let ((res (assoc key lst)))
     (if res (cadr res)(if (null? default) #f (car default)))))
 
-(define (common:get-testsuite-name)
-  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
-      (configf:lookup *configdat* "setup" "testsuite" )
-      (getenv "MT_TESTSUITE_NAME")
-      (pathname-file (or (if (string? *toppath* )
-			     (pathname-file *toppath*)
-			     #f)
-			 (common:get-toppath #f)))
-      "please-set-setup-area-name")) ;; (pathname-file (current-directory)))))
-
 ;;======================================================================
 ;; safe getting of toppath
 (define (common:get-toppath areapath)
   (or *toppath*
       (if areapath
@@ -1768,82 +1456,20 @@
 		  #f)
 		(loop (pathname-directory thepath)))))
       ))
 
 
-;;======================================================================
-;; redefine for future cleanup (converge on area-name, the more generic
-;;
-(define common:get-area-name common:get-testsuite-name)
-
-(define (common:get-db-tmp-area . junk)
-  (if *db-cache-path*
-      *db-cache-path*
-      (if *toppath* ;; common:get-create-writeable-dir
-	  (handle-exceptions
-	      exn
-	      (begin
-		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path* ", exn=" exn)
-		(exit 1))
-	      (let* ((toppath (common:real-path *toppath*))
-		     (tsname (common:get-testsuite-name))
-		     (dbpath (common:get-create-writeable-dir
-			      (list (conc "/tmp/" (current-user-name)
-					  "/megatest_localdb/"
-					  tsname "/"
-					  (string-translate toppath "/" "."))
-				    (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
-					  "/"(current-user-name) "/megatest_localdb/"
-					  tsname
-					  (string-translate toppath "/" "."))
-				    ))))
-		(set! *db-cache-path* dbpath)
-		;; ensure megatest area has .mtdb
-		(let ((dbarea (conc *toppath* "/.mtdb")))
-		  (if (not (file-exists? dbarea))
-		      (create-directory dbarea)))
-		;; ensure tmp area has .mtdb
-		(let ((dbarea (conc dbpath "/.mtdb")))
-		  (if (not (file-exists? dbarea))
-		      (create-directory dbarea)))
-		dbpath))
-	  #f)))
+(define (get-area-path-signature toppath #!optional (short #f))
+  (let ((res (message-digest-string (md5-primitive) toppath)))
+    (if short
+	(substring res 0 4)
+	res)))
+
 
 (define (common:get-area-path-signature)
   (message-digest-string (md5-primitive) *toppath*))
 
-;;======================================================================
-;; E X I T   H A N D L I N G
-;;======================================================================
-
-(define (common:run-sync?)
-  (and *toppath*               ;; gate if called before *toppath* is set
-       (common:on-homehost?)
-       (args:get-arg "-server")))
-
-
-(define (std-signal-handler signum)
-  ;; (signal-mask! signum)
-  (set! *time-to-exit* #t) 
-  ;;(debug:print-info 13 *default-log-port* "got signal "signum)
-  (debug:print-error 0 *default-log-port* "Received signal " signum " aaa exiting promptly")
-  ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway
-  (exit))
-
-(define (special-signal-handler signum)
-  ;; (signal-mask! signum)
-  (set! *time-to-exit* #t)
-  ;;(debug:print-info 13 *default-log-port* "got signal "signum)
-  (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting!!")
-  ;;TODO send email to notify admin contact listed in the config that the lisner got killed
-  ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway
-  (exit))
-
-
-(set-signal-handler! signal/int  std-signal-handler)  ;; ^C
-(set-signal-handler! signal/term std-signal-handler)
-
 ;; (set-signal-handler! signal/stop std-signal-handler)  ;; ^Z NO, do NOT handle ^Z!
 
 ;;======================================================================
 ;; M I S C   U T I L S
 ;;======================================================================
@@ -1873,28 +1499,10 @@
 		 (set! res #t))))
 	 (string-split patts ","))
 	res)
       #t))
 
-;;======================================================================
-;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
-(define (common:get-disks #!key (configf #f))
-  (hash-table-ref/default 
-   (or configf (read-config "megatest.config" #f #t))
-   "disks" '("none" "")))
-
-(define (common:get-install-area)
-  (let ((exe-path (car (argv))))
-    (if (common:file-exists? exe-path)
-	(handle-exceptions
-	 exn
-	 #f
-	 (pathname-directory
-	  (pathname-directory 
-	   (pathname-directory exe-path))))
-	#f)))
-
 ;;======================================================================
 ;; return first path that can be created or already exists and is writable
 ;;
 (define (common:get-create-writeable-dir dirs)
   (if (null? dirs)
@@ -1961,177 +1569,10 @@
       inlst
       (begin
 	(if message (debug:print-error 0 *default-log-port* message))
 	(or ovrd '()))))
   
-;;======================================================================
-;; T A R G E T S  ,   S T A T E ,   S T A T U S ,   
-;;                    R U N N A M E    A N D   T E S T P A T T
-;;======================================================================
-
-;;======================================================================
-;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
-;;
-(define (common:get-runconfig-targets #!key (configf #f))
-  (let ((targs       (sort (map car (hash-table->alist
-				     (or configf ;; NOTE: There is no value in using runconfig:read here.
-					 (read-config (conc *toppath* "/runconfigs.config")
-						      #f #t)
-					 (make-hash-table))))
-			   string<?))
-	(target-patt (args:get-arg "-target")))
-    (if target-patt
-	(filter (lambda (x)
-		  (patt-list-match x target-patt))
-		targs)
-	targs)))
-
-;;======================================================================
-;; Lookup a value in runconfigs based on -reqtarg or -target
-;; 
-(define (runconfigs-get config var)
-  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
-    (if targ
-	(or (configf:lookup config targ var)
-	    (configf:lookup config "default" var))
-	(configf:lookup config "default" var))))
-
-(define (common:args-get-state)
-  (or (args:get-arg "-state")(args:get-arg ":state")))
-
-(define (common:args-get-status)
-  (or (args:get-arg "-status")(args:get-arg ":status")))
-
-(define (common:args-get-testpatt rconf)
-  (let* (;; (tagexpr       (args:get-arg "-tagexpr"))
-         ;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
-         (testpatt-key  (or (args:get-arg "-modepatt") (args:get-arg "--modepatt") "TESTPATT"))
-         (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
-         (rtestpatt     (if rconf (runconfigs-get rconf testpatt-key) #f)))
-    (cond
-     ((or (args:get-arg "--modepatt") (args:get-arg "-modepatt")) ;; modepatt is a forced setting, when set it MUST refer to an existing PATT in the runconfig
-      (if rconf
-	  (let* ((patts-from-mode-patt	  (runconfigs-get rconf testpatt-key)))
-	    (debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key " "  patts-from-mode-patt)
-	    patts-from-mode-patt)
-	  (begin
-	    (debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key) ;;  " " patts-from-mode-patt)
-	    #f)))     ;; We do NOT fall back to "%"
-     ;; (tags-testpatt
-     ;;  (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
-     ;;  tags-testpatt)
-     ((and (equal? args-testpatt "%") rtestpatt)
-      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
-      rtestpatt)
-     (else 
-      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
-      args-testpatt))))
-
-
-(define (common:get-linktree)
-  (or (getenv "MT_LINKTREE")
-      (if *configdat*
-	  (configf:lookup *configdat* "setup" "linktree")
-	  #f)
-      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
-	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
-	  #f)
-      (let* ((tp (common:get-toppath #f))
-	     (lt (conc tp "/lt")))
-	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
-	lt)))
-
-(define (common:args-get-runname)
-  (let ((res (or (args:get-arg "-runname")
-		 (args:get-arg ":runname")
-		 (getenv "MT_RUNNAME"))))
-    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
-    res))
-
-(define (common:get-fields cfgdat)
-  (let ((fields (hash-table-ref/default cfgdat "fields" '())))
-    (map car fields)))
-
-(define (common:args-get-target #!key (split #f)(exit-if-bad #f))
-  (let* ((keys    (if (hash-table? *configdat*) (common:get-fields *configdat*) '()))
-	 (numkeys (length keys))
-	 (target  (or (args:get-arg "-reqtarg")
-		      (args:get-arg "-target")
-		      (getenv "MT_TARGET")))
-	 (tlist   (if target (string-split target "/" #t) '()))
-	 (valid   (if target
-		      (or (null? keys) ;; probably don't know our keys yet
-			  (and (not (null? tlist))
-			       (eq? numkeys (length tlist))
-			       (null? (filter string-null? tlist))))
-		      #f)))
-    (if valid
-	(if split
-	    tlist
-	    target)
-	(if target
-	    (begin
-	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
-	      (if exit-if-bad (exit 1))
-	      #f)
-	    #f))))
-
-;;======================================================================
-;; looking only (at least for now) at the MT_ variables craft the full testname
-;;
-(define (common:get-full-test-name)
-  (if (getenv "MT_TEST_NAME")
-      (if (and (getenv "MT_ITEMPATH")
-               (not (equal? (getenv "MT_ITEMPATH") "")))
-          (getenv "MT_TEST_NAME")
-          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
-      #f))
-
-;;======================================================================
-;; logic for getting homehost. Returns (host . at-home)
-;; IF *toppath* is not set, wait up to five seconds trying every two seconds
-;; (this is to accomodate the watchdog)
-;;
-
-;;======================================================================
-;; do we honor the caches of the config files?
-;;
-(define (common:use-cache?)
-  (let ((res #t)) ;; priority by order of evaluation
-    (if *configdat* ;; sillyness here. can't use setup/use-cache to know if we can use the cached files!
-	(if (equal? (configf:lookup *configdat* "setup" "use-cache") "no")
-	    (set! res #f)
-	    (if (equal? (configf:lookup *configdat* "setup" "use-cache") "yes")
-		(set! res #t))))
-    (if (args:get-arg "-no-cache")(set! res #f)) ;; overrides setting in "setup"
-    (if (getenv "MT_USE_CACHE")
-	(if (equal? (getenv "MT_USE_CACHE") "yes")
-	    (set! res #t)
-	    (if (equal? (getenv "MT_USE_CACHE") "no")
-		(set! res #f))))    ;; overrides -no-cache switch
-    res))
-  
-;;======================================================================
-;; force use of server?
-;;
-(define (common:force-server?)
-  (let* ((force-setting (configf:lookup *configdat* "server" "force"))
-	 (force-type    (if force-setting (string->symbol force-setting) #f))
-	 (force-result  (case force-type
-			  ((#f)     #f)
-			  ((always) #t)
-			  ((test)   (if (args:get-arg "-execute") ;; we are in a test
-					#t
-					#f))
-			  (else
-			   (debug:print 0 *default-log-port* "ERROR: Bad server force setting " force-setting ", forcing server.")
-			   #t)))) ;; default to requiring server
-    (if force-result
-	(begin
-	  (debug:print-info 0 *default-log-port* "ATTENTION! Forcing use of server, force setting is \"" force-setting "\".")
-	  #t)
-	#f)))
 
 ;;======================================================================
 ;; M I S C   L I S T S
 ;;======================================================================
 
@@ -2368,64 +1809,10 @@
       onemin
       (let* ((load-change (- onemin fivemin))
 	     (tchange     (- 300 60)))
 	(max (+ onemin (* 60 (/ load-change tchange))) 0))))
 
-;;======================================================================
-;; calculate a delay number based on a droop curve
-;;    inputs are:
-;;      - load-in, load as from uptime, NOT normalized
-;;      - numcpus, number of cpus, ideally use the real cpus, not threads
-;;
-(define (common:get-delay load-in numcpus)
-  (let* ((ratio (/ load-in numcpus))
-         (new-option (configf:lookup *configdat* "load" "new-load-method"))
-	 (paramstr   (or (configf:lookup *configdat* "load" "exp-params")
-			 "15 12 1281453987.9543 0.75")) ;; 5 4 10 1"))
-	 (paramlst   (map string->number (string-split paramstr))))
-    (if new-option
-	(begin
-          (cond ((and (>= ratio 0) (< ratio .5))
-		 0)
-		((and (>= ratio 0.5) (<= ratio .9))
-		 (* ratio (/ 5 .9)))
-		((and (> ratio .9) (<= ratio 1.1))
-		 (+ 5 (* (- ratio .9) (/ 55 .2)))) 
-		((> ratio 1.1)
-		 60)))
-	(match paramlst
-	  ((r1 r2 s1 s2)
-	   (debug:print 3 *default-log-port* "Using params r1=" r1 " r2=" r2 " s1=" s1 " s2=" s2)
-	   (min (max (/ (expt r1 (* r2 s2 ratio)) s1) 0) 30))
-	  (else
-	   (debug:print 0 *default-log-port* "BAD exp-params, should be \"r1 r2 s1 s2\" but got " paramstr)
-	   30)))))
-
-;; -mrw- this appears to not be used
-;;
-;; (define (common:print-delay-table)
-;;   (let loop ((x 0))
-;;     (print x "," (common:get-delay x 1))
-;;     (if (< x 2)
-;; 	(loop (+ x 0.1)))))
-
-;; (define (get-cpu-load #!key (remote-host #f))
-;;    (car (common:get-cpu-load remote-host)))
-
-;;======================================================================
-;;   (let* ((load-res (process:cmd-run->list "uptime"))
-;; 	 (load-rx  (regexp "load average:\\s+(\\d+)"))
-;; 	 (cpu-load #f))
-;;     (for-each (lambda (l)
-;; 		(let ((match (string-search load-rx l)))
-;; 		  (if match
-;; 		      (let ((newval (string->number (cadr match))))
-;; 			(if (number? newval)
-;; 			    (set! cpu-load newval))))))
-;; 	      (car load-res))
-;;     cpu-load))
-
 ;;======================================================================
 ;; get values from cached info from dropping file in .sysdata dir
 ;;  e.g. key is host and dtype is normalized-load
 ;;
 (define (common:get-cached-info key dtype #!key (age 10))
@@ -2612,151 +1999,10 @@
 
 (define (common:unix-ping hostname)
   (let ((res (system (conc "ping -c 1 " hostname " > /dev/null"))))
     (eq? res 0)))
 
-;;======================================================================
-;; ideally put all this info into the db, no need to preserve it across moving homehost
-;;
-;; return list of
-;;  ( reachable? cpuload update-time )
-(define (common:get-host-info hostname)
-  (let* ((loadinfo                         (rmt:get-latest-host-load hostname)) ;; if this host happens to have been recently used by a test reuse the load data
-         (load                             (car loadinfo))
-         (load-sample-time                 (cdr loadinfo))
-         (load-sample-age                  (- (current-seconds) load-sample-time))
-         (loadinfo-timeout-seconds         6) ;; this was 20 seconds, seems way too lax. Switch to 6 seconds
-         (host-last-update-timeout-seconds 4)
-         (host-rec (hash-table-ref/default *host-loads* hostname #f))
-         )
-    (cond
-     ((< load-sample-age loadinfo-timeout-seconds)
-      (list #t
-            load-sample-time
-            load))
-     ((and host-rec
-           (< (current-seconds) (+ (host-last-update host-rec) host-last-update-timeout-seconds)))
-      (list #t
-            (host-last-update host-rec)
-            (host-last-cpuload host-rec )))
-     ((common:unix-ping hostname)
-      (list #t
-            (current-seconds)
-            (alist-ref 'adj-core-load (common:get-normalized-cpu-load hostname)))) ;; this is cheaper than you might think. get-normalized-cpu-load is cached for up to 5 seconds
-     (else
-      (list #f 0 -1) ;; bad host, don't use!
-      ))))
-
-;;======================================================================
-;; see defstruct host at top of file.
-;;    host: reachable last-update last-used last-cpuload
-;;
-(define (common:update-host-loads-table hosts-raw)
-  (let* ((hosts (filter (lambda (x)
-                          (string-match (regexp "^\\S+$") x))
-                        hosts-raw)))
-    (for-each
-     (lambda (hostname)
-       (let* ((rec       (let ((h (hash-table-ref/default *host-loads* hostname #f)))
-                          (if h
-                              h
-                              (let ((h (make-host)))
-                                (hash-table-set! *host-loads* hostname h)
-                                h))))
-              (host-info         (common:get-host-info hostname))
-              (is-reachable      (car host-info))
-              (last-reached-time (cadr host-info))
-              (load              (caddr host-info)))
-         (host-reachable-set!    rec is-reachable)
-         (host-last-update-set!  rec last-reached-time)
-         (host-last-cpuload-set! rec load)))
-     hosts)))
-
-;;======================================================================
-;; go through the hosts from least recently used to most recently used, pick the first that meets the load criteral from the
-;; [host-rules] section.
-;;
-(define (common:get-least-loaded-host hosts-raw host-type configdat)
-  (let* ((rdat       (configf:lookup configdat "host-rules" host-type))
-	 (rules      (common:val->alist (or rdat "") convert: #t))   ;; maxnload, maxnjobs, maxjobrate
-	 (maxnload   (common:alist-ref/default 'maxnload rules 1.5)) ;; max normalized load
-	 (maxnjobs   (common:alist-ref/default 'maxnjobs rules 1.5)) ;; max normalized number of jobs
-	 (maxjobrate (common:alist-ref/default 'maxjobrate rules (/ 1 6))) ;; max rate of submitting jobs to a given host in jobs/second
-	 (hosts      (filter (lambda (x)
-			       (string-match (regexp "^\\S+$") x))
-			     hosts-raw))
-         ;; (best-host #f)
-	 (get-rec    (lambda (hostname)
-		       ;; (print "get-rec hostname=" hostname)
-		       (let ((h (hash-table-ref/default *host-loads* hostname #f)))
-			 (if h
-			     h
-			     (let ((h (make-host)))
-			       (hash-table-set! *host-loads* hostname h)
-			       h)))))
-         (best-load 99999)
-         (curr-time (current-seconds))
-	 (get-hosts-sorted (lambda (hosts)
-			     (sort hosts (lambda (a b)
-					   (let ((a-rec (get-rec a))
-						 (b-rec (get-rec b)))
-					     ;; (print "a=" a " a-rec=" a-rec " host-last-used=" (host-last-used a-rec))
-					     ;; (print "b=" b " b-rec=" b-rec " host-last-used=" (host-last-used b-rec))
-					     (< (host-last-used a-rec)
-						(host-last-used b-rec))))))))
-    (debug:print 0 *default-log-port* "INFO: hosts-sorted=" (get-hosts-sorted hosts))
-    (if (null? hosts)
-	#f ;; no hosts to select from. All done and giving up now.
-	(let ((hosts-sorted (get-hosts-sorted hosts)))
-	  (common:update-host-loads-table hosts)
-	  (let loop ((hostname  (car hosts-sorted))
-		     (tal       (cdr hosts-sorted))
-		     (best-host #f))
-	    (let* ((rec       (get-rec hostname))
-		   (reachable (host-reachable     rec))
-		   (load      (host-last-cpuload  rec))
-		   (last-used (host-last-used     rec))
-		   (delta     (- curr-time last-used))
-		   (job-rate  (if (> delta 0)
-				  (/ 1 delta)
-				  999)) ;; jobs per second
-		   (new-best  
-		    (cond
-		     ((not reachable)
-		      (debug:print 0 *default-log-port* "Skipping host " hostname " as it cannot be reached.")
-		      best-host)
-		     ((and (< load maxnload)        ;; load is acceptable
-			   (< job-rate maxjobrate)) ;; job rate is acceptable
-		      (set! best-load load)
-		      hostname)
-		     (else best-host))))
-	      (debug:print 0 *default-log-port* "INFO: Trying host " hostname " with load " load ", last used " delta " seconds ago, with job-rate " job-rate " for running a test." )
-	      (if new-best
-		  (begin ;; found a host, return it
-		    (debug:print 0 *default-log-port* "INFO: Found host: " new-best " load: " load " last-used: " delta " seconds ago, with job-rate: " job-rate)
-		    (host-last-used-set! rec curr-time)
-		    new-best)
-		  (if (null? tal) #f (loop (car tal)(cdr tal) best-host)))))))))
-
-(define (common:wait-for-homehost-load maxnormload msg)
-  (let loop ((start-time (current-seconds))) ;; we saw some instances of this being called before *toppath* was set. This might be an early setup race. This delay should help but it is impossible to test...
-    (if (not *toppath*)
-	(begin
-	  (debug:print 0 *default-log-port* "ERROR: common:wait-for-homehost-load called before *toppath* set.")
-	  (thread-sleep! 30)
-	  (if (< (- (current-seconds) start-time) 300)
-	      (loop start-time)))))
-  (case (rmt:transport-mode)
-    ((http)
-     (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
-			#f
-			(server:choose-server *toppath* 'homehost)))
-            (hh     (if hh-dat (car hh-dat) #f)))
-       (common:wait-for-normalized-load maxnormload msg hh)))
-    (else
-     (common:wait-for-normalized-load maxnormload msg (get-host-name)))))
-    
 (define (common:get-num-cpus remote-host)
   (let* ((actual-host (or remote-host (get-host-name))))
     ;; hosts had better not be changing the number of cpus too often!
     (or (hash-table-ref/default *numcpus-cache* actual-host #f)
 	(let* ((numcpus (or (common:get-cached-info actual-host "num-cpus" age: (+ 2592000 (random 3600)))
@@ -2782,342 +2028,10 @@
 				  (common:write-cached-info actual-host "num-cpus" result))
 			      result))))
 	  (hash-table-set! *numcpus-cache* actual-host numcpus)
 	  numcpus))))
 
-;;======================================================================
-;; wait for normalized cpu load to drop below maxload
-;;
-(define (common:wait-for-normalized-load maxnormload msg remote-host #!optional (rem-tries 5))
-  (let ((num-cpus (common:get-num-cpus remote-host)))
-    (if num-cpus
-	(common:wait-for-cpuload maxnormload num-cpus 15 msg: msg remote-host: remote-host)
-	(begin
-	  (thread-sleep! (random 60)) ;; we failed to get num cpus. wait a bit and try again
-	  (if (> rem-tries 0)
-	      (common:wait-for-normalized-load maxnormload msg remote-host (- rem-tries 1))
-	      #f)))))
-
-;;======================================================================
-;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
-;;   count     - count down to zero, at some point we'd give up if the load never drops
-;;   num-tries - count down to zero number tries to get numcpus
-;;
-(define (common:wait-for-cpuload maxnormload numcpus-in
-				 #!key (count 1000)
-				 (msg #f)(remote-host #f)(num-tries 5))
-  (let* ((loadavg     (common:get-cpu-load remote-host))
-    ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
-    (numcpus     (if (<= 1 numcpus-in)
-    (common:get-num-cpus remote-host) numcpus-in))
-    (first       (car loadavg))
-    (next        (cadr loadavg))
-    (adjmaxload  (* maxnormload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude
-						  ;; fallback is to at least use 1
-    ;; effective load accounts for load jumps, this should elminate all the first-next-avg, adjwait, load-jump-limit
-    ;; etc.
-    (effective-load    (common:get-intercept first next))
-    (recommended-delay (common:get-delay effective-load numcpus))
-    (effective-host    (or remote-host "localhost"))
-    (normalized-effective-load (/ effective-load numcpus))
-    (will-wait                 (> normalized-effective-load maxnormload)))
-    (if (and will-wait (> recommended-delay 1)) 
-      (let* ((actual-delay (min recommended-delay 30)))
-        (if (common:low-noise-print 30 (conc (round actual-delay) "-safe-load"))
-          (debug:print-info 0 *default-log-port* "Load control, delaying "
-				actual-delay " seconds to maintain safe load. current normalized effective load is "
-				normalized-effective-load". maxnormload = " maxnormload " numcpus = " numcpus " loadavg = " loadavg " effective-load = " effective-load))
-	(thread-sleep! actual-delay)))
-    
-    (cond
-     ;; bad data, try again to get the data
-     ((not will-wait)
-      (if (common:low-noise-print 3600 (conc (round normalized-effective-load) "-load-acceptable-" effective-host))
-      	  (debug:print 0 *default-log-port* "Effective load on " effective-host " is acceptable at " effective-load " continuing.")))
-
-     ((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
-	   (> num-tries 0))
-      (debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load "
-		   first ", we'll sleep 10s and try " num-tries " more times.")
-      (thread-sleep! 10)
-      (common:wait-for-cpuload maxnormload numcpus-in
-			       count: count remote-host: remote-host num-tries: (- num-tries 1)))
-
-     ;; need to wait for load to drop
-     ((and will-wait ;; (> first adjmaxload)
-	   (> count 0))
-      (debug:print-info 0 *default-log-port*
-			"Delaying 15" ;; adjwait
-			" seconds due to normalized effective load " normalized-effective-load ;; first
-			" exceeding max of " adjmaxload
-			" on server " (or remote-host (get-host-name))
-			" (normalized load-limit: " maxnormload ") " (if msg msg ""))
-      (thread-sleep! 15) ;; adjwait)
-      (common:wait-for-cpuload maxnormload numcpus count: (- count 1) msg: msg remote-host: remote-host)
-      ;; put the message here to indicate came out of waiting
-      (debug:print-info 1 *default-log-port*
-			"On host: " effective-host
-			", effective load: " effective-load
-			", numcpus: " numcpus
-			", normalized effective load: " normalized-effective-load
-			))
-     ;; overloaded and count expired (i.e. went to zero)
-     (else
-      (if (> num-tries 0) ;; should be "num-tries-left". 
-	  (if (common:low-noise-print 30 (conc (round effective-load) "-load-acceptable-" effective-host))
-	      (debug:print 0 *default-log-port* "Load on " effective-host " is acceptable at effective normalized load of "
-			   effective-normalized-load "  continuing."))
-	  (debug:print 0 *default-log-port* "Load on " effective-host ", "
-		       first" could not be retrieved. Giving up and continuing."))))))
-
-;;======================================================================
-;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
-;;
-;; (define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f)(force-maxload #f)(num-tries 5))
-;;   (let* ((loadavg (common:get-cpu-load remote-host))
-;; 	 (numcpus (if (<= 1 numcpus-in) ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
-;; 		      (common:get-num-cpus remote-host)
-;; 		      numcpus-in))
-;; 	 (maxload (if force-maxload
-;; 		      maxload-in
-;; 		      (if (number? maxload-in)
-;; 			  (max maxload-in 0.5)
-;; 			  0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
-;; 	 (first   (car loadavg))
-;; 	 (next    (cadr loadavg))
-;; 	 (adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
-;; 					       ;; numcpus (or could be
-;; 					       ;; maxload) is zero,
-;; 					       ;; crude fallback is to
-;; 					       ;; at least use 1
-;; 	 (loadjmp (- first (if (> next (* numcpus 0.7)) ;; could do something with average of first and next?
-;; 			       0
-;; 			       next))) ;; we will force a conservative calculation any time next is large.
-;; 	 (first-next-avg    (/ (+ first next) 2))
-;; 	 ;; add some randomness to the time to break any alignment
-;; 	 ;; where netbatch dumps many jobs to machines simultaneously
-;;          (adjwait           (min (+ 300 (random 10)) (abs (* (+ (random 10)
-;; 								(/ (- 1000 count) 10)
-;; 								waitdelay)
-;; 							     (- first adjmaxload) ))))
-;; 	 (load-jump-limit   (configf:lookup-number *configdat* "setup" "load-jump-limit"))
-;; 	 ;; effective load accounts for load jumps, this should elminate all the first-next-avg, adjwait, load-jump-limit
-;; 	 ;; etc.
-;; 	 (effective-load    (common:get-intercept first next))
-;; 	 (effective-host    (or remote-host "localhost"))
-;; 	 (normalized-effective-load (/ effective-load numcpus))
-;; 	 (will-wait                 (> normalized-effective-load maxload)))
-;; 	 
-;;     ;; let's let the user know once in a long while that load checking
-;;     ;; is happening but not constantly report it
-;;     #;(if (common:low-noise-print 30 (conc "cpuload" (or remote-host "localhost"))) ;; (> (random 100) 75) ;; about 25% of the time
-;; 	(debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
-;;     ", load: " first ", adjmaxload: " adjmaxload ", loadjmp: " loadjmp))
-;; 
-;;     (debug:print-info 1 *default-log-port*
-;; 		      "On host: " effective-host
-;; 		      ", effective load: " effective-load
-;; 		      ", numcpus: " numcpus
-;; 		      ", normalized effective load: " normalized-effective-load
-;; 		      )
-;;     
-;;     (cond
-;;      ;; bad data, try again to get the data
-;;      ((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
-;; 	   (> num-tries 0))
-;;       (debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load " first ", we'll sleep 10s and try " num-tries " more times.")
-;;       (thread-sleep! 10)
-;;       (common:wait-for-cpuload maxload-in numcpus-in waitdelay
-;; 			       count: count remote-host: remote-host force-maxload: force-maxload num-tries: (- num-tries 1)))
-;;      ;; need to wait for load to drop
-;;      ((and will-wait ;; (> first adjmaxload)
-;; 	   (> count 0))
-;;       (debug:print-info 0 *default-log-port*
-;; 			"Delaying " 15 ;; adjwait
-;; 			" seconds due to normalized effective load " normalized-effective-load ;; first
-;; 			" exceeding max of " adjmaxload
-;; 			" on server " (or remote-host (get-host-name))
-;; 			" (normalized load-limit: " maxload ") " (if msg msg ""))
-;;       (thread-sleep! 15) ;; adjwait)
-;;       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
-;;      ((and (> loadjmp (cond
-;; 		       (load-jump-limit load-jump-limit)
-;; 		       ((> numcpus 8)(/ numcpus 2))
-;; 		       ((> numcpus 4)(/ numcpus 1.2))
-;; 		       (else 0.5)))
-;; 	   (> count 0))
-;;       (debug:print-info 0 *default-log-port* "waiting " adjwait " seconds due to possible load jump " loadjmp ". "
-;; 			(if msg msg ""))
-;;       (thread-sleep! adjwait)
-;;       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
-;;      (else
-;;       (if (> num-tries 0)
-;; 	  (if (common:low-noise-print 30 (conc (round first) "-load-acceptable-" (or remote-host "localhost")))
-;; 	      (debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") " is acceptable at " first " continuing."))
-;; 	  (debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") ", "first" could not be retrieved. Giving up and continuing."))))))
-;; 
-(define (get-uname . params)
-  (let* ((uname-res (process:cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
-	 (uname #f))
-    (if (null? (car uname-res))
-	"unknown"
-	(caar uname-res))))
-
-;;======================================================================
-;; D I S K   S P A C E 
-;;======================================================================
-
-(define (common:get-disk-space-used fpath)
-  (with-input-from-pipe (conc "/usr/bin/du -s " fpath) read))
-
-;;======================================================================
-;; given path get free space, allows override in [setup]
-;; with free-space-script /path/to/some/script.sh
-;;
-(define (get-df path)
-  (if (configf:lookup *configdat* "setup" "free-space-script")
-      (with-input-from-pipe 
-       (conc (configf:lookup *configdat* "setup" "free-space-script") " " path)
-       (lambda ()
-	 (let ((res (read-line)))
-	   (if (string? res)
-	       (string->number res)))))
-      (get-unix-df path)))
-
-(define (get-free-inodes path)
-  (if (configf:lookup *configdat* "setup" "free-inodes-script")
-      (with-input-from-pipe 
-	  (conc (configf:lookup *configdat* "setup" "free-inodes-script") " " path)
-	(lambda ()
-	  (let ((res (read-line)))
-	    (if (string? res)
-		(string->number res)))))
-      (get-unix-inodes path)))
-
-(define (get-unix-df path)
-  (let* ((df-results (process:cmd-run->list (conc "df " path)))
-	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
-	 (freespc    #f))
-    ;; (write df-results)
-    (for-each (lambda (l)
-		(let ((match (string-search space-rx l)))
-		  (if match 
-		      (let ((newval (string->number (cadr match))))
-			(if (number? newval)
-			    (set! freespc newval))))))
-	      (car df-results))
-    freespc))
-
-(define (get-unix-inodes path)
-  (let* ((df-results (process:cmd-run->list (conc "df -i " path)))
-	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
-	 (freenodes    0)) ;; 0 is a better failsafe than #f here.
-    ;; (write df-results)
-    (for-each (lambda (l)
-		(let ((match (string-search space-rx l)))
-		  (if match 
-		      (let ((newval (string->number (cadr match))))
-			(if (number? newval)
-			    (set! freenodes newval))))))
-	      (car df-results))
-    freenodes))
-
-(define (common:check-space-in-dir dirpath required)
-  (let* ((dbspace  (if (directory? dirpath)
-		       (get-df dirpath)
-		       0)))
-    (list (> dbspace required)
-	  dbspace
-	  required
-	  dirpath)))
-
-;;======================================================================
-;; check space in dbdir and in megatest dir
-;; returns: ok/not dbspace required-space
-;;
-(define (common:check-db-dir-space)
-  (let* ((required (string->number 
-                    ;; default is 1GB (or actually a billion bytes) This is the number of 1 kB blocks.
-		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
-			"1000000")))
-	 (dbdir    (common:make-tmpdir-name *toppath* "")) ;; (db:get-dbdir))
-	 (tdbspace (common:check-space-in-dir dbdir required))
-	 (mdbspace (common:check-space-in-dir *toppath* required)))
-    (sort (list tdbspace mdbspace) (lambda (a b)
-				     (< (cadr a)(cadr b))))))
-
-;;======================================================================
-;; check available space in dbdir, exit if insufficient
-;;
-(define (common:check-db-dir-and-exit-if-insufficient)
-  (let* ((spacedat (car (common:check-db-dir-space))) ;; look only at worst for now
-	 (is-ok    (car spacedat))
-	 (dbspace  (cadr spacedat))
-	 (required (caddr spacedat))
-	 (dbdir    (cadddr spacedat)))
-    (if (not is-ok)
-	(begin
-	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")
-	  (exit 1)))))
-
-;;======================================================================
-;; paths is list of lists ((name path) ... )
-;;
-(define (common:get-disk-with-most-free-space disks minsize)
-  (let* ((best     #f)
-	(bestsize 0)
-        (default-min-inodes-string "1000000")
-        (default-min-inodes (string->number default-min-inodes-string))
-        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes)))
-
-    (for-each 
-     (lambda (disk-num)
-       (let* ((dirpath    (cadr (assoc disk-num disks)))
-	      (freespc    (cond
-			   ((not (directory? dirpath))
-			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
-			    -1)
-			   ((not (file-write-access? dirpath))
-			    (if (common:low-noise-print 300 "disks not writeable " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
-			    -1)
-			   ((not (eq? (string-ref dirpath 0) #\/))
-			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
-			    -1)
-			   (else
-			    (get-df dirpath))))
-	      (free-inodes (cond
-			   ((not (directory? dirpath))
-			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
-			    -1)
-			   ((not (file-write-access? dirpath))
-			    (if (common:low-noise-print 300 "disks not writeable " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
-			    -1)
-			   ((not (eq? (string-ref dirpath 0) #\/))
-			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
-				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
-			    -1)
-			   (else
-			    (get-free-inodes dirpath))))
-             ;;(free-inodes (get-free-inodes dirpath))
-             )
-             (debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes)
-	 (if (and (> freespc bestsize)(> free-inodes min-inodes ))
-	     (begin
-	       (set! best     (cons disk-num dirpath))
-	       (set! bestsize freespc)))
-        ;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
-      ))
-     (map car disks))
-    (if (and best (> bestsize minsize))
-	best
-	#f))) ;; #f means no disk candidate found
-
 ;;======================================================================
 ;; convert a spec string to a list of vectors #( rx  action rx-string )
 (define (common:spec-string->list-of-specs spec-string actions)
   (let ((spec-strings  (string-split-fields "\\s*;\\s*" spec-string #:infix))
 	(actions-regex (regexp (conc "^(.*)\\s+(" (string-intersperse (map conc actions) "|") ")"))))
@@ -3329,22 +2243,10 @@
      vars
      (lambda (var val)
        (setenv var val)))
     vars))
 
-(define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f))
-  (let* ((pre-cmd  (dtests:get-pre-command))
-         (post-cmd (dtests:get-post-command))
-         (fullcmd  (if (or pre-cmd post-cmd)
-                       (conc pre-cmd cmd post-cmd)
-                       (conc "viewscreen " cmd))))
-    (debug:print-info 02 *default-log-port* "Running command: " fullcmd)
-    (cond
-     (with-vars     (common:without-vars  fullcmd))
-     (with-orig-env (common:with-orig-env fullcmd))
-     (else          (common:without-vars  fullcmd "MT_.*")))))
-		  
 ;;======================================================================
 ;; C O L O R S
 ;;======================================================================
       
 (define (common:name->iup-color name)
@@ -3381,45 +2283,10 @@
    "/"))
 
 ;;======================================================================
 ;; L O C K I N G   M E C H A N I S M S 
 ;;======================================================================
-
-;;======================================================================
-;; faux-lock is deprecated. Please use simple-lock below
-;;
-(define (common:faux-lock keyname #!key (wait-time 8)(allow-lock-steal #t))
-  (if (rmt:no-sync-get/default keyname #f) ;; do not be tempted to compare to pid. locking is a one-shot action, if already locked for this pid it doesn't actually count
-      (if (> wait-time 0)
-	  (begin
-	    (thread-sleep! 1)
-	    (if (eq? wait-time 1) ;; only one second left, steal the lock
-		(begin
-		  (debug:print-info 0 *default-log-port* "stealing lock for " keyname)
-		  (common:faux-unlock keyname force: #t)))
-	    (common:faux-lock keyname wait-time: (- wait-time 1)))
-	  #f)
-      (begin
-        (rmt:no-sync-set keyname (conc (current-process-id)))
-        (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))))
-
-(define (common:faux-unlock keyname #!key (force #f))
-  (if (or force (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))
-      (begin
-        (if (rmt:no-sync-get/default keyname #f) (rmt:no-sync-del! keyname))
-        #t)
-      #f))
-
-;;======================================================================
-;; simple lock. improve and converge on this one.
-;;
-(define (common:simple-lock keyname)
-  (rmt:no-sync-get-lock keyname))
-
-(define (common:simple-unlock keyname #!key (force #f))
-  (rmt:no-sync-del! keyname))
-
 ;;======================================================================
 ;;
 ;;======================================================================
 
 (define (common:in-running-test?)
@@ -3506,102 +2373,10 @@
 ;; (define (mddb:get-dashboards)
 ;;   (let ((db (mddb:open-db)))
 ;;     (query fetch-column
 ;; 	   (sql db "SELECT ipaddr || ':' || portnum FROM dashboards;"))))
     
-;;======================================================================
-;;  T E S T   L A U N C H I N G   P E R   I T E M   W I T H   H O S T   T Y P E S
-;;======================================================================
-;; 
-;; [hosts]
-;; arm cubie01 cubie02
-;; x86_64 zeus xena myth01
-;; allhosts #{g hosts arm} #{g hosts x86_64}
-;; 
-;; [host-types]
-;; general #MTLOWESTLOAD #{g hosts allhosts}
-;; arm     #MTLOWESTLOAD #{g hosts arm}
-;; nbgeneral nbjob run JOBCOMMAND -log $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME.$MT_TESTNAME-$MT_ITEM_PATH.lgo
-;;
-;; [host-rules]
-;; # maxnload   => max normalized load
-;; # maxnjobs   => max jobs per cpu
-;; # maxjobrate => max jobs per second
-;; general maxnload=1.1; maxnjobs=1.2; maxjobrate=0.1 
-;; 
-;; [launchers]
-;; envsetup general
-;; xor/%/n 4C16G
-;; % nbgeneral
-;; 
-;; [jobtools]
-;; # if defined and not "no" flexi-launcher will bypass "launcher" unless no match.
-;; flexi-launcher yes  
-;; launcher nbfake
-;;
-(define (common:get-launcher configdat testname itempath)
-  (let ((fallback-launcher (configf:lookup configdat "jobtools" "launcher")))
-    (if (and (configf:lookup configdat "jobtools" "flexi-launcher") ;; overrides launcher
-	     (not (equal? (configf:lookup configdat "jobtools" "flexi-launcher") "no")))
-	(let* ((launchers         (hash-table-ref/default configdat "launchers" '())))
-	  (if (null? launchers)
-	      fallback-launcher
-	      (let loop ((hed (car launchers))
-			 (tal (cdr launchers)))
-		(let ((patt      (car hed))
-		      (host-type (cadr hed)))
-		  (if (tests:match patt testname itempath)
-		      (begin
-			(debug:print-info 2 *default-log-port* "Have flexi-launcher match for " testname "/" itempath " = " host-type)
-			(let ((launcher (configf:lookup configdat "host-types" host-type)))
-			  (if launcher
-			      (let* ((launcher-parts (string-split launcher))
-				     (launcher-exe   (car launcher-parts)))
-				(if (equal? launcher-exe "#MTLOWESTLOAD") ;; this is our special case, we will find the lowest load and craft a nbfake commandline
-				    (let host-loop ((targ-host (common:get-least-loaded-host (cdr launcher-parts) host-type configdat))
-						    (count     100))
-				      (if targ-host
-					  (conc "remrun " targ-host)
-					  (if (> count 0)
-					      (begin
-						(debug:print 0 *default-log-port* "INFO: Waiting for a host for host-type " host-type)
-						(thread-sleep! (- 101 count))
-						(host-loop (common:get-least-loaded-host (cdr launcher-parts) host-type configdat)
-							   (- count 1)))
-					      (begin
-						(debug:print 0 *default-log-port* "FATAL: Failed to find a host from #MTLOWESTLOAD for host-type " host-type)
-						(exit)))))
-				    launcher))
-			      (begin
-				(debug:print-info 0 *default-log-port* "WARNING: no launcher found for host-type " host-type)
-				(if (null? tal)
-				    fallback-launcher
-				    (loop (car tal)(cdr tal)))))))
-		      ;; no match, try again
-		      (if (null? tal)
-			  fallback-launcher
-			  (loop (car tal)(cdr tal))))))))
-	fallback-launcher)))
-
-;;======================================================================
-;; D A S H B O A R D   U S E R   V I E W S
-;;======================================================================
-
-;;======================================================================
-;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
-;;
-(define (common:load-views-config)
-  (let* ((view-cfgdat    (make-hash-table))
-	 (home-cfgfile   (conc (get-environment-variable "HOME") "/.mtviews.config"))
-	 (mthome-cfgfile (conc *toppath* "/.mtviews.config")))
-    (if (common:file-exists? mthome-cfgfile)
-	(read-config mthome-cfgfile view-cfgdat #t))
-    ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
-    (if (common:file-exists? home-cfgfile)
-	(read-config home-cfgfile view-cfgdat #t))
-    view-cfgdat))
-
 ;;======================================================================
 ;; H I E R A R C H I C A L   H A S H   T A B L E S
 ;;======================================================================
 ;;
 ;; Every element including top element is a vector:
@@ -3674,110 +2449,10 @@
 		(state     . s)
 		(target    . t)
 		(status    . u)
 		(parent    . P)))))
 
-(define (common:get-pkts-dirs mtconf use-lt)
-  (let* ((pktsdirs-str (or (configf:lookup mtconf "setup"  "pktsdirs")
-			   (and use-lt
-				(conc (or *toppath*
-					  (current-directory))
-				      "/lt/.pkts"))))
-	 (pktsdirs  (if pktsdirs-str
-			(string-split pktsdirs-str " ")
-			#f)))
-    pktsdirs))
-
-;;======================================================================
-;; use-lt is use linktree "lt" link to find pkts dir
-(define (common:save-pkt pktalist-in mtconf use-lt #!key (add-only #f)) ;; add-only saves the pkt only if there is a parent already
-  (if (or (not add-only)
-	  (hash-table-exists? *pkts-info* 'last-parent))
-      (let* ((parent   (hash-table-ref/default *pkts-info* 'last-parent #f))
-	     (pktalist (if parent
-			   (cons `(parent . ,parent)
-				 pktalist-in)
-			   pktalist-in)))
-	(let-values (((uuid pkt)
-		      (alist->pkt pktalist common:pkts-spec)))
-	  (hash-table-set! *pkts-info* 'last-parent uuid)
-	  (let ((pktsdir (or (hash-table-ref/default *pkts-info* 'pkts-dir #f)
-			     (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
-				    (pktsdir   (car pktsdirs))) ;; assume it is there
-			       (hash-table-set! *pkts-info* 'pkts-dir pktsdir)
-			       pktsdir))))
-	    (debug:print 0 *default-log-port* "pktsdir: "pktsdir)
-            (handle-exceptions
-             exn
-             (debug:print-info 0 "failed to write out packet to " pktsdir ", exn=" exn) ;; don't care if this failed for now but MUST FIX - BUG!!
-             (if (not (file-exists? pktsdir))
-                 (create-directory pktsdir #t))
-             (with-output-to-file
-                 (conc pktsdir "/" uuid ".pkt")
-               (lambda ()
-                 (print pkt)))))))))
-	
-(define (common:with-queue-db mtconf proc #!key (use-lt #f)(toppath-in #f))
-  (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
-	 (pktsdir  (if pktsdirs (car pktsdirs) #f))
-	 (toppath  (or (configf:lookup mtconf "scratchdat" "toppath")
-		       toppath-in))
-	 (pdbpath  (or (configf:lookup mtconf "setup"  "pdbpath") pktsdir)))
-    (cond
-     ((not (and  pktsdir toppath pdbpath))
-      (debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.")
-      (debug:print  0 *default-log-port* "  you need to have pktsdirs in the [setup] section."))
-     ((not (common:file-exists? pktsdir))
-      (debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir))
-     ((not (equal? (file-owner pktsdir)(current-effective-user-id)))
-      (debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
-     (else
-	(let* ((pdb  (open-queue-db pdbpath "pkts.db"
-				    schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
-	  (proc pktsdirs pktsdir pdb)
-	  (dbi:close pdb))))))
-
-(define (common:load-pkts-to-db mtconf #!key (use-lt #f))
-  (common:with-queue-db
-   mtconf
-   (lambda (pktsdirs pktsdir pdb)
-     (for-each
-      (lambda (pktsdir) ;; look at all
-	(cond
-	 ((not (common:file-exists? pktsdir))
-	  (debug:print 0 *default-log-port* "ERROR: packets directory " pktsdir " does not exist."))
-	 ((not (directory? pktsdir))
-	  (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not a directory."))
-	 ((not (file-read-access? pktsdir))
-	  (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not readable."))
-	 (else
-	  (debug:print-info 0 *default-log-port* "Loading packets found in " pktsdir)
-	  (let ((pkts (glob (conc pktsdir "/*.pkt")))
-                (sqdb (dbi:db-conn pdb))
-                )
-           ;; Put this in a transaction to avoid issues overloading the db
-           (sqlite3:with-transaction
-            sqdb
-            (lambda ()
-	    (for-each
-	     (lambda (pkt)
-	       (let* ((uuid    (cadr (string-match ".*/([0-9a-f]+).pkt" pkt)))
-		      (exists  (lookup-by-uuid pdb uuid #f)))
-		 (if (not exists)
-		     (let* ((pktdat (string-intersperse
-				     (with-input-from-file pkt read-lines)
-				     "\n"))
-			    (apkt   (pkt->alist pktdat))
-			    (ptype  (alist-ref 'T apkt)))
-		       (add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0)
-		       (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
-		     (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
-		     )))
-	     pkts)))))))
-      pktsdirs))
-   use-lt: use-lt))
-
 (define (common:get-pkt-alists pkts)
   (map (lambda (x)
 	 (alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
        pkts))