fix problems with windows event handling and sleeping

svn: r14675

src/mred/mredmsw.cxx

@@ -44,9 +44,6 @@ extern "C" {
   void scheme_forget_thread(struct Scheme_Thread_Memory *);
 };
 
-static int found_nothing;
-static DWORD max_sleep_time;
-
 static volatile int need_quit;
 
 extern void wxDoPreGM(void);
@@ -183,7 +180,6 @@ static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
                     info->remove ? PM_REMOVE : PM_NOREMOVE)) {
       info->wnd = wnd;
       info->c_return = c;
-      found_nothing = 0;
       return FALSE;
     }
   }
@@ -219,7 +215,6 @@ int FindReady(MrEdContext *c, MSG *msg, int remove, MrEdContext **c_return)
   {
     MSG pmsg;
     while (PeekMessage(&pmsg, NULL, 0x4000, 0xFFFF, PM_REMOVE)) {
-      found_nothing = 0;
       wxTranslateMessage(&pmsg);
       DispatchMessage(&pmsg);
     }
@@ -855,67 +850,8 @@ void MrEdMSWSleep(float secs, void *fds, SLEEP_PROC_PTR mzsleep)
   if (wxCheckMousePosition())
     return;
 
-  /* If the event queue is empty (as reported by GetQueueStatus),
+  scheme_add_fd_eventmask(fds, QS_ALLINPUT);
-     everything's ok.
+  mzsleep(secs, fds);
-
-     Otherwise, we have trouble sleeping until an event is ready. We
-     sometimes leave events on th queue because, say, an eventspace is
-     not ready. The problem is that MsgWait... only unbocks when a new
-     event appears. Since we check the queue using a seuqence of
-     PeekMessages, it's possible that an event is added during the
-     middle of our sequence, but doesn't get handled.
-
-     We try to avoid this problem by going through the sequence
-     twice. But that still doesn't always work. For the general case,
-     then, we don't actually sleep indefinitely. Instead, we slep 10
-     ms, then 20 ms, etc. This exponential backoff ensures that we
-     eventually handle a pending event, but we don't spin and eat CPU
-     cycles. */
-
-  if (GetQueueStatus(QS_ALLINPUT)) {
-    /* Maybe the events are new since we last checked, or maybe
-       they're not going to be dispatched until something else
-       unblocks. Go into exponential-back-off mode. */
-    if (found_nothing) {
-      /* Ok, we gone around at least once. */
-      if (max_sleep_time < 0x20000000)
-	max_sleep_time *= 2;
-    } else {
-      /* Starting back-off mode */
-      found_nothing = 1;
-      max_sleep_time = 10;
-      return;
-    }
-  } else {
-    /* Disable back-off mode */
-    found_nothing = 0;
-    max_sleep_time = 0;
-  }
-
-  if (secs > 0) {
-    if (secs > 100000)
-      msecs = 100000000;
-    else
-      msecs = (DWORD)(secs * 1000);
-    if (max_sleep_time && (msecs > max_sleep_time))
-      msecs = max_sleep_time;
-  } else {
-    if (max_sleep_time) {
-      msecs = max_sleep_time;
-      /* Avoid infinite sleep: */
-      secs = 1.0;
-    } else
-      msecs = 0;
-  }
-
-  if (fds) {
-    scheme_add_fd_eventmask(fds, QS_ALLINPUT);
-    mzsleep(secs, fds);
-  } else if (wxTheApp->keep_going) {
-    MsgWaitForMultipleObjects(0, NULL, FALSE,
-			      secs ? msecs : INFINITE,
-			      QS_ALLINPUT);
-  }
 }
 
 void wxQueueLeaveEvent(void *ctx, wxWindow *wnd, int x, int y, int flags)

src/mzscheme/src/port.c

@@ -925,6 +925,35 @@ void scheme_add_fd_eventmask(void *fds, int mask)
 #endif
 }
 
+#if defined(WIN32_FD_HANDLES)
+void WSAEventSelect_plus_check(SOCKET s, WSAEVENT e, long mask)
+{
+  fd_set rd[1], wr[1], ex[1];
+  struct timeval t = {0, 0};
+
+  WSAEventSelect(s, e, mask);
+  
+  /* double-check with select(), because WSAEventSelect only
+     handles new activity (I think) */
+  FD_ZERO(rd);
+  FD_ZERO(wr);
+  FD_ZERO(ex);
+
+  if (mask & FD_READ)
+    FD_SET(s, rd);
+  if (mask & FD_WRITE)
+    FD_SET(s, wr);
+  if (mask & FD_OOB)
+    FD_SET(s, ex);
+
+  if (select(1, rd, wr, ex, &t)) {
+    /* already ready */
+    WSAEventSelect(s, NULL, 0);
+    SetEvent(e);
+  }
+}
+#endif
+
 void scheme_collapse_win_fd(void *fds)
 {
 #if defined(WIN32_FD_HANDLES)
@@ -980,7 +1009,7 @@ void scheme_collapse_win_fd(void *fds)
     for (i = SCHEME_INT_VAL(rfd->added); i--; ) {
       s = rfd->sockets[i];
       if (s != INVALID_SOCKET) {
-	mask = FD_READ | FD_ACCEPT | FD_CONNECT | FD_CLOSE;
+	mask = FD_READ | FD_ACCEPT | FD_CLOSE;
 	
 	for (j = SCHEME_INT_VAL(wfd->added); j--; ) {
 	  if (wfd->sockets[j] == s) {
@@ -998,7 +1027,7 @@ void scheme_collapse_win_fd(void *fds)
 
 	e = WSACreateEvent();
 	wa[p++] = e;
-	WSAEventSelect(s, e, mask);
+	WSAEventSelect_plus_check(s, e, mask);
       }
     }
 
@@ -1024,7 +1053,7 @@ void scheme_collapse_win_fd(void *fds)
 	  
 	  e = WSACreateEvent();
 	  wa[p++] = e;
-	  WSAEventSelect(s, e, mask);
+	  WSAEventSelect_plus_check(s, e, mask);
 	}
       }
     }
@@ -1052,7 +1081,7 @@ void scheme_collapse_win_fd(void *fds)
 	  if (mask) {
 	    e = WSACreateEvent();
 	    wa[p++] = e;
-	    WSAEventSelect(s, e, mask);
+	    WSAEventSelect_plus_check(s, e, mask);
 	  }
 	}
       }
@@ -8015,6 +8044,7 @@ void scheme_release_file_descriptor(void)
 /****************** Windows cleanup  *****************/
 
 #if defined(WIN32_FD_HANDLES)
+
 static void clean_up_wait(long result, OS_SEMAPHORE_TYPE *array,
 			  int *rps, int count)
 {
@@ -8027,6 +8057,21 @@ static void clean_up_wait(long result, OS_SEMAPHORE_TYPE *array,
   /* Clear out break semaphore */
   WaitForSingleObject(scheme_break_semaphore, 0);
 }
+
+static int made_progress;
+static DWORD max_sleep_time;
+
+void scheme_notify_sleep_progres()
+{
+  made_progress = 1;
+}
+
+#else
+
+void scheme_notify_sleep_progres()
+{
+}
+
 #endif
 
 /******************** Main sleep function  *****************/
@@ -8177,21 +8222,58 @@ static void default_sleep(float v, void *fds)
       break_sema = scheme_break_semaphore;
       array[count++] = break_sema;
 
-      /* Wait for HANDLE-based input: */
+      /* Extensions may handle events.
-      /* Extensions may handle events */
+	 If the event queue is empty (as reported by GetQueueStatus),
+	 everything's ok.
+
+	 Otherwise, we have trouble sleeping until an event is ready. We
+	 sometimes leave events on th queue because, say, an eventspace is
+	 not ready. The problem is that MsgWait... only unblocks when a new
+	 event appears. Since extensions may check the queue using a sequence of
+	 PeekMessages, it's possible that an event is added during the
+	 middle of the sequence, but doesn't get handled.
+
+	 To avoid this problem, we don't actually sleep indefinitely if an event
+	 is pending. Instead, we slep 10 ms, then 20 ms, etc. This exponential 
+	 backoff ensures that we eventually handle a pending event, but we don't 
+	 spin and eat CPU cycles. The back-off is reset whenever a thread makes
+	 progress. */
+
+
       if (SCHEME_INT_VAL(((win_extended_fd_set *)fds)->wait_event_mask)
-	  && GetQueueStatus(SCHEME_INT_VAL(((win_extended_fd_set *)fds)->wait_event_mask)))
+	  && GetQueueStatus(SCHEME_INT_VAL(((win_extended_fd_set *)fds)->wait_event_mask))) {
-	result = WAIT_TIMEOUT; /* doesn't matter... */
+	if (!made_progress) {
-      else {
+	  /* Ok, we've gone around at least once. */
+	  if (max_sleep_time < 0x20000000)
+	    max_sleep_time *= 2;
+	} else {
+	  /* Starting back-off mode */
+	  made_progress = 0;
+	  max_sleep_time = 5;
+	}
+      } else {
+	/* Disable back-off mode */
+	made_progress = 1;
+	max_sleep_time = 0;
+      }
+
+      /* Wait for HANDLE-based input: */
+      {
 	DWORD msec;
 	if (v) {
 	  if (v > 100000)
 	    msec = 100000000;
 	  else
 	    msec = (DWORD)(v * 1000);
+	  if (max_sleep_time && (msec > max_sleep_time))
+	    msec = max_sleep_time;
 	} else {
-	  msec = INFINITE;
+	  if (max_sleep_time)
+	    msec = max_sleep_time;
+	  else
+	    msec = INFINITE;
 	}
+
 	result = MsgWaitForMultipleObjects(count, array, FALSE, msec,
 					   SCHEME_INT_VAL(((win_extended_fd_set *)fds)->wait_event_mask));
       }

src/mzscheme/src/thread.c

@@ -118,6 +118,7 @@ extern void *scheme_gmp_tls_load(long *s);
 extern void scheme_gmp_tls_unload(long *s, void *p);
 extern void scheme_gmp_tls_snapshot(long *s, long *save);
 extern void scheme_gmp_tls_restore_snapshot(long *s, void *data, long *save, int do_free);
+extern void scheme_notify_sleep_progres();
 
 static void check_ready_break();
 
@@ -3491,17 +3492,21 @@ static int check_sleep(int need_activity, int sleep_now)
   
   p2 = scheme_first_thread;
   while (p2) {
-    p2->ran_some = 0;
+    if (p2->ran_some) {
+      scheme_notify_sleep_progres();
+      p2->ran_some = 0;
+    }
     p2 = p2->next;
   }
   
   end_with_act = thread_ended_with_activity;
   thread_ended_with_activity = 0;
   
-  if (need_activity && !end_with_act && 
+  if (need_activity 
-      (do_atomic 
+      && !end_with_act 
-       || (!p && ((!sleep_now && scheme_wakeup_on_input)
+      && (do_atomic 
-		  || (sleep_now && scheme_sleep))))) {
+	  || (!p && ((!sleep_now && scheme_wakeup_on_input)
+		     || (sleep_now && scheme_sleep))))) {
     double max_sleep_time = 0;
 
     /* Poll from top-level process, and all subprocesses are blocked. */