add way to constrain poll/select timeout from low-level evt

src/racket/include/mzwin.def

@@ -459,6 +459,7 @@ EXPORTS
  scheme_add_fd_handle
  scheme_add_fd_eventmask
  scheme_collapse_win_fd
+ scheme_set_wakeup_time
  scheme_security_check_file
  scheme_security_check_file_link
  scheme_security_check_network

src/racket/include/mzwin3m.def

@@ -474,6 +474,7 @@ EXPORTS
  scheme_add_fd_handle
  scheme_add_fd_eventmask
  scheme_collapse_win_fd
+ scheme_set_wakeup_time
  scheme_security_check_file
  scheme_security_check_file_link
  scheme_security_check_network

src/racket/include/racket.exp

@@ -476,6 +476,7 @@ scheme_fdisset
 scheme_add_fd_handle
 scheme_add_fd_eventmask
 scheme_collapse_win_fd
+scheme_set_wakeup_time
 scheme_security_check_file
 scheme_security_check_file_link
 scheme_security_check_network

src/racket/include/racket3m.exp

@@ -482,6 +482,7 @@ scheme_fdisset
 scheme_add_fd_handle
 scheme_add_fd_eventmask
 scheme_collapse_win_fd
+scheme_set_wakeup_time
 scheme_security_check_file
 scheme_security_check_file_link
 scheme_security_check_network

src/racket/include/schthread.h

@@ -229,6 +229,7 @@ typedef struct Thread_Local_Variables {
   int thread_ended_with_activity_;
   int scheme_no_stack_overflow_;
   int needs_sleep_cancelled_;
+  double needs_sleep_time_end_;
   int tls_pos_;
   struct Scheme_Object *the_nested_exn_handler_;
   struct Scheme_Object *cust_closers_;
@@ -522,6 +523,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define thread_ended_with_activity XOA (scheme_get_thread_local_variables()->thread_ended_with_activity_)
 #define scheme_no_stack_overflow XOA (scheme_get_thread_local_variables()->scheme_no_stack_overflow_)
 #define needs_sleep_cancelled XOA (scheme_get_thread_local_variables()->needs_sleep_cancelled_)
+#define needs_sleep_time_end XOA (scheme_get_thread_local_variables()->needs_sleep_time_end_)
 #define tls_pos XOA (scheme_get_thread_local_variables()->tls_pos_)
 #define the_nested_exn_handler XOA (scheme_get_thread_local_variables()->the_nested_exn_handler_)
 #define cust_closers XOA (scheme_get_thread_local_variables()->cust_closers_)

src/racket/src/schemef.h

@@ -897,6 +897,8 @@ MZ_EXTERN void scheme_add_fd_handle(void *h, void *fds, int repost);
 MZ_EXTERN void scheme_add_fd_eventmask(void *fds, int mask);
 MZ_EXTERN void scheme_collapse_win_fd(void *fds);
 
+MZ_EXTERN void scheme_set_wakeup_time(void *fds, double end_time);
+
 MZ_EXTERN void scheme_security_check_file(const char *who, const char *filename, int guards);
 MZ_EXTERN void scheme_security_check_file_link(const char *who, const char *filename, const char *content);
 MZ_EXTERN void scheme_security_check_network(const char *who, const char *host, int port, int client);

src/racket/src/schemex.h

@@ -751,6 +751,7 @@ int (*scheme_fdisset)(void *fd, int pos);
 void (*scheme_add_fd_handle)(void *h, void *fds, int repost);
 void (*scheme_add_fd_eventmask)(void *fds, int mask);
 void (*scheme_collapse_win_fd)(void *fds);
+void (*scheme_set_wakeup_time)(void *fds, double end_time);
 void (*scheme_security_check_file)(const char *who, const char *filename, int guards);
 void (*scheme_security_check_file_link)(const char *who, const char *filename, const char *content);
 void (*scheme_security_check_network)(const char *who, const char *host, int port, int client);

src/racket/src/schemex.inc

@@ -528,6 +528,7 @@
   scheme_extension_table->scheme_add_fd_handle = scheme_add_fd_handle;
   scheme_extension_table->scheme_add_fd_eventmask = scheme_add_fd_eventmask;
   scheme_extension_table->scheme_collapse_win_fd = scheme_collapse_win_fd;
+  scheme_extension_table->scheme_set_wakeup_time = scheme_set_wakeup_time;
   scheme_extension_table->scheme_security_check_file = scheme_security_check_file;
   scheme_extension_table->scheme_security_check_file_link = scheme_security_check_file_link;
   scheme_extension_table->scheme_security_check_network = scheme_security_check_network;

src/racket/src/schemexm.h

@@ -528,6 +528,7 @@
 #define scheme_add_fd_handle (scheme_extension_table->scheme_add_fd_handle)
 #define scheme_add_fd_eventmask (scheme_extension_table->scheme_add_fd_eventmask)
 #define scheme_collapse_win_fd (scheme_extension_table->scheme_collapse_win_fd)
+#define scheme_set_wakeup_time (scheme_extension_table->scheme_set_wakeup_time)
 #define scheme_security_check_file (scheme_extension_table->scheme_security_check_file)
 #define scheme_security_check_file_link (scheme_extension_table->scheme_security_check_file_link)
 #define scheme_security_check_network (scheme_extension_table->scheme_security_check_network)

src/racket/src/thread.c

@@ -221,6 +221,7 @@ THREAD_LOCAL_DECL(int scheme_active_but_sleeping = 0);
 THREAD_LOCAL_DECL(static int thread_ended_with_activity);
 THREAD_LOCAL_DECL(int scheme_no_stack_overflow);
 THREAD_LOCAL_DECL(static int needs_sleep_cancelled);
+THREAD_LOCAL_DECL(static double needs_sleep_time_end); /* back-door result */
 THREAD_LOCAL_DECL(static int tls_pos = 0);
 /* On swap, put target in a static variable, instead of on the stack,
    so that the swapped-out thread is less likely to have a pointer
@@ -3648,17 +3649,27 @@ static int check_sleep(int need_activity, int sleep_now)
     p = scheme_first_thread;
     while (p) {
       int merge_time = 0;
+      double p_time;
 
       if (p->nestee) {
 	/* nothing */
       } else if (p->block_descriptor == GENERIC_BLOCKED) {
+        needs_sleep_time_end = -1.0;
 	if (p->block_needs_wakeup) {
 	  Scheme_Needs_Wakeup_Fun f = p->block_needs_wakeup;
 	  f(p->blocker, fds);
 	}
-	merge_time = (p->sleep_end > 0.0);
+        p_time = p->sleep_end;
+	merge_time = (p_time > 0.0);
+        if (needs_sleep_time_end > 0.0) {
+          if (!merge_time || (needs_sleep_time_end < p_time)) {
+            p_time = needs_sleep_time_end;
+            merge_time = 1;
+          }
+        }
       } else if (p->block_descriptor == SLEEP_BLOCKED) {
 	merge_time = 1;
+        p_time = p->sleep_end;
       }
 
       if (merge_time) {
@@ -3703,6 +3714,12 @@ static int check_sleep(int need_activity, int sleep_now)
   return 0;
 }
 
+void scheme_set_wakeup_time(void *fds, double end_time)
+{
+  /* should be called only during a needs_wakeup callback */
+  needs_sleep_time_end = end_time;
+}
+
 static int post_system_idle()
 {
   return scheme_try_channel_get(scheme_system_idle_channel);