284
285
286
287
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
321
322
323
324
325
326
327
328
|
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 ()
;; sync for filesystem local db writes
;;
(let ((start-time (current-seconds))
(servers-started (make-hash-table)))
(mutex-lock! *db-multi-sync-mutex*)
(let ((last-write (hash-table-ref/default *db-local-sync* run-id 0)))
(if (> (- start-time last-write) 5) ;; every five seconds
(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*))
(thread-sleep! 5) ;; five second resolution is only a minor burden and should be tolerable
(loop)))))
"Watchdog thread"))
(thread-start! *watchdog*)
(define (std-exit-procedure)
(rmt:print-db-stats)
|
|
<
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
>
|
|
|
284
285
286
287
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
321
322
323
324
325
326
327
328
|
0))
;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog*
(make-thread
(lambda ()
(thread-sleep! 0.05) ;; delay for startup
(let loop ()
;; sync for filesystem local db writes
;;
(let ((start-time (current-seconds))
(servers-started (make-hash-table)))
(for-each
(lambda (run-id)
(mutex-lock! *db-multi-sync-mutex*)
(if (hash-table-ref/default *db-local-sync* run-id 0)
;; (if (> (- start-time last-write) 5) ;; every five seconds
(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)))
(mutex-unlock! *db-multi-sync-mutex*))
(hash-table-keys *db-local-sync*)))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
(begin
(thread-sleep! 1) ;; wait one second before syncing again
(loop)))))
"Watchdog thread"))
(thread-start! *watchdog*)
(define (std-exit-procedure)
(rmt:print-db-stats)
|
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
|
(begin
(db:multi-db-sync
#f ;; do all run-ids
'killservers
'dejunk
'adj-testids
'old2new
'new2old
)
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
(begin
(db:multi-db-sync
#f ;; do all run-ids
|
|
|
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
|
(begin
(db:multi-db-sync
#f ;; do all run-ids
'killservers
'dejunk
'adj-testids
'old2new
;; 'new2old
)
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
(begin
(db:multi-db-sync
#f ;; do all run-ids
|