@@ -34,13 +34,13 @@
 (define getenv get-environment-variable)
 (define (safe-setenv key val)
   (if (and (string? val)(string? key))
       (handle-exceptions
        exn
-       (debug:print 0 #f "ERROR: bad value for setenv, key=" key ", value=" val)
+       (debug:print 0 *default-log-port* "ERROR: bad value for setenv, key=" key ", value=" val)
        (setenv key val))
-      (debug:print 0 #f "ERROR: bad value for setenv, key=" key ", value=" val)))
+      (debug:print 0 *default-log-port* "ERROR: bad value for setenv, key=" key ", value=" val)))
 
 (define home (getenv "HOME"))
 (define user (getenv "USER"))
 
 ;; GLOBAL GLETCHES
@@ -58,10 +58,11 @@
 (define *globalexitstatus*  0) ;; attempt to work around possible thread issues
 (define *passnum*           0) ;; when running track calls to run-tests or similar
 (define *write-frequency*   (make-hash-table)) ;; run-id => (vector (current-seconds) 0))
 (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))
 
 ;; DATABASE
 (define *dbstruct-db*  #f)
 (define *db-stats*            (make-hash-table)) ;; hash of vectors < count duration-total >
 (define *db-stats-mutex*      (make-mutex))
@@ -169,28 +170,28 @@
       (common:set-last-run-version)))
 
 (define (common:exit-on-version-changed)
   (if (common:version-changed?)
       (let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config")))
-        (debug:print 0 #f
+        (debug:print 0 *default-log-port*
 		     "ERROR: Version mismatch!\n"
 		     "   expected: " (common:version-signature) "\n"
 		     "   got:      " (common:get-last-run-version))
 	(if (and (file-exists? mtconf)
 		 (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
 	    (begin
-	      (debug:print 0 #f "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
+	      (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 #f "Failed to switch versions.")
-		 (debug:print 0 #f " message: " ((condition-property-accessor 'exn 'message) exn))
+		 (debug:print 0 *default-log-port* "Failed to switch versions.")
+		 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
 		 (print-call-chain (current-error-port))
 		 (exit 1))
 	       (common:cleanup-db)))
 	    (begin
-	      (debug:print 0 #f " to switch versions you can run: \"megatest -cleanup-db\"")
+	      (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
 	      (exit 1))))))
 
 ;;======================================================================
 ;; S P A R S E   A R R A Y S
 ;;======================================================================
@@ -273,11 +274,11 @@
   (handle-exceptions
    exn
    (handle-exceptions
     exn
     (begin
-      (debug:print 0 #f "ERROR: received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
+      (debug:print 0 *default-log-port* "ERROR: received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain (current-error-port))
       #f)
     (read (open-input-string (base64:base64-decode instr))))
    (read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))
 
@@ -375,11 +376,11 @@
   (let ((no-hurry  (if *time-to-exit* ;; hurry up
 		       #f
 		       (begin
 			 (set! *time-to-exit* #t)
 			 #t))))
-    (debug:print-info 4 #f "starting exit process, finalizing databases.")
+    (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.")
     (if (and no-hurry (debug:debug-mode 18))
 	(rmt:print-db-stats))
     (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
 			      (let ((run-ids (hash-table-keys *db-local-sync*)))
 				(if (and (not (null? run-ids))
@@ -398,27 +399,29 @@
 				  (let ((db (cdr *task-db*)))
 				    (if (sqlite3:database? db)
 					(begin
 					  (sqlite3:interrupt! db)
 					  (sqlite3:finalize! db #t)
-					  (vector-set! *task-db* 0 #f)))))) "Cleanup db exit thread"))
+					  (vector-set! *task-db* 0 #f)))))
+			      (close-output-port *default-log-port*)
+			      (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))
 	  (th2 (make-thread (lambda ()
-			      (debug:print 4 #f "Attempting clean exit. Please be patient and wait a few seconds...")
+			      (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...")
 			      (if no-hurry
 				  (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff
 				  (thread-sleep! 2))
-			      (debug:print 4 #f " ... done")
+			      (debug:print 4 *default-log-port* " ... done")
 			      )
 			    "clean exit")))
       (thread-start! th1)
       (thread-start! th2)
       (thread-join! th1))))
 
 (define (std-signal-handler signum)
   ;; (signal-mask! signum)
   (set! *time-to-exit* #t)
-  (debug:print 0 #f "ERROR: Received signal " signum " exiting promptly")
+  (debug:print 0 *default-log-port* "ERROR: Received signal " signum " exiting promptly")
   ;; (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)
@@ -470,17 +473,17 @@
 (define (any->number-if-possible val)
   (let ((num (any->number val)))
     (if num num val)))
 
 (define (patt-list-match item patts)
-  (debug:print-info 8 #f "patt-list-match item=" item " patts=" patts)
+  (debug:print-info 8 *default-log-port* "patt-list-match item=" item " patts=" patts)
   (if (and item patts)  ;; here we are filtering for matches with item patterns
       (let ((res #f))   ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is %
 	(for-each 
 	 (lambda (patt)
 	   (let ((modpatt (string-substitute "%" ".*" patt #t)))
-	     (debug:print-info 10 #f "patt " patt " modpatt " modpatt)
+	     (debug:print-info 10 *default-log-port* "patt " patt " modpatt " modpatt)
 	     (if (string-match (regexp modpatt) item)
 		 (set! res #t))))
 	 (string-split patts ","))
 	res)
       #t))
@@ -531,11 +534,11 @@
 			    (args:get-arg "-runtests")
 			    "%"))
 	 (testpatt    (or (and (equal? args-testpatt "%")
 			       rtestpatt)
 			  args-testpatt)))
-    (if rtestpatt (debug:print-info 0 #f "TESTPATT from runconfigs: " rtestpatt))
+    (if rtestpatt (debug:print-info 0 *default-log-port* "TESTPATT from runconfigs: " rtestpatt))
     testpatt))
 
 (define (common:get-linktree)
   (or (getenv "MT_LINKTREE")
       (if *configdat*
@@ -565,11 +568,11 @@
 	(if split
 	    tlist
 	    target)
 	(if target
 	    (begin
-	      (debug:print 0 #f "ERROR: Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
+	      (debug:print 0 *default-log-port* "ERROR: Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
 	      #f)
 	    #f))))
 
 ;;======================================================================
 ;; M I S C   L I S T S
@@ -638,11 +641,11 @@
 	       (existing-coldat (assoc colkey colnames))
 	       (curr-rownum     (if existing-rowdat rownum (+ rownum 1)))
 	       (curr-colnum     (if existing-coldat colnum (+ colnum 1)))
 	       (new-rownames    (if existing-rowdat rownames (cons (list rowkey curr-rownum) rownames)))
 	       (new-colnames    (if existing-coldat colnames (cons (list colkey curr-colnum) colnames))))
-	  ;; (debug:print-info 0 #f "Processing record: " hed )
+	  ;; (debug:print-info 0 *default-log-port* "Processing record: " hed )
 	  (if proc (proc curr-rownum curr-colnum rowkey colkey value))
 	  (if (null? tal)
 	      (list new-rownames new-colnames)
 	      (loop (car tal)
 		    (cdr tal)
@@ -670,11 +673,11 @@
 
 (define (common:read-link-f path)
   (handle-exceptions
       exn
       (begin
-	(debug:print 0 #f "ERROR: command \"/bin/readlink -f " path "\" failed.")
+	(debug:print 0 *default-log-port* "ERROR: command \"/bin/readlink -f " path "\" failed.")
 	path) ;; just give up
     (with-input-from-pipe
 	(conc "/bin/readlink -f " path)
       (lambda ()
 	(read-line)))))
@@ -706,16 +709,16 @@
 	 (adjload (* maxload numcpus))
 	 (loadjmp (- first next)))
     (cond
      ((and (> first adjload)
 	   (> count 0))
-      (debug:print-info 0 #f "waiting " waitdelay " seconds due to load " first " exceeding max of " adjload (if msg msg ""))
+      (debug:print-info 0 *default-log-port* "waiting " waitdelay " seconds due to load " first " exceeding max of " adjload (if msg msg ""))
       (thread-sleep! waitdelay)
       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1)))
      ((and (> loadjmp numcpus)
 	   (> count 0))
-      (debug:print-info 0 #f "waiting " waitdelay " seconds due to load jump " loadjmp " > numcpus " numcpus (if msg msg ""))
+      (debug:print-info 0 *default-log-port* "waiting " waitdelay " seconds due to load jump " loadjmp " > numcpus " numcpus (if msg msg ""))
       (thread-sleep! waitdelay)
       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1))))))
 
 (define (common:get-num-cpus)
   (with-input-from-file "/proc/cpuinfo"
@@ -820,11 +823,11 @@
 	 (dbspace  (cadr spacedat))
 	 (required (caddr spacedat))
 	 (dbdir    (cadddr spacedat)))
     (if (not is-ok)
 	(begin
-	  (debug:print 0 #f "ERROR: Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")
+	  (debug:print 0 *default-log-port* "ERROR: 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)
@@ -834,19 +837,19 @@
      (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 #f "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
+				(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 #f "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
+				(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 #f "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
+				(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)))))
 	 (if (> freespc bestsize)
 	     (begin
@@ -953,11 +956,11 @@
 
 (define (seconds->time-string sec)
   (time->string 
    (seconds->local-time sec) "%H:%M:%S"))
 
-(define (seconds->work-week/day-time sec)
+(define (sbeconds->work-week/day-time sec)
   (time->string
    (seconds->local-time sec) "ww%V.%u %H:%M"))
 
 (define (seconds->work-week/day sec)
   (time->string
@@ -967,11 +970,11 @@
   (time->string
    (seconds->local-time sec) "%yww%V.%w"))
 
 (define (seconds->year-work-week/day-time sec)
   (time->string
-   (seconds->local-time sec) "%yww%V.%w %H:%M"))
+   (seconds->local-time sec) "%Yww%V.%w %H:%M"))
 
 (define (seconds->quarter sec)
   (case (string->number
 	 (time->string 
 	  (seconds->local-time sec)
@@ -1230,20 +1233,20 @@
 			 (tal (cdr launchers)))
 		(let ((patt      (car hed))
 		      (host-type (cadr hed)))
 		  (if (tests:match patt testname itempath)
 		      (begin
-			(debug:print-info 2 #f "Have flexi-launcher match for " testname "/" itempath " = " host-type)
+			(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
 			      launcher
 			      (begin
-				(debug:print-info 0 #f "WARNING: no launcher found for host-type " host-type)
+				(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)))