Leave blocking section on callback while polling (#142)

Fixes #141

See also verifast/verifast#252

src/ml_glib.c

@@ -300,11 +300,15 @@ ML_1 (g_source_remove, Int_val, Unit)
 
 static GPollFunc poll_func = NULL;
 
+int polling = 0;
+
 static gint ml_poll (GPollFD *ufds, guint nfsd, gint timeout)
 {
     gint res;
     caml_enter_blocking_section();
+    polling = 1;
     res = poll_func(ufds, nfsd, timeout);
+    polling = 0;
     caml_leave_blocking_section();
     return res;
 }

src/ml_glib.h

@@ -37,3 +37,5 @@ CAMLexport GSList *GSList_val (value list, value_out);
 
 CAMLexport void ml_register_exn_map (GQuark domain, char *caml_name);
 CAMLexport void ml_raise_gerror(GError *) Noreturn;
+
+extern int polling;

src/ml_gobject.c

@@ -29,6 +29,7 @@
 #include <caml/memory.h>
 #include <caml/callback.h>
 #include <caml/fail.h>
+#include <caml/threads.h>
 
 #include "wrappers.h"
 #include "ml_glib.h"
@@ -178,7 +179,7 @@ static void notify_destroy(gpointer unit, GClosure *c)
     remove_global_root((value*)&c->data);
 }
 
-static void marshal (GClosure *closure, GValue *ret,
+static void marshal_core (GClosure *closure, GValue *ret,
                      guint nargs, const GValue *args,
                      gpointer hint, gpointer marshall_data)
 {
@@ -194,6 +195,20 @@ static void marshal (GClosure *closure, GValue *ret,
     CAMLreturn0;
 }
 
+static void marshal (GClosure *closure, GValue *ret,
+                     guint nargs, const GValue *args,
+                     gpointer hint, gpointer marshall_data)
+{
+    if (polling) { // https://github.com/garrigue/lablgtk/issues/141
+      caml_leave_blocking_section();
+      polling = 0;
+      marshal_core(closure, ret, nargs, args, hint, marshall_data);
+      polling = 1;
+      caml_enter_blocking_section();
+    } else
+      marshal_core(closure, ret, nargs, args, hint, marshall_data);
+}
+
 CAMLprim value ml_g_closure_new (value clos)
 {
     GClosure* closure = g_closure_new_simple(sizeof(GClosure), (gpointer)clos);