From d3e4fbe7a75087d989b8e78f30a3e34a1e5fe417 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 14 Dec 2012 06:31:21 -0700
Subject: [PATCH] make scheme_check_threads() run at least on thread quantum

As long as some thread is ready to run, and in case the threads
synchronize after very little work, keep checking threads for
at least one thread quantum.
---
 collects/scribblings/inside/threads.scrbl |  7 +++++--
 src/racket/src/thread.c                   | 20 +++++++++++++++-----
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/collects/scribblings/inside/threads.scrbl b/collects/scribblings/inside/threads.scrbl
index 08d506a06c..ce9cd4368a 100644
--- a/collects/scribblings/inside/threads.scrbl
+++ b/collects/scribblings/inside/threads.scrbl
@@ -553,8 +553,11 @@ it wakes up if the Racket thread if it is sleeping.}
 @function[(void scheme_check_threads)]{
 
 This function is periodically called by the embedding program to give
-background processes time to execute.  See @secref["threadtime"]
-for more information.}
+background processes time to execute. See @secref["threadtime"]
+for more information.
+
+As long as some threads are ready, this functions returns only after
+one thread quantum, at least.}
 
 @function[(void scheme_wake_up)]{
 
diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c
index e31cc8705a..9bc64459c9 100644
--- a/src/racket/src/thread.c
+++ b/src/racket/src/thread.c
@@ -4074,13 +4074,23 @@ void scheme_cancel_sleep()
 }
 
 void scheme_check_threads(void)
-/* Signals should be suspended. */
 {
-  scheme_current_thread->suspend_break++;
-  scheme_thread_block((float)0);
-  --scheme_current_thread->suspend_break;
+  double start, now;
 
-  check_sleep(have_activity, 0);
+  start = scheme_get_inexact_milliseconds();
+  
+  while (1) {
+    scheme_current_thread->suspend_break++;
+    scheme_thread_block((float)0);
+    --scheme_current_thread->suspend_break;
+    
+    if (check_sleep(have_activity, 0))
+      break;
+
+    now = scheme_get_inexact_milliseconds();
+    if (((now - start) * 1000) > MZ_THREAD_QUANTUM_USEC)
+      break;
+  }
 }
 
 void scheme_wake_up(void)