From 11f4a0048ba5ca50a378f3dd7bf23923bddda0df Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 1 Jun 2020 13:25:00 -0600 Subject: [PATCH] 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. --- racket/src/thread/schedule.rkt | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/racket/src/thread/schedule.rkt b/racket/src/thread/schedule.rkt index dd4c55c8c0..668a84c2f0 100644 --- a/racket/src/thread/schedule.rkt +++ b/racket/src/thread/schedule.rkt @@ -221,21 +221,25 @@ [(null? callbacks) (swap-in-engine e t leftover-ticks)] [else (define done? #f) - (let loop ([e e]) + (let loop ([e e] [callbacks callbacks]) (end-implicit-atomic-mode) (e TICKS - (lambda () - (run-callbacks callbacks) - (set! done? #t) - (engine-block)) + (if (pair? callbacks) + ;; run callbacks as a "prefix" callbacks + (lambda () + (run-callbacks callbacks) + (set! done? #t) + (engine-block)) + ;; still running callbacks, so no new prefix + void) (lambda (e result remaining) (start-implicit-atomic-mode) (unless e (internal-error "thread ended while it should run callbacks atomically")) (if done? (swap-in-engine e t leftover-ticks) - (loop e)))))])) + (loop e null)))))])) ;; Run foreign "async-apply" callbacks, now that we're in some thread (define (run-callbacks callbacks)