From 7438586cf083a591aa334eb87c4831f4803ffe35 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 2 Jan 2021 08:20:11 -0700
Subject: [PATCH] cs & thread: fix atomic timeouts

Commit 9a3eb15d8b7 broke atomic-timeout handling. As aresult, for
example, using the scroll thumb on Mac OS could freeze DrRacket as
long as something is running for a canvas refresh.
---
 racket/src/cs/schemified/thread.scm | 15 +++++++++------
 racket/src/thread/schedule.rkt      |  5 ++++-
 2 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm
index 34c3fd4348..dd25b5c8af 100644
--- a/racket/src/cs/schemified/thread.scm
+++ b/racket/src/cs/schemified/thread.scm
@@ -12507,18 +12507,21 @@
                          (poll-and-select-thread! new-leftover-ticks_0))))
                    (begin
                      (add-end-atomic-callback! engine-timeout)
-                     (loop_0 e_2 void)))))))))))
+                     (loop_0 e_2 check-for-atomic-timeout)))))))))))
      (loop_0 e_0 check-break-prefix))))
 (define check-break-prefix
   (lambda ()
     (begin
       (current-thread-now-running!)
       (1/check-for-break)
-      (if (unsafe-place-local-ref cell.4)
-        (if (positive? (current-atomic))
-          (|#%app| (unsafe-place-local-ref cell.4) #f)
-          (void))
-        (void)))))
+      (check-for-atomic-timeout))))
+(define check-for-atomic-timeout
+  (lambda ()
+    (if (unsafe-place-local-ref cell.4)
+      (if (positive? (current-atomic))
+        (|#%app| (unsafe-place-local-ref cell.4) #f)
+        (void))
+      (void))))
 (define maybe-done
   (lambda (callbacks_0)
     (if (pair? callbacks_0)
diff --git a/racket/src/thread/schedule.rkt b/racket/src/thread/schedule.rkt
index 8ae6f41bff..fcdc7a21cd 100644
--- a/racket/src/thread/schedule.rkt
+++ b/racket/src/thread/schedule.rkt
@@ -174,11 +174,14 @@
              ;; where host-system interrupts are not disabled (i.e.,
              ;; don't use `engine-block` instead of `engine-timeout`):
              (add-end-atomic-callback! engine-timeout)
-             (loop e void)])])))))
+             (loop e check-for-atomic-timeout)])])))))
 
 (define (check-break-prefix)
   (current-thread-now-running!)
   (check-for-break)
+  (check-for-atomic-timeout))
+
+(define (check-for-atomic-timeout)
   (when atomic-timeout-callback
     (when (positive? (current-atomic))
       (atomic-timeout-callback #f))))