Megatest

Check-in [0ca08ed334]
Login
Overview
Comment:Speed up exit by moving delays around in the watchdog
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 0ca08ed33418520f6c43156df77da7b9332b862d
User & Date: mrwellan on 2014-11-02 11:09:30
Other Links: branch diff | manifest | tags
Context
2014-11-03
23:40
Moving newdashboard forward check-in: 255fa799a6 user: matt tags: v1.60
2014-11-02
11:09
Speed up exit by moving delays around in the watchdog check-in: 0ca08ed334 user: mrwellan tags: v1.60
09:25
Merged streamline exception handling branch into v1.60 check-in: 8fd7d261b7 user: matt tags: v1.60
Changes

Modified megatest.scm from [93df8109f6] to [f4fb8b012f].

284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300
284
285
286
287
288
289
290
291
292


293
294
295
296
297
298
299







+

-
-







		 0))

;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog*
  (make-thread 
   (lambda ()
     (thread-sleep! 0.5) ;; half second delay for startup
     (let loop ()
       (thread-sleep! 5) ;; five second resolution is only a minor burden and should be tolerable 

       ;; sync for filesystem local db writes
       ;;
       (let ((start-time (current-seconds)))
	 (mutex-lock! *db-multi-sync-mutex*)
	 (for-each 
	  (lambda (run-id)
	    (let ((last-write (hash-table-ref/default *db-local-sync* run-id 0)))
308
309
310
311
312
313
314


315

316
317
318
319
320
321
322
307
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323







+
+
-
+







		 (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
	     (thread-sleep! 5) ;; five second resolution is only a minor burden and should be tolerable 
	   (loop))))
	     (loop)))))
   "Watchdog thread"))

(thread-start! *watchdog*)

(define (std-exit-procedure)
  (rmt:print-db-stats)
  (let ((run-ids (hash-table-keys *db-local-sync*)))