Patch taken from:
  https://github.com/mshinwell/ocaml/commits/4.02-block-bounds

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 01eff9c..b498b58 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -22,6 +22,13 @@ open Clambda
 open Cmm
 open Cmx_format
 
+let do_check_field_access = true
+(*
+  match try Some (Sys.getenv "BOUNDS") with Not_found -> None with
+  | None | Some "" -> false
+  | Some _ -> true
+*)
+
 (* Local binding of complex expressions *)
 
 let bind name arg fn =
@@ -494,6 +501,35 @@ let get_tag ptr =
 let get_size ptr =
   Cop(Clsr, [header ptr; Cconst_int 10])
 
+(* Bounds checks upon field access, for debugging the compiler *)
+
+let check_field_access ptr field_index if_success =
+  if not do_check_field_access then
+    if_success
+  else
+    let field_index = Cconst_int field_index in
+    (* If [ptr] points at an infix header, we need to move it back to the "main"
+       [Closure_tag] header. *)
+    let ptr =
+      Cifthenelse (Cop (Ccmpi Cne, [get_tag ptr; Cconst_int Obj.infix_tag]),
+        ptr,
+        Cop (Csuba, [ptr;
+          Cop (Cmuli, [get_size ptr (* == Infix_offset_val(ptr) *);
+            Cconst_int size_addr])]))
+    in
+    let not_too_small = Cop (Ccmpi Cge, [field_index; Cconst_int 0]) in
+    let not_too_big = Cop (Ccmpi Clt, [field_index; get_size ptr]) in
+    let failure =
+      Cop (Cextcall ("caml_field_access_out_of_bounds_error", typ_addr, false,
+             Debuginfo.none),
+        [ptr; field_index])
+    in
+    Cifthenelse (not_too_small,
+      Cifthenelse (not_too_big,
+        if_success,
+        failure),
+      failure)
+
 (* Array indexing *)
 
 let log2_size_addr = Misc.log2 size_addr
@@ -1550,13 +1586,18 @@ and transl_prim_1 p arg dbg =
       return_unit(remove_unit (transl arg))
   (* Heap operations *)
   | Pfield n ->
-      get_field (transl arg) n
+      let ptr = transl arg in
+      let body = get_field ptr n in
+      check_field_access ptr n body
   | Pfloatfield n ->
       let ptr = transl arg in
-      box_float(
-        Cop(Cload Double_u,
-            [if n = 0 then ptr
-                       else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+      let body =
+        box_float(
+          Cop(Cload Double_u,
+              [if n = 0 then ptr
+                         else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+      in
+      check_field_access ptr n body
   | Pint_as_pointer ->
      Cop(Cadda, [transl arg; Cconst_int (-1)])
   (* Exceptions *)
@@ -1649,20 +1690,25 @@ and transl_prim_1 p arg dbg =
 and transl_prim_2 p arg1 arg2 dbg =
   match p with
   (* Heap operations *)
-    Psetfield(n, ptr) ->
-      if ptr then
-        return_unit(Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none),
-                        [field_address (transl arg1) n; transl arg2]))
-      else
-        return_unit(set_field (transl arg1) n (transl arg2))
+    Psetfield(n, is_ptr) ->
+      let ptr = transl arg1 in
+      let body =
+        if is_ptr then
+          Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none),
+            [field_address ptr n; transl arg2])
+        else
+          set_field ptr n (transl arg2)
+      in
+      check_field_access ptr n (return_unit body)
   | Psetfloatfield n ->
       let ptr = transl arg1 in
-      return_unit(
+      let body =
         Cop(Cstore Double_u,
             [if n = 0 then ptr
                        else Cop(Cadda, [ptr; Cconst_int(n * size_float)]);
-                   transl_unbox_float arg2]))
-
+                   transl_unbox_float arg2])
+      in
+      check_field_access ptr n (return_unit body)
   (* Boolean operations *)
   | Psequand ->
       Cifthenelse(test_bool(transl arg1), transl arg2, Cconst_int 1)
diff --git a/asmrun/fail.c b/asmrun/fail.c
index cb2c1cb..4f67c74 100644
--- a/asmrun/fail.c
+++ b/asmrun/fail.c
@@ -15,6 +15,7 @@
 
 #include <stdio.h>
 #include <signal.h>
+#include <assert.h>
 #include "alloc.h"
 #include "fail.h"
 #include "io.h"
@@ -180,3 +181,20 @@ int caml_is_special_exception(value exn) {
     || exn == (value) caml_exn_Assert_failure
     || exn == (value) caml_exn_Undefined_recursive_module;
 }
+
+void caml_field_access_out_of_bounds_error(value v_block, intnat index)
+{
+  assert(Is_block(v_block));
+  fprintf(stderr, "Fatal error: out-of-bounds access to field %ld ", index);
+  fprintf(stderr, "of block at %p (%s, size %ld, tag %d)\n",
+    (void*) v_block,
+    Is_young(v_block) ? "in minor heap"
+      : Is_in_heap(v_block) ? "in major heap"
+      : Is_in_value_area(v_block) ? "in static data"
+      : "out-of-heap",
+    (long) Wosize_val(v_block), (int) Tag_val(v_block));
+  fflush(stderr);
+  /* This error may have occurred in places where it is not reasonable to
+     attempt to continue. */
+  abort();
+}