Invalid reads from complex bigarrays (#1755)

The following function can raise an Assert_failure in trunk:

let bug_example () =
  let open Bigarray in
  let work = Array1.create complex64 c_layout 1 in
  work.{0} <- { Complex. re=0.; im=0. };
  let result = work.{0}.Complex.re in (* alloc *)
  assert (result = 0.)

because the Complex.t value (corresponding to work.{0} on
line "alloc" ) is allocated after the address inside the bigarray
has been computed but before the reads actually occur.
The allocation can trigger a collection that then deallocates the
bigarray.

This commit moves the allocation of the Complex.t value so that
it occurs after the reads from the bigarray. Our understanding
is that only complex reads can allocate: non-complex reads do
not allocate, and writes never allocate.

It also changes the Cmm type for bigarray addressing from Int to Addr, marking the fact
that the returned pointer is a derived pointer that may not survive a GC.

Changes

@@ -490,6 +490,10 @@ OCaml 4.07
 - GPR#1722: Scrape types in Typeopt.maybe_pointer
   (Leo White, review by Thomas Refis)
 
+- GPR#1755: ensure that a bigarray is never collected while reading complex
+  values (Xavier Clerc, Mark Shinwell and Leo White, report by Chris Hardin,
+  reviews by Stephen Dolan and Xavier Leroy)
+
 OCaml 4.06.1 (16 Feb 2018):
 ---------------------------
 

asmcomp/cmmgen.ml

@@ -1078,7 +1078,7 @@ let bigarray_indexing unsafe elt_kind layout b args dbg =
   and elt_size =
     bigarray_elt_size elt_kind in
   (* [array_indexing] can simplify the given expressions *)
-  array_indexing ~typ:Int (log2 elt_size)
+  array_indexing ~typ:Addr (log2 elt_size)
                  (Cop(Cload (Word_int, Mutable),
                     [field_address b 1 dbg], dbg)) offset dbg
 
@@ -1103,12 +1103,13 @@ let bigarray_get unsafe elt_kind layout b args dbg =
       Pbigarray_complex32 | Pbigarray_complex64 ->
         let kind = bigarray_word_kind elt_kind in
         let sz = bigarray_elt_size elt_kind / 2 in
-        bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
-          (fun addr ->
-          box_complex dbg
-            (Cop(Cload (kind, Mutable), [addr], dbg))
-            (Cop(Cload (kind, Mutable),
-              [Cop(Cadda, [addr; Cconst_int sz], dbg)], dbg)))
+        bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
+          bind "reval"
+            (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval ->
+              bind "imval"
+                (Cop(Cload (kind, Mutable),
+                     [Cop(Cadda, [addr; Cconst_int sz], dbg)], dbg)) (fun imval ->
+          box_complex dbg reval imval)))
     | _ ->
         Cop(Cload (bigarray_word_kind elt_kind, Mutable),
             [bigarray_indexing unsafe elt_kind layout b args dbg],