PR#4832: Filling bigarrays may block out runtimeflambda_fork_point

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15947 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 51 insertions, 14 deletions

diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c
index 463865525c..225d6c52ee 100644
--- a/otherlibs/bigarray/bigarray_stubs.c
+++ b/otherlibs/bigarray/bigarray_stubs.c
@@ -22,6 +22,7 @@
 #include "caml/hash.h"
 #include "caml/memory.h"
 #include "caml/mlvalues.h"
+#include "caml/signals.h"
 
 #define int8 caml_ba_int8
 #define uint8 caml_ba_uint8
@@ -1120,12 +1121,23 @@ CAMLprim value caml_ba_sub(value vb, value vofs, value vlen)
 
 /* Copying a big array into another one */
 
+static inline int is_mmapped(struct caml_ba_array *ba)
+{
+  return (ba->flags & CAML_BA_MAPPED_FILE);
+}
+
+#define LEAVE_RUNTIME_OP_CUTOFF 4096
+
 CAMLprim value caml_ba_blit(value vsrc, value vdst)
 {
+  CAMLparam2(vsrc, vdst);
   struct caml_ba_array * src = Caml_ba_array_val(vsrc);
   struct caml_ba_array * dst = Caml_ba_array_val(vdst);
+  void *src_data = src->data;
+  void *dst_data = dst->data;
   int i;
   intnat num_bytes;
+  int leave_runtime;
 
   /* Check same numbers of dimensions and same dimensions */
   if (src->num_dims != dst->num_dims) goto blit_error;
@@ -1135,19 +1147,44 @@ CAMLprim value caml_ba_blit(value vsrc, value vdst)
   num_bytes =
     caml_ba_num_elts(src)
     * caml_ba_element_size[src->flags & CAML_BA_KIND_MASK];
+  leave_runtime =
+    (
+      (num_bytes >= LEAVE_RUNTIME_OP_CUTOFF*sizeof(long))
+      || is_mmapped(src)
+      || is_mmapped(dst)
+    );
   /* Do the copying */
-  memmove (dst->data, src->data, num_bytes);
-  return Val_unit;
+  if (leave_runtime) caml_enter_blocking_section();
+  memmove (dst_data, src_data, num_bytes);
+  if (leave_runtime) caml_leave_blocking_section();
+  CAMLreturn (Val_unit);
  blit_error:
   caml_invalid_argument("Bigarray.blit: dimension mismatch");
-  return Val_unit;              /* not reached */
+  CAMLreturn (Val_unit);              /* not reached */
 }
 
 /* Filling a big array with a given value */
 
+#define FILL_GEN_LOOP(n_ops, loop) do{                                       \
+  int leave_runtime = ((n_ops >= LEAVE_RUNTIME_OP_CUTOFF) || is_mmapped(b)); \
+  if (leave_runtime) caml_enter_blocking_section();                          \
+  loop;                                                                      \
+  if (leave_runtime) caml_leave_blocking_section();                          \
+}while(0)
+
+#define FILL_SCALAR_LOOP                                        \
+  FILL_GEN_LOOP(num_elts,                                       \
+    for (p = data; num_elts > 0; p++, num_elts--) *p = init)
+
+#define FILL_COMPLEX_LOOP                                                    \
+  FILL_GEN_LOOP(num_elts + num_elts,                                         \
+    for (p = data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; })
+
 CAMLprim value caml_ba_fill(value vb, value vinit)
 {
+  CAMLparam1(vb);
   struct caml_ba_array * b = Caml_ba_array_val(vb);
+  void *data = b->data;
   intnat num_elts = caml_ba_num_elts(b);
 
   switch (b->flags & CAML_BA_KIND_MASK) {
@@ -1156,13 +1193,13 @@ CAMLprim value caml_ba_fill(value vb, value vinit)
   case CAML_BA_FLOAT32: {
     float init = Double_val(vinit);
     float * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_FLOAT64: {
     double init = Double_val(vinit);
     double * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_CHAR:
@@ -1170,56 +1207,56 @@ CAMLprim value caml_ba_fill(value vb, value vinit)
   case CAML_BA_UINT8: {
     int init = Int_val(vinit);
     unsigned char * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_SINT16:
   case CAML_BA_UINT16: {
     int init = Int_val(vinit);
     int16 * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_INT32: {
     int32_t init = Int32_val(vinit);
     int32_t * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_INT64: {
     int64_t init = Int64_val(vinit);
     int64_t * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_NATIVE_INT: {
     intnat init = Nativeint_val(vinit);
     intnat * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_CAML_INT: {
     intnat init = Long_val(vinit);
     intnat * p;
-    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
+    FILL_SCALAR_LOOP;
     break;
   }
   case CAML_BA_COMPLEX32: {
     float init0 = Double_field(vinit, 0);
     float init1 = Double_field(vinit, 1);
     float * p;
-    for (p = b->data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; }
+    FILL_COMPLEX_LOOP;
     break;
   }
   case CAML_BA_COMPLEX64: {
     double init0 = Double_field(vinit, 0);
     double init1 = Double_field(vinit, 1);
     double * p;
-    for (p = b->data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; }
+    FILL_COMPLEX_LOOP;
     break;
   }
   }
-  return Val_unit;
+  CAMLreturn (Val_unit);
 }
 
 /* Reshape an array: change dimensions and number of dimensions, preserving