diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index f74b25be84..04614d67f1 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -387,6 +387,7 @@ (define-mz scheme_end_sleeper_thread (_fun -> _void)) (define-mz scheme_sleep _pointer) +(define-mz scheme_set_place_sleep (_fun _pointer -> _void)) ;; Called through an atomic callback: (define (sleep-until-event secs fds) @@ -399,6 +400,5 @@ (define (cocoa-install-event-wakeup) (post-dummy-event) ; why do we need this? 'nextEventMatchingMask:' seems to hang if we don't use it - (set-ffi-obj! 'scheme_sleep #f _pointer (function-ptr sleep-until-event - (_fun #:atomic? #t - _float _gcpointer -> _void)))) + (scheme_set_place_sleep (function-ptr sleep-until-event + (_fun #:atomic? #t _float _gcpointer -> _void)))) diff --git a/collects/tests/racket/portlib.rktl b/collects/tests/racket/portlib.rktl index 3a59e06538..375aec63f0 100644 --- a/collects/tests/racket/portlib.rktl +++ b/collects/tests/racket/portlib.rktl @@ -830,8 +830,7 @@ ;; -------------------------------------------------- -;; Check that commit-based reading counts against a port limit: - +;; check that commit-based reading counts against a port limit: (let* ([p (make-limited-input-port (open-input-string "A\nB\nC\nD\n") 4)] diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 4159f2e71c..50ff8b6a14 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -53,6 +53,7 @@ EXPORTS scheme_cancel_sleep scheme_start_sleeper_thread scheme_end_sleeper_thread + scheme_set_place_sleep scheme_notify_sleep_progress scheme_make_thread_cell scheme_thread_cell_get diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 66fe8e5b8b..5b8a4a5d48 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -53,6 +53,7 @@ EXPORTS scheme_cancel_sleep scheme_start_sleeper_thread scheme_end_sleeper_thread + scheme_set_place_sleep scheme_notify_sleep_progress scheme_make_thread_cell scheme_thread_cell_get diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 09d13df9a2..9b2a7932fa 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -51,6 +51,7 @@ scheme_in_main_thread scheme_cancel_sleep scheme_start_sleeper_thread scheme_end_sleeper_thread +scheme_set_place_sleep scheme_notify_sleep_progress scheme_make_thread_cell scheme_thread_cell_get diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index 89d32694cc..de04422b20 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -51,6 +51,7 @@ scheme_in_main_thread scheme_cancel_sleep scheme_start_sleeper_thread scheme_end_sleeper_thread +scheme_set_place_sleep scheme_notify_sleep_progress scheme_make_thread_cell scheme_thread_cell_get diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index 3ff0e48b15..92c8b3849b 100644 --- a/src/racket/include/schthread.h +++ b/src/racket/include/schthread.h @@ -103,6 +103,8 @@ struct gmp_tmp_stack typedef intptr_t objhead; #endif +typedef void (*Scheme_Sleep_Proc)(float seconds, void *fds); + /* **************************************** */ #ifndef USE_THREAD_LOCAL @@ -323,6 +325,7 @@ typedef struct Thread_Local_Variables { struct Scheme_Prefix *scheme_prefix_finalize_; struct Scheme_Hash_Table *loaded_extensions_; struct Scheme_Hash_Table *fullpath_loaded_extensions_; + Scheme_Sleep_Proc scheme_place_sleep_; } Thread_Local_Variables; #if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS) @@ -651,6 +654,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL; #define scheme_prefix_finalize XOA (scheme_get_thread_local_variables()->scheme_prefix_finalize_) #define loaded_extensions XOA (scheme_get_thread_local_variables()->loaded_extensions_) #define fullpath_loaded_extensions XOA (scheme_get_thread_local_variables()->fullpath_loaded_extensions_) +#define scheme_place_sleep XOA (scheme_get_thread_local_variables()->scheme_place_sleep_) /* **************************************** */ diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 6750a398f9..3a9c415b28 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -135,6 +135,7 @@ MZ_EXTERN void scheme_cancel_sleep(void); MZ_EXTERN void scheme_start_sleeper_thread(void (*mzsleep)(float seconds, void *fds), float secs, void *fds, int hit_fd); MZ_EXTERN void scheme_end_sleeper_thread(); +MZ_EXTERN void scheme_set_place_sleep(Scheme_Sleep_Proc slp); MZ_EXTERN void scheme_notify_sleep_progress(); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index b0082ffdb7..2f13e9cfc3 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -93,6 +93,7 @@ int (*scheme_in_main_thread)(void); void (*scheme_cancel_sleep)(void); void (*scheme_start_sleeper_thread)(void (*mzsleep)(float seconds, void *fds), float secs, void *fds, int hit_fd); void (*scheme_end_sleeper_thread)(); +void (*scheme_set_place_sleep)(Scheme_Sleep_Proc slp); void (*scheme_notify_sleep_progress)(); Scheme_Object *(*scheme_make_thread_cell)(Scheme_Object *def_val, int inherited); Scheme_Object *(*scheme_thread_cell_get)(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 5952f78bb8..d0f8141add 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -59,6 +59,7 @@ scheme_extension_table->scheme_cancel_sleep = scheme_cancel_sleep; scheme_extension_table->scheme_start_sleeper_thread = scheme_start_sleeper_thread; scheme_extension_table->scheme_end_sleeper_thread = scheme_end_sleeper_thread; + scheme_extension_table->scheme_set_place_sleep = scheme_set_place_sleep; scheme_extension_table->scheme_notify_sleep_progress = scheme_notify_sleep_progress; scheme_extension_table->scheme_make_thread_cell = scheme_make_thread_cell; scheme_extension_table->scheme_thread_cell_get = scheme_thread_cell_get; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 2ad6ad990d..42b3768038 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -59,6 +59,7 @@ #define scheme_cancel_sleep (scheme_extension_table->scheme_cancel_sleep) #define scheme_start_sleeper_thread (scheme_extension_table->scheme_start_sleeper_thread) #define scheme_end_sleeper_thread (scheme_extension_table->scheme_end_sleeper_thread) +#define scheme_set_place_sleep (scheme_extension_table->scheme_set_place_sleep) #define scheme_notify_sleep_progress (scheme_extension_table->scheme_notify_sleep_progress) #define scheme_make_thread_cell (scheme_extension_table->scheme_make_thread_cell) #define scheme_thread_cell_get (scheme_extension_table->scheme_thread_cell_get) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index a9e7d7b6ee..f1ad0224d5 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -204,6 +204,7 @@ static void inform_GC(int master_gc, int major_gc, intptr_t pre_used, intptr_t p THREAD_LOCAL_DECL(static volatile short delayed_break_ready); THREAD_LOCAL_DECL(static Scheme_Thread *main_break_target_thread); +THREAD_LOCAL_DECL(Scheme_Sleep_Proc scheme_place_sleep_); HOOK_SHARED_OK void (*scheme_sleep)(float seconds, void *fds); HOOK_SHARED_OK void (*scheme_notify_multithread)(int on); HOOK_SHARED_OK void (*scheme_wakeup_on_input)(void *fds); @@ -3375,7 +3376,7 @@ static int check_sleep(int need_activity, int sleep_now) && !end_with_act && (do_atomic || (!p && ((!sleep_now && scheme_wakeup_on_input) - || (sleep_now && scheme_sleep))))) { + || (sleep_now && (scheme_sleep || scheme_place_sleep)))))) { double max_sleep_time = 0; /* Poll from top-level process, and all subprocesses are blocked. */ @@ -3460,7 +3461,15 @@ static int check_sleep(int need_activity, int sleep_now) mst = 100000000.0; } - scheme_sleep(mst, fds); + { + Scheme_Sleep_Proc slp; + if (scheme_place_sleep) + slp = scheme_place_sleep; + else + slp = scheme_sleep; + + slp(mst, fds); + } } else if (scheme_wakeup_on_input) scheme_wakeup_on_input(fds); @@ -3476,6 +3485,11 @@ void scheme_set_wakeup_time(void *fds, double end_time) needs_sleep_time_end = end_time; } +void scheme_set_place_sleep(Scheme_Sleep_Proc slp) +{ + scheme_place_sleep = slp; +} + static int post_system_idle() { return scheme_try_channel_get(scheme_system_idle_channel);