thread: fix scheduler's handling of async callbacks

If the callback takes too long to run, then a second copy was
scheduled --- which likely schedules a third copy, and so on. This
problem could lead DrRacket to get stuck in a GC cycle, for example.
This commit is contained in:
Matthew Flatt 2020-06-01 13:25:00 -06:00
parent 613155a317
commit 11f4a0048b

View File

@ -221,21 +221,25 @@
[(null? callbacks) (swap-in-engine e t leftover-ticks)] [(null? callbacks) (swap-in-engine e t leftover-ticks)]
[else [else
(define done? #f) (define done? #f)
(let loop ([e e]) (let loop ([e e] [callbacks callbacks])
(end-implicit-atomic-mode) (end-implicit-atomic-mode)
(e (e
TICKS TICKS
(if (pair? callbacks)
;; run callbacks as a "prefix" callbacks
(lambda () (lambda ()
(run-callbacks callbacks) (run-callbacks callbacks)
(set! done? #t) (set! done? #t)
(engine-block)) (engine-block))
;; still running callbacks, so no new prefix
void)
(lambda (e result remaining) (lambda (e result remaining)
(start-implicit-atomic-mode) (start-implicit-atomic-mode)
(unless e (unless e
(internal-error "thread ended while it should run callbacks atomically")) (internal-error "thread ended while it should run callbacks atomically"))
(if done? (if done?
(swap-in-engine e t leftover-ticks) (swap-in-engine e t leftover-ticks)
(loop e)))))])) (loop e null)))))]))
;; Run foreign "async-apply" callbacks, now that we're in some thread ;; Run foreign "async-apply" callbacks, now that we're in some thread
(define (run-callbacks callbacks) (define (run-callbacks callbacks)