thread: fix resume of suspended sync

This commit is contained in:
Matthew Flatt 2018-07-29 09:59:12 -06:00
parent e066bb44ea
commit f8297f9c00
2 changed files with 9 additions and 2 deletions

View File

@ -40,7 +40,7 @@
(all-threads-poll-done?) (all-threads-poll-done?)
(waiting-on-external-or-idle?)) (waiting-on-external-or-idle?))
(or (check-external-events 'slow) (or (check-external-events 'slow)
(post-idle) (try-post-idle)
(process-sleep))) (process-sleep)))
(define child (thread-group-next! g)) (define child (thread-group-next! g))
(cond (cond
@ -196,6 +196,12 @@
;; Maybe some thread can proceed: ;; Maybe some thread can proceed:
(thread-did-work!)) (thread-did-work!))
(define (try-post-idle)
(and (post-idle)
(begin
(thread-did-work!)
#t)))
;; ---------------------------------------- ;; ----------------------------------------
(define (accum-cpu-time! t) (define (accum-cpu-time! t)

View File

@ -129,7 +129,8 @@
;; Return result in a thunk: ;; Return result in a thunk:
(lambda () #f)])] (lambda () #f)])]
[(and (all-asynchronous? s) [(and (all-asynchronous? s)
(not (syncing-selected s))) (not (syncing-selected s))
(not (syncing-need-retry? s)))
(suspend-syncing-thread s timeout-at) (suspend-syncing-thread s timeout-at)
(set-syncing-wakeup! s void) (set-syncing-wakeup! s void)
(loop #f #t)] (loop #f #t)]