Adding FFI polling mode

With this option, FFI calls always block until scheme_check_foreign_work
is called by the program embedding Racket.

This is needed for embedding Racket into contexts where you do not
control the event loop, need Racket to make FFI calls, and those FFI
calls must occur on a thread within the event loop. A good example of
this is with OpenGL FFI calls that require the current thread to hold
the OpenGL/EGL context.

An important point about this is that scheme_check_foreign_work will
only execute a single FFI call. So if this is used for OpenGL rendering,
you'll want to run it a lot.

racket/src/configure

@@ -823,6 +823,7 @@ enable_backtrace
 enable_pthread
 enable_stackup
 enable_bigendian
+enable_ffipoll
 enable_gprof
 enable_gcov
 enable_noopt
@@ -1475,6 +1476,7 @@ Optional Features:
   --enable-pthread        link with pthreads (usually auto-enabled if needed)
   --enable-stackup        assume "up" if stack direction cannot be determined
   --enable-bigendian      assume "big" if endianness cannot be determined
+  --enable-ffipoll        only make FFI calls if embedding program explicitly polls
   --enable-gprof          compile for profiling with gprof (gcc only)
   --enable-gcov           compile to gather gcov statistics (gcc3 only)
   --enable-strip          strip debug on install (usually enabled by default)
@@ -2792,6 +2794,11 @@ if test "${enable_bigendian+set}" = set; then :
   enableval=$enable_bigendian;
 fi
 
+# Check whether --enable-ffipoll was given.
+if test "${enable_ffipoll+set}" = set; then :
+  enableval=$enable_ffipoll;
+fi
+
 
 # AC_ARG_ENABLE(oskit,   [  --enable-oskit          compile OSKit-based Racket kernel])
 # AC_ARG_ENABLE(smalloskit, [  --enable-smalloskit     compile small OSKit-based Racket kernel])
@@ -3060,6 +3067,7 @@ show_explicitly_enabled "${enable_extflonum}" "Extflonums"
 show_explicitly_disabled "${enable_extflonum}" "Extflonums"
 
 show_explicitly_enabled "${enable_pthread}" "pthreads"
+show_explicitly_enabled "${enable_ffipoll}" "ffipoll"
 show_explicitly_enabled "${enable_oskit}" "OSKit"
 show_explicitly_enabled "${enable_smalloskit}" "OSKit small mode"
 
@@ -6508,6 +6516,14 @@ $as_echo "#define MZ_USE_FUTURES 1" >>confdefs.h
   enable_mzrt=yes
 fi
 
+############### ffipoll ###################
+
+if test "${enable_ffipoll}" = "yes" ; then
+
+$as_echo "#define MZ_USE_FFIPOLL 1" >>confdefs.h
+
+fi
+
 ############## compare-and-swap ################
 
 if test "${enable_mzrt}" = "yes" ; then

racket/src/foreign/foreign.c

@@ -12,6 +12,12 @@
 
 #include <errno.h>
 
+#ifdef MZ_USE_FFIPOLL
+# define MZ_USE_FFIPOLL_COND 1
+#else
+# define MZ_USE_FFIPOLL_COND 0
+#endif
+
 #ifndef SIZEOF_BOOL
 # define SIZEOF_BOOL 0
 #endif /* SIZEOF_BOOL */
@@ -3505,7 +3511,10 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
          to handle those anyway, since the call in the original
          place may lead to a callback that should run in
          this place. */
+#     ifdef MZ_USE_FFIPOLL
+#     else
       check_foreign_work(0);
+#     endif
     }
   }
 }
@@ -3580,7 +3589,7 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
   int i;
   intptr_t basetype, offset, *offsets;
 #ifdef MZ_USE_PLACES
-  if (orig_place && (scheme_current_place_id == 0))
+  if (orig_place && ((scheme_current_place_id == 0) && !MZ_USE_FFIPOLL_COND))
     orig_place = 0;
 #endif
   if (!cif) {
@@ -3722,7 +3731,7 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
   int i, nargs, save_errno;
   Scheme_Object *lock = scheme_false;
 # ifdef MZ_USE_PLACES
-  int orig_place;
+  int orig_place = MZ_USE_FFIPOLL_COND;
 # define FFI_CALL_VEC_SIZE 9
 # else /* MZ_USE_PLACES undefined */
 # define FFI_CALL_VEC_SIZE 8
@@ -3757,7 +3766,7 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
     }
   } else
     save_errno = 0;
-# ifdef MZ_USE_PLACES
+# if defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL)
   if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
   else orig_place = 0;
 # endif /* MZ_USE_PLACES */
@@ -3899,6 +3908,9 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
 }
 
 static void check_foreign_work(int check_for_in_original)
+#ifdef MZ_USE_FFIPOLL
+XFORM_SKIP_PROC
+#endif
 {
   GC_CAN_IGNORE Queued_Callback *qc;
   ffi_callback_struct *data;
@@ -3933,7 +3945,7 @@ static void check_foreign_work(int check_for_in_original)
   }
 
 #ifdef MZ_USE_PLACES
-  if (check_for_in_original && (scheme_current_place_id == 0) && orig_place_mutex) {
+  if (check_for_in_original && ((scheme_current_place_id == 0) || MZ_USE_FFIPOLL_COND) && orig_place_mutex) {
     FFI_Orig_Place_Call *todo;
     void *sh;
 
@@ -3967,6 +3979,9 @@ static void check_foreign_work(int check_for_in_original)
 }
 
 void scheme_check_foreign_work(void)
+#ifdef MZ_USE_FFIPOLL
+XFORM_SKIP_PROC
+#endif
 {
   check_foreign_work(1);
 }

racket/src/racket/configure.ac

@@ -76,6 +76,7 @@ AC_ARG_ENABLE(backtrace, [  --enable-backtrace      3m: support GC backtrace dum
 AC_ARG_ENABLE(pthread, [  --enable-pthread        link with pthreads (usually auto-enabled if needed)])
 AC_ARG_ENABLE(stackup, [  --enable-stackup        assume "up" if stack direction cannot be determined])
 AC_ARG_ENABLE(bigendian, [  --enable-bigendian      assume "big" if endianness cannot be determined])
+AC_ARG_ENABLE(ffipoll, [  --enable-ffipoll        only make FFI calls if embedding program explicitly polls])
 
 # AC_ARG_ENABLE(oskit,   [  --enable-oskit          compile OSKit-based Racket kernel])
 # AC_ARG_ENABLE(smalloskit, [  --enable-smalloskit     compile small OSKit-based Racket kernel])
@@ -328,6 +329,7 @@ show_explicitly_enabled "${enable_extflonum}" "Extflonums"
 show_explicitly_disabled "${enable_extflonum}" "Extflonums"
 
 show_explicitly_enabled "${enable_pthread}" "pthreads"
+show_explicitly_enabled "${enable_ffipoll}" "ffipoll"
 show_explicitly_enabled "${enable_oskit}" "OSKit"
 show_explicitly_enabled "${enable_smalloskit}" "OSKit small mode"
 
@@ -1427,6 +1429,12 @@ if test "${enable_futures}" = "yes" ; then
   enable_mzrt=yes
 fi
 
+############### ffipoll ###################
+
+if test "${enable_ffipoll}" = "yes" ; then
+  AC_DEFINE(MZ_USE_FFIPOLL,1,[FFIPoll enabled])
+fi
+
 ############## compare-and-swap ################
 
 if test "${enable_mzrt}" = "yes" ; then

racket/src/racket/mzconfig.h.in

@@ -82,6 +82,9 @@ typedef unsigned long uintptr_t;
 #undef MZ_USE_PLACES
 #endif
 
+/* Enable FFI polling: */
+#undef MZ_USE_FFIPOLL
+
 /* Whether __sync_bool_compare_and_swap() works: */
 #undef MZ_CAS_AVAILABLE
 

racket/src/racket/src/thread.c

@@ -5010,7 +5010,7 @@ void scheme_thread_block(float sleep_time)
   if (!do_atomic)
     scheme_check_future_work();
 #endif
-#if defined(MZ_USE_MZRT) && !defined(DONT_USE_FOREIGN)
+#if defined(MZ_USE_MZRT) && !defined(DONT_USE_FOREIGN) && !defined(MZ_USE_FFIPOLL)
   if (!do_atomic)
     scheme_check_foreign_work();
 #endif