Index: client.scm
==================================================================
--- client.scm
+++ client.scm
@@ -50,10 +50,13 @@
 ;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
 ;;   2. We are a run tests, list runs or other interactive process and we must figure out
 ;;      *transport-type* and *runremote* from the monitor.db
 ;;
 ;; client:setup
+;;
+;; lookup_server, need to remove *runremote* stuff
+;;
 (define (client:setup run-id #!key (remaining-tries 3))
   (if (not *toppath*)
       (if (not (setup-for-run))
 	  (begin
 	    (debug:print 0 "ERROR: failed to find megatest.config, exiting")
@@ -82,25 +85,27 @@
 		    (exit 1)))
 	      (begin
 		(hash-table-set! *runremote* run-id hostinfo)
 		(debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
 		(debug:print-info 11 "Using transport type of " transport (if hostinfo (conc " to connect to " hostinfo) ""))
-		(case *transport-type* 
-		  ;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
-		  ((http)
-		   ;; this saves the hostinfo in the *runremote* hash and returns it
-		   (http-transport:client-connect run-id 
-						  (tasks:hostinfo-get-interface hostinfo)
-						  (tasks:hostinfo-get-port hostinfo)))
-		  ((zmq)
-		   (zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
-						 (tasks:hostinfo-get-port      hostinfo)
-						 (tasks:hostinfo-get-pubport   hostinfo)))
-		  (else  ;; default to fs
-		   (debug:print 0 "ERROR: unrecognised transport type " *transport-type* " exiting now.")
-		   (exit)))))))))
-    ;;	  (pop-directory)))
+		(client:start run-id transport server-info)))))))
+
+(define (client:start run-id transport server-info)
+  (case transport
+    ;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
+    ((http)
+     ;; this saves the server-info in the *runremote* hash and returns it
+     (http-transport:client-connect run-id 
+				    (tasks:hostinfo-get-interface server-info)
+				    (tasks:hostinfo-get-port server-info)))
+    ((zmq)
+     (zmq-transport:client-connect (tasks:hostinfo-get-interface server-info)
+				   (tasks:hostinfo-get-port      server-info)
+				   (tasks:hostinfo-get-pubport   server-info)))
+    (else  ;; default to fs
+     (debug:print 0 "ERROR: unrecognised transport type " transport )
+     #f)))
 
 ;; client:signal-handler
 (define (client:signal-handler signum)
   (handle-exceptions
    exn

Index: docs/manual/server.dot
==================================================================
--- docs/manual/server.dot
+++ docs/manual/server.dot
@@ -46,12 +46,15 @@
 	remove_server_record -> set_available;
 	set_available -> avail_delay [label="delay 3s"];
 	avail_delay -> "first_in_queue?";
 
 	"first_in_queue?" -> set_running [label=yes];
-	set_running -> handle_requests;
-	"first_in_queue?" -> "server_running?" [label=no];
+	set_running -> get_next_port -> handle_requests;
+	"first_in_queue?" -> "dead_entry_in_queue?" [label=no];
+	"dead_entry_in_queue?" -> "server_running?" [label=no];
+	"dead_entry_in_queue?" -> "remove_dead_entries" [label=yes];
+	remove_dead_entries -> "server_running?";
 
 	handle_requests -> start_shutdown [label="no traffic"];
 	handle_requests -> shutdown_request;
 	start_shutdown -> shutdown_delay;
 	shutdown_request -> shutdown_delay;

ADDED   docs/results.pdf
Index: docs/results.pdf
==================================================================
--- /dev/null
+++ docs/results.pdf
cannot compute difference between binary files

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -60,33 +60,19 @@
 	  (u8vector->list
 	   (if res res (hostname->ip hostname)))) ".")))
 
 (define (http-transport:run hostn run-id server-id)
   (debug:print 2 "Attempting to start the server ...")
-  (if (not *toppath*)
-      (if (not (setup-for-run))
-	  (begin
-	    (debug:print 0 "ERROR: cannot find megatest.config, cannot start server, exiting")
-	    (exit))))
-  (let* (;; (iface           (if (string=? "-" hostn)
-	 ;;        	      #f ;; (get-host-name) 
-	 ;;        	      hostn))
-	 (db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
+  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
 	 (hostname        (get-host-name))
 	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
 					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
 					   (server:get-best-guess-address hostname)
 					   #f)))
 			    (if ipstr ipstr hostn))) ;; hostname))) 
-	 (start-port    (if (and (args:get-arg "-port")
-				 (string->number (args:get-arg "-port")))
-			    (string->number (args:get-arg "-port"))
-			    (if (and (config-lookup  *configdat* "server" "port")
-				     (string->number (config-lookup  *configdat* "server" "port")))
-				(string->number (config-lookup  *configdat* "server" "port"))
-				(+ 5000 (random 1001)))))
-	 (link-tree-path (config-lookup *configdat* "setup" "linktree")))
+	 (start-port      (open-run-close tasks:server-get-next-port tasks:open-db))
+	 (link-tree-path  (config-lookup *configdat* "setup" "linktree")))
     (set! db *inmemdb*)
     (root-path     (if link-tree-path 
 		       link-tree-path
 		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
     (handle-directory spiffy-directory-listing)
@@ -154,10 +140,13 @@
      (print-error-message exn)
      (if (< portnum 9000)
 	 (begin 
 	   (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port")
 	   (thread-sleep! 0.1)
+
+	   ;; get_next_port goes here
+
 	   (http-transport:try-start-server ipaddrstr (+ portnum 1) server-id))
 	 (print "ERROR: Tried and tried but could not start the server")))
    ;; any error in following steps will result in a retry
    (set! *server-info* (list ipaddrstr portnum))
    (open-run-close tasks:server-set-interface-port 
@@ -371,10 +360,13 @@
 	 (thread-join! th1)
 	 (thread-terminate! th2)
 	 (debug:print-info 11 "got res=" res)
 	 res)))))
 
+;;
+;; connect
+;;
 (define (http-transport:client-connect run-id iface port)
   (let* ((login-res   #f)
 	 (uri-dat     (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/ctrl"))))
 	 (uri-api-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/api"))))
 	 (serverdat   (list iface port uri-dat uri-api-dat)))
@@ -386,11 +378,11 @@
 	  (debug:print-info 2 "Logged in and connected to " iface ":" port)
 	  (hash-table-set! *runremote* run-id serverdat)
 	  serverdat)
 	(begin
 	  (debug:print-info 0 "ERROR: Failed to login or connect to " iface ":" port)
-	  (exit 1)))))
+	  #f))))
 
 ;; run http-transport:keep-running in a parallel thread to monitor that the db is being 
 ;; used and to shutdown after sometime if it is not.
 ;;
 (define (http-transport:keep-running server-id)
@@ -421,10 +413,13 @@
 			   (if (and (string? tmo)
 				    (string->number tmo))
 			       (* 60 60 (string->number tmo))
 			       ;; default to three days
 			       (* 3 24 60 60)))))
+    ;;
+    ;; set_running
+    ;;
     (tasks:server-set-state! tdb server-id "running")
     (let loop ((count 0))
       ;; Use this opportunity to sync the inmemdb to db
       (let ((start-time (current-milliseconds))
 	    (sync-time  #f)
@@ -455,20 +450,27 @@
 	    (set! iface (car sdat))
 	    (set! port  (cadr sdat))))
       
       ;; NOTE: Get rid of this mechanism! It really is not needed...
       ;; (open-run-close tasks:server-update-heartbeat tasks:open-db spid)
-      (tasks:server-update-heartbeat tdb server-id)
+
+      ;;
+      ;; NOT USED ANY MORE
+      ;;
+      ;; (tasks:server-update-heartbeat tdb server-id)
       
       ;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access
 
       ;; Transfer *last-db-access* to last-access to use in checking that we are still alive
       (mutex-lock! *heartbeat-mutex*)
       (set! last-access *last-db-access*)
       (mutex-unlock! *heartbeat-mutex*)
 
       ;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
+      ;;
+      ;; no_traffic
+      ;;
       (if (and *server-run*
 	       (> (+ last-access server-timeout)
 		  (current-seconds)))
 	  (begin
 	    (debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
@@ -476,10 +478,13 @@
 	  (begin
 	    (debug:print-info 0 "Starting to shutdown the server.")
 	    ;; need to delete only *my* server entry (future use)
 	    (set! *time-to-exit* #t)
 	    (if *inmemdb* (db:sync-touched *inmemdb* force-sync: #t))
+	    ;;
+	    ;; start_shutdown
+	    ;;
 	    ( tasks:server-set-state! tdb server-id "shutting-down")
 	    (thread-sleep! 5)
 	    (debug:print-info 0 "Max cached queries was    " *max-cache-size*)
 	    (debug:print-info 0 "Number of cached writes   " *number-of-writes*)
 	    (debug:print-info 0 "Average cached write time "
@@ -498,45 +503,42 @@
 	    (debug:print-info 0 "Server shutdown complete. Exiting")
 	    (tasks:server-delete-record! tdb server-id)
 	    (exit))))))
 
 ;; all routes though here end in exit ...
+;;
+;; start_server? 
+;;
 (define (http-transport:launch run-id)
   (set! *run-id*   run-id)
-  (if (not *toppath*)
-      (if (not (setup-for-run))
-	  (begin
-	    (debug:print 0 "ERROR: cannot find megatest.config, exiting")
-	    (exit))))
-  (debug:print-info 2 "Starting the standalone server")
   (if (args:get-arg "-daemonize")
       (daemon:ize))
+  ;;
+  ;; set_available
+  ;;
   (let ((server-id (open-run-close tasks:server-lock-slot tasks:open-db run-id)))
     (if (not server-id)
 	(begin
 	  (debug:print-info 2 "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
 	  (open-run-close tasks:server-delete-records-for-this-pid tasks:open-db))
-	(if *toppath* 
-	    (let* ((th2 (make-thread (lambda ()
-				       (http-transport:run 
-					(if (args:get-arg "-server")
-					    (args:get-arg "-server")
-					    "-")
-					run-id
-					server-id)) "Server run"))
-		   (th3 (make-thread (lambda ()
-				       (http-transport:keep-running server-id))
-				     "Keep running")))
-	      ;; Database connection
-	      (set! *inmemdb*  (db:setup run-id))
-	      (thread-start! th2)
-	      (thread-start! th3)
-	      (set! *didsomething* #t)
-	      (thread-join! th2))
-	    (debug:print 0 "ERROR: Failed to setup for megatest")))
-    ;; (sdb:qry 'finalize)
-    (exit)))
+	(let* ((th2 (make-thread (lambda ()
+				   (http-transport:run 
+				    (if (args:get-arg "-server")
+					(args:get-arg "-server")
+					"-")
+				    run-id
+				    server-id)) "Server run"))
+	       (th3 (make-thread (lambda ()
+				   (http-transport:keep-running server-id))
+				 "Keep running")))
+	  ;; Database connection
+	  (set! *inmemdb*  (db:setup run-id))
+	  (thread-start! th2)
+	  (thread-start! th3)
+	  (set! *didsomething* #t)
+	  (thread-join! th2)
+	  (exit)))))
 
 (define (http-transport:server-signal-handler signum)
   (handle-exceptions
    exn
    (debug:print " ... exiting ...")

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -42,25 +42,24 @@
 
 ;; Call this to start the actual server
 ;;
 
 ;; all routes though here end in exit ...
+;;
+;; start_server
+;;
 (define (server:launch transport run-id)
-  (if (not *toppath*)
-      (if (not (setup-for-run))
-	  (begin
-	    (debug:print 0 "ERROR: cannot find megatest.config, exiting")
-	    (exit))))
-  (debug:print-info 2 "Starting server using " transport " transport")
-  (set! *transport-type* transport)
-  (case transport
-    ;; ((fs)   (exit)) ;; there is no "fs" server transport
-    ((fs http) (http-transport:launch run-id))
-    ((zmq)     (zmq-transport:launch run-id))
-    (else
-     (debug:print "WARNING: unrecognised transport " transport)
-     (exit))))
+  (let ((server-running (server:check-if-running run-id transport)))
+    (if server-running
+	;; a server is already running
+	(exit)
+	(case transport
+	  ((http) (http-transport:launch run-id))
+	  ((zmq)  (zmq-transport:launch run-id))
+	  (else
+	   (debug:print "WARNING: unrecognised transport " transport)
+	   (exit))))))
 
 ;;======================================================================
 ;; Q U E U E   M A N A G E M E N T
 ;;======================================================================
 
@@ -145,5 +144,14 @@
 	      (loop (open-run-close tasks:get-server tasks:open-db run-id) 
 		    (+ trycount 1))
 	      (debug:print 0 "WARNING: Couldn't start or find a server.")))
 	(debug:print 2 "INFO: Server(s) running " servers)
 	)))
+
+(define (server:check-if-running run-id transport)
+  (let loop ((server (open-run-close tasks:get-server tasks:open-db run-id))
+	     (trycount 0))
+    (if server
+	;; note: client:start will set *runremote*. this needs to be changed
+	;;       also, client:start will login to the server, also need to change that.
+	(client:start run-id transport server)
+	#f)))

Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -103,11 +103,11 @@
 ;; register that this server may come online (first to register goes though with the process)
 (define (tasks:server-set-available mdb run-id)
   (sqlite3:execute 
    mdb 
    "INSERT INTO servers (pid,hostname,port,pubport,start_time,      priority,state,mt_version,heartbeat,   interface,transport,run_id)
-                   VALUES(?, ?,       ?,   ?, strftime('%s','now'), ?,       ?,    ?, strftime('%s','now'),?,        ?,        ?);"
+                   VALUES(?, ?,       ?,   ?, strftime('%s','now'), ?,       ?,    ?,-1,?,        ?,        ?);"
    (current-process-id)       ;; pid
    (get-host-name)            ;; hostname
    -1                         ;; port
    -1                         ;; pubport
    (random 1000)              ;; priority (used a tiebreaker on get-available)
@@ -134,10 +134,33 @@
   (sqlite3:execute mdb "DELETE FROM servers WHERE hostname=? AND pid=?;" (get-host-name) (current-process-id)))
 
 (define (tasks:server-set-interface-port mdb server-id interface port)
   (sqlite3:execute mdb "UPDATE servers SET interface=?,port=? WHERE id=?;" interface port server-id))
 
+(define (tasks:server-get-next-port mdb)
+  (let ((res         #f)
+	(port-param  (if (and (args:get-arg "-port")
+			      (string->number (args:get-arg "-port")))
+			 (string->number (args:get-arg "-port"))
+			 #f))
+	(config-port (if (and (config-lookup  *configdat* "server" "port")
+			      (string->number (config-lookup  *configdat* "server" "port")))
+			 (string->number (config-lookup  *configdat* "server" "port"))
+			 #f)))
+    (sqlite3:for-each-row
+     (lambda (port)
+       (set! res (+ port 1))) ;; set to next
+     mdb
+     "SELECT max(port) FROM servers;")
+    (cond
+     ((and port-param res)   (if (> res port-param) res port-param))
+     (port-param             port-param)
+     ((and config-port res)  (if (> res config-port) res config-port))
+     (config-port            config-port)
+     ((and res (> res 8080)) res)
+     (else                   (+ 5000 (random 1001))))))
+
 (define (tasks:server-am-i-the-server? mdb run-id)
   (let* ((all    (tasks:server-get-servers-vying-for-run-id mdb run-id))
 	 (first  (if (null? all)
 		     (begin (debug:print 0 "ERROR: no servers listed, should be at least one by now.") 
 			    (sqlite3:finalize! mdb)

ADDED   utils/plot-code.scm
Index: utils/plot-code.scm
==================================================================
--- /dev/null
+++ utils/plot-code.scm
@@ -0,0 +1,148 @@
+#!/mfs/pkgs/chicken/4.8.0.5/bin/csi -nbq
+
+(use regex srfi-69 srfi-13)
+
+(define targs #f) 
+(define files (cddddr (argv)))
+
+(let ((targdat (cadddr (argv))))
+  (if (equal? targdat "-")
+      (set! targs files)
+      (set! targs (string-split targdat ","))))
+
+(define filedat-defns (make-hash-table))
+(define filedat-usages (make-hash-table))
+
+(define defn-rx (regexp "^\\s*\\(define\\s+\\(([^\\s\\)]+).*"))
+(define all-regexs (make-hash-table))
+
+(define all-fns '())
+
+(define (print-err . data)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (apply print data))))
+
+(print-err "Making graph for files: " (string-intersperse targs ", "))
+(print-err "Looking at files: " (string-intersperse files ", "))
+
+;; Gather the functions
+;;
+(for-each 
+ (lambda (fname)
+   (print-err "Processing file " fname)
+   (with-input-from-file fname
+     (lambda ()
+       (let loop ((inl (read-line)))
+	 (if (not (eof-object? inl))
+	     (let ((match (string-match defn-rx inl)))
+	       (if match 
+		   (let ((fnname (cadr match)))
+		     ;; (print "   " fnname)
+		     (set! all-fns (cons fnname all-fns))
+		     (hash-table-set! 
+		      filedat-defns 
+		      fname
+		      (cons fnname (hash-table-ref/default filedat-defns fname '())))
+		     ))
+	       (loop (read-line))))))))
+ files)
+
+;; fill up the regex hash
+(print-err "Make the huge regex hash")
+(for-each
+ (lambda (fnname)
+   (hash-table-set! all-regexs fnname (regexp (conc "^(|.*[^a-zA-Z]+)" fnname "([^a-zA-Z]+|)$"))))
+ (cons "toplevel" all-fns))
+
+(define breadcrumbs (make-hash-table))
+
+(define (have-function inl)
+  (let loop ((hed (car all-fns))
+	     (tal (cdr all-fns)))
+    (if (string-contains inl hed)
+	#t
+	(if (null? tal)
+	    #f
+	    (loop (car tal)(cdr tal))))))
+
+(define (look-for-all-calls inl fnname)
+  (if (have-function inl) ;; (string-search have-function-rx inl)
+      (let loop ((hed (car all-fns))
+		 (tal (cdr all-fns))
+		 (res '()))
+	(let ((match (string-match (hash-table-ref all-regexs hed) inl)))
+	  (if match
+	      (let ((newres (cons hed res)))
+		(if (null? tal)
+		    newres
+		    (loop (car tal)
+			  (cdr tal)
+			  newres)))
+	      (if (null? tal)
+		  res
+		  (loop (car tal)(cdr tal) res)))))
+      '()))
+  
+;; Gather the usages
+(print "digraph G {")
+(define curr-cluster-num 0)
+(define function-calls '())
+
+(for-each
+ (lambda (fname)
+   (let ((last-func #f))
+     (print-err "Processing file " fname)
+     (print "subgraph cluster_" curr-cluster-num " {")
+     (set! curr-cluster-num (+ curr-cluster-num 1))
+     (with-input-from-file fname
+       (lambda ()
+	 (with-output-to-port (current-error-port)
+	   (lambda ()
+	     (print "Analyzing file " fname)))
+	 (print "label=\"" fname "\";")
+	 (let loop ((inl    (read-line))
+		    (fnname "toplevel")
+		    (allcalls '()))
+	   (if (eof-object? inl)
+	       (begin
+		 (set! function-calls (cons (list fnname allcalls) function-calls))
+		 (for-each 
+		  (lambda (call-name)
+		    (hash-table-set! breadcrumbs call-name #t))
+		  allcalls)
+		 (print-err "function: " fnname " allcalls: " allcalls))
+	       (let ((match (string-match defn-rx inl)))
+		 (if match
+		     (let ((func-name (cadr match)))
+		       (if last-func
+			   (print "\"" func-name "\" -> \"" last-func "\";")
+			   (print "\"" func-name "\";"))
+		       (set! last-func func-name)
+		       (hash-table-set! breadcrumbs func-name #t)
+		       (loop (read-line)
+			     func-name
+			     allcalls))
+		     (let ((calls (look-for-all-calls inl fnname)))
+		       (loop (read-line) fnname (append allcalls calls)))))))))
+     (print "}")))
+ targs)
+
+(print-err "breadcrumbs: " (hash-table-keys breadcrumbs))
+(print-err "function-calls: " function-calls)
+
+(for-each 
+ (lambda (function-call)
+   (print-err "function-call: " function-call)
+   (let ((fnname (car function-call))
+	 (calls  (cadr function-call)))
+     (for-each
+      (lambda (callname)
+	(print (if (hash-table-ref/default breadcrumbs callname #f) "" "// ")
+	       "\"" fnname "\" -> \"" callname "\";"))
+      calls)))
+ function-calls)
+
+(print "}")
+
+(exit)