place-specific low-level "sleep" function

to make racket/gui work right with places (running
 in just one of them) on Mac OS X

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))))

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)]

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

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

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

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

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_)
 
 /* **************************************** */
 

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();
 

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);

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;

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)

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);