diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 95f0234860..50dd80d544 100644 --- a/src/racket/include/mzwin.def +++ b/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 diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index cf62b065bf..6c19219f94 100644 --- a/src/racket/include/mzwin3m.def +++ b/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 diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 0585aad718..f11d821d40 100644 --- a/src/racket/include/racket.exp +++ b/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 diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index 153a2ae997..19c6741af8 100644 --- a/src/racket/include/racket3m.exp +++ b/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 diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index 8d407e2fa9..e120d3d0f4 100644 --- a/src/racket/include/schthread.h +++ b/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_) diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index dd13e5f970..78e2d1db06 100644 --- a/src/racket/src/schemef.h +++ b/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); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 9b79f56a5e..fcb562eab9 100644 --- a/src/racket/src/schemex.h +++ b/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); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index ab1c5aaea0..eef964f522 100644 --- a/src/racket/src/schemex.inc +++ b/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; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 42cd0c34a2..c6e1ba6854 100644 --- a/src/racket/src/schemexm.h +++ b/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) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 76222ca436..033125f174 100644 --- a/src/racket/src/thread.c +++ b/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);