Megatest

Diff
Login

Differences From Artifact [4ce5effbaa]:

To Artifact [9b64b448cf]:


288
289
290
291
292
293
294
295


296
297
298
299
300
301

302
303
304
305
306
307
308
309
310
311












312
313
314
315
316
317
318
288
289
290
291
292
293
294

295
296
297
298
299
300


301










302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320







-
+
+




-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+







(define *watchdog*
  (make-thread 
   (lambda ()
     (thread-sleep! 0.5) ;; half second delay for startup
     (let loop ()
       ;; sync for filesystem local db writes
       ;;
       (let ((start-time (current-seconds)))
       (let ((start-time      (current-seconds))
	     (servers-started (make-hash-table)))
	 (mutex-lock! *db-multi-sync-mutex*)
	 (for-each 
	  (lambda (run-id)
	    (let ((last-write (hash-table-ref/default *db-local-sync* run-id 0)))
	      (if ;; (and 
	       (> (- start-time last-write) 5) ;; every five seconds
	      (if (> (- start-time last-write) 5) ;; every five seconds
	       ;;      (common:db-access-allowed?))
	       (let ((sync-time (- (current-seconds) start-time)))
		 (db:multi-db-sync (list run-id) 'new2old)
		 (if (common:low-noise-print 30 "sync new to old")
		     (begin
		       (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
		       (if (> sync-time 10) ;; took more than ten seconds, start a server for this run
			   (debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id)
			   (server:kind-run run-id))))
		 (hash-table-delete! *db-local-sync* run-id)))))
		  (let ((sync-time (- (current-seconds) start-time)))
		    (db:multi-db-sync (list run-id) 'new2old)
		    (if (common:low-noise-print 30 "sync new to old")
			(begin
			  (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
			  (if (and (> sync-time 10) ;; took more than ten seconds, start a server for this run
				   (hash-table-ref/default servers-started run-id #f))
			      (begin
				(debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id)
				(server:kind-run run-id)
				(hash-table-set! servers-started run-id #t)))))
		    (hash-table-delete! *db-local-sync* run-id)))))
	  (hash-table-keys *db-local-sync*))
	 (mutex-unlock! *db-multi-sync-mutex*))
       
       ;; keep going unless time to exit
       ;;
       (if (not *time-to-exit*)
	   (begin