More precise typing at the C-- and Mach level:

- Register type "Addr" is split into
    . "Val" (well-formed OCaml values, appropriate as GC roots)
    . "Addr" (derived pointers within the heap, must not survive a GC)
- memory_chunk "Word" is split into
    . "Word_val" (OCaml value)
    . "Word_int" (native-sized integer, not a pointer into the heap)

Cmmgen was updated to use Word_val or Word_int as appropriate.

Application #1: fail at compile-time if a derived pointer within the heap
survives a GC point (cf. PR#6484).

Application #2: CSE can do a better job across allocation points
(keep factoring expressions of type Int, Val, Float, but not Addr).


git-svn-id: http://caml.inria.fr/svn/ocaml/branches/cmm-mach-types@15568 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

22 files changed, 244 insertions, 166 deletions

diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml
index 6571ad53fe..7d398fff2f 100644
--- a/asmcomp/CSEgen.ml
+++ b/asmcomp/CSEgen.ml
@@ -153,6 +153,12 @@ let set_unknown_regs n rs =
 let filter_equations pred n =
   { n with num_eqs = Equations.filter (fun (op,_) res -> pred op) n.num_eqs }
 
+(* Forget everything we know about registers of type [Addr]. *)
+
+let kill_addr_regs n =
+  { n with num_reg =
+              Reg.Map.filter (fun r n -> r.Reg.typ <> Cmm.Addr) n.num_reg }
+
 (* Prepend a set of moves before [i] to assign [srcs] to [dsts].  *)
 
 let insert_single_move i src dst = instr_cons (Iop Imove) [|src|] [|dst|] i
@@ -231,7 +237,8 @@ method private cse n i =
          - equations involving memory loads, since the callee can
            perform arbitrary memory stores;
          - equations involving arithmetic operations that can
-           produce bad pointers into the heap (see below for Ialloc);
+           produce [Addr]-typed derived pointers into the heap
+           (see below for Ialloc);
          - mappings from hardware registers to value numbers,
            since the callee does not preserve these registers.
          That doesn't leave much usable information: checkbounds
@@ -241,13 +248,14 @@ method private cse n i =
       {i with next = self#cse empty_numbering i.next}
   | Iop (Ialloc _) ->
       (* For allocations, we must avoid extending the live range of a
-         pseudoregister across the allocation if this pseudoreg can
-         contain a value that looks like a pointer into the heap but
-         is not a pointer to the beginning of a Caml object.  PR#6484
-         is an example of such a value (a derived pointer into a
-         block).  In the absence of more precise typing information,
-         we just forget everything. *)
-       {i with next = self#cse empty_numbering i.next}
+         pseudoregister across the allocation if this pseudoreg
+         is a derived heap pointer (a pointer into the heap that does
+         not point to the beginning of a Caml block).  PR#6484 is an
+         example of this situation.  Such pseudoregs have type [Addr].
+         Pseudoregs with types other than [Addr] can be kept. *)
+       let n1 = kill_addr_regs n in
+       let n2 = set_unknown_regs n1 i.res in
+       {i with next = self#cse n2 i.next}
   | Iop op ->
       begin match self#class_of_operation op with
       | Op_pure | Op_checkbound | Op_load ->
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index b576ece983..94855f96d9 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -165,10 +165,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+      | {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -430,7 +432,7 @@ let emit_instr fallthrough i =
     | Lop(Iload(chunk, addr)) ->
         let dest = i.res.(0) in
         begin match chunk with
-          | Word ->
+          | Word_int | Word_val ->
               `	movq	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
           | Byte_unsigned ->
               `	movzbq	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
@@ -451,7 +453,7 @@ let emit_instr fallthrough i =
         end
     | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
-          | Word ->
+          | Word_int | Word_val ->
             `	movq	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
           | Byte_unsigned | Byte_signed ->
             `	movb	{emit_reg8 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index f14e69cd38..f31ea14e28 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -161,10 +161,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+      | {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -423,7 +425,7 @@ let emit_instr fallthrough i =
     | Lop(Iload(chunk, addr)) ->
         let dest = i.res.(0) in
         begin match chunk with
-          | Word ->
+          | Word_int | Word_val ->
               `	mov	{emit_reg dest}, QWORD PTR {emit_addressing addr i.arg 0}\n`
           | Byte_unsigned ->
               `	movzx	{emit_reg dest}, BYTE PTR {emit_addressing addr i.arg 0}\n`
@@ -445,7 +447,7 @@ let emit_instr fallthrough i =
         end
     | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
-          | Word ->
+          | Word_int | Word_val ->
             `	mov	QWORD PTR {emit_addressing addr i.arg 1}, {emit_reg i.arg.(0)}\n`
           | Byte_unsigned | Byte_signed ->
             `	mov	BYTE PTR {emit_addressing addr i.arg 1}, {emit_reg8 i.arg.(0)}\n`
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 298e92900d..bcc7fcb5ef 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -99,8 +99,7 @@ let num_register_classes = 2
 
 let register_class r =
   match r.typ with
-    Int -> 0
-  | Addr -> 0
+  | Val | Int | Addr -> 0
   | Float -> 1
 
 let num_available_registers = [| 13; 16 |]
@@ -155,7 +154,7 @@ let calling_conventions first_int last_int first_float last_float make_stack
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i).typ with
-      Int | Addr as ty ->
+    | Val | Int | Addr as ty ->
         if !int <= last_int then begin
           loc.(i) <- phys_reg !int;
           incr int
@@ -215,7 +214,7 @@ let win64_loc_external_arguments arg =
   and ofs = ref 32 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i).typ with
-      Int | Addr as ty ->
+    | Val | Int | Addr as ty ->
         if !reg < 4 then begin
           loc.(i) <- phys_reg win64_int_external_arguments.(!reg);
           incr reg
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index fa7fe66c05..4556ac668b 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -30,11 +30,11 @@ let rec select_addr exp =
   match exp with
     Cconst_symbol s when not !Clflags.dlcode ->
       (Asymbol s, 0)
-  | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
+  | Cop((Caddi | Caddv | Cadda), [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n + m)
-  | Cop((Csubi | Csuba), [arg; Cconst_int m]) ->
+  | Cop(Csubi, [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n - m)
-  | Cop((Caddi | Cadda), [Cconst_int m; arg]) ->
+  | Cop((Caddi | Caddv | Cadda), [Cconst_int m; arg]) ->
       let (a, n) = select_addr arg in (a, n + m)
   | Cop(Clsl, [arg; Cconst_int(1|2|3 as shift)]) ->
       begin match select_addr arg with
@@ -51,7 +51,7 @@ let rec select_addr exp =
         (Alinear e, n) -> (Ascale(e, mult), n * mult)
       | _ -> (Alinear exp, 0)
       end
-  | Cop((Caddi | Cadda), [arg1; arg2]) ->
+  | Cop((Caddi | Caddv | Cadda), [arg1; arg2]) ->
       begin match (select_addr arg1, select_addr arg2) with
           ((Alinear e1, n1), (Alinear e2, n2)) ->
               (Aadd(e1, e2), n1 + n2)
@@ -170,8 +170,8 @@ method! select_store is_assign addr exp =
 method! select_operation op args =
   match op with
   (* Recognize the LEA instruction *)
-    Caddi | Cadda | Csubi | Csuba ->
-      begin match self#select_addressing Word (Cop(op, args)) with
+    Caddi | Caddv | Cadda | Csubi ->
+      begin match self#select_addressing Word_int (Cop(op, args)) with
         (Iindexed d, _) -> super#select_operation op args
       | (Iindexed2 0, _) -> super#select_operation op args
       | (addr, arg) -> (Ispecific(Ilea addr), [arg])
@@ -196,11 +196,11 @@ method! select_operation op args =
          assert false
      end
   (* Recognize store instructions *)
-  | Cstore Word ->
+  | Cstore (Word_int|Word_val as chunk) ->
       begin match args with
         [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])]
         when loc = loc' && self#is_immediate n ->
-          let (addr, arg) = self#select_addressing Word loc in
+          let (addr, arg) = self#select_addressing chunk loc in
           (Ispecific(Ioffset_loc(n, addr)), [arg])
       | _ ->
           super#select_operation op args
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index 61035b85fd..070397bf04 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -103,10 +103,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+      | {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
index 4725942b72..1332589ffc 100644
--- a/asmcomp/arm/selection.ml
+++ b/asmcomp/arm/selection.ml
@@ -27,7 +27,7 @@ let is_offset chunk n =
   (* ARM load/store byte/word have -4095 to 4095 *)
   | Byte_unsigned | Byte_signed
   | Thirtytwo_unsigned | Thirtytwo_signed
-  | Word | Single
+  | Word_int | Word_val | Single
     when not !thumb ->
       n >= -4095 && n <= 4095
   (* Thumb-2 load/store have -255 to 4095 *)
@@ -231,12 +231,12 @@ method private select_operation_softfp op args =
        [Cop(Cextcall(func, typ_int, false, Debuginfo.none), args)])
   (* Add coercions around loads and stores of 32-bit floats *)
   | (Cload Single, args) ->
-      (Iextcall("__aeabi_f2d", false), [Cop(Cload Word, args)])
+      (Iextcall("__aeabi_f2d", false), [Cop(Cload Word_int, args)])
   | (Cstore Single, [arg1; arg2]) ->
       let arg2' =
         Cop(Cextcall("__aeabi_d2f", typ_int, false, Debuginfo.none),
             [arg2]) in
-      self#select_operation (Cstore Word) [arg1; arg2']
+      self#select_operation (Cstore Word_int) [arg1; arg2']
   (* Other operations are regular *)
   | (op, args) -> super#select_operation op args
 
diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index 734bd23e15..df82f29919 100644
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -123,10 +123,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+      | {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -385,7 +387,7 @@ let emit_instr i =
         | Single ->
             `	ldr	s7, {emit_addressing addr base}\n`;
             `	fcvt	{emit_reg dst}, s7\n`
-        | Word | Double | Double_u ->
+        | Word_int | Word_val | Double | Double_u ->
             `	ldr	{emit_reg dst}, {emit_addressing addr base}\n`
         end
     | Lop(Istore(size, addr, _)) ->
@@ -406,7 +408,7 @@ let emit_instr i =
         | Single ->
             `	fcvt	s7, {emit_reg src}\n`;
             `	str	s7, {emit_addressing addr base}\n`;
-        | Word | Double | Double_u ->
+        | Word_int | Word_val | Double | Double_u ->
             `	str	{emit_reg src}, {emit_addressing addr base}\n`
         end
     | Lop(Ialloc n) ->
diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml
index e7ded8fb43..491337ab6f 100644
--- a/asmcomp/arm64/selection.ml
+++ b/asmcomp/arm64/selection.ml
@@ -28,7 +28,7 @@ let is_offset chunk n =
         n land 1 = 0 && n lsr 1 < 0x1000
     | Thirtytwo_unsigned | Thirtytwo_signed | Single ->
         n land 3 = 0 && n lsr 2 < 0x1000
-    | Word | Double | Double_u ->
+    | Word_int | Word_val | Double | Double_u ->
         n land 7 = 0 && n lsr 3 < 0x1000)
 
 (* An automaton to recognize ( 0+1+0* | 1+0+1* )
diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
index 67ee3445fd..52cd1e5db4 100644
--- a/asmcomp/cmm.ml
+++ b/asmcomp/cmm.ml
@@ -11,19 +11,21 @@
 (***********************************************************************)
 
 type machtype_component =
-    Addr
+  | Val
+  | Addr
   | Int
   | Float
 
 type machtype = machtype_component array
 
 let typ_void = ([||] : machtype_component array)
+let typ_val = [|Val|]
 let typ_addr = [|Addr|]
 let typ_int = [|Int|]
 let typ_float = [|Float|]
 
 let size_component = function
-    Addr -> Arch.size_addr
+  | Val | Addr -> Arch.size_addr
   | Int -> Arch.size_int
   | Float -> Arch.size_float
 
@@ -59,7 +61,8 @@ type memory_chunk =
   | Sixteen_signed
   | Thirtytwo_unsigned
   | Thirtytwo_signed
-  | Word
+  | Word_int
+  | Word_val
   | Single
   | Double
   | Double_u
@@ -73,7 +76,7 @@ type operation =
   | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi of comparison
-  | Cadda | Csuba
+  | Caddv | Cadda
   | Ccmpa of comparison
   | Cnegf | Cabsf
   | Caddf | Csubf | Cmulf | Cdivf
diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
index 97b8d40971..121620eb01 100644
--- a/asmcomp/cmm.mli
+++ b/asmcomp/cmm.mli
@@ -13,13 +13,41 @@
 (* Second intermediate language (machine independent) *)
 
 type machtype_component =
-    Addr
+  | Val
+  | Addr
   | Int
   | Float
 
+(* - [Val] denotes a valid OCaml value: either a pointer to the beginning
+     of a heap block, an infix pointer if it is preceded by the correct
+     infix header, or a 2n+1 encoded integer.
+   - [Int] is for integers (not necessarily 2n+1 encoded) and for
+     pointers outside the heap.
+   - [Addr] denotes pointers that are neither [Val] nor [Int], i.e.
+     pointers into the heap that point in the middle of a heap block.
+     Such derived pointers are produced by e.g. array indexing.
+   - [Float] is for unboxed floating-point numbers.
+
+The purpose of these types is twofold.  First, they guide register
+allocation: type [Float] goes in FP registers, the other types go
+into integer registers.  Second, they determine how local variables are 
+tracked by the GC:
+   - Variables of type [Val] are GC roots.  If they are pointers, the
+     GC will not deallocate the addressed heap block, and will update
+     the local variable if the heap block moves.
+   - Variables of type [Int] and [Float] are ignored by the GC.
+     The GC does not change their values.
+   - Variables of type [Addr] must never be live across an allocation
+     point or function call.  They cannot be given as roots to the GC
+     because they don't point after a well-formed block header of the
+     kind that the GC needs.  However, the GC may move the block pointed
+     into, invalidating the value of the [Addr] variable.
+*)
+
 type machtype = machtype_component array
 
 val typ_void: machtype
+val typ_val: machtype
 val typ_addr: machtype
 val typ_int: machtype
 val typ_float: machtype
@@ -45,10 +73,11 @@ type memory_chunk =
   | Sixteen_signed
   | Thirtytwo_unsigned
   | Thirtytwo_signed
-  | Word
+  | Word_int                           (* integer or pointer outside heap *)
+  | Word_val                           (* pointer inside heap or encoded int *)
   | Single
-  | Double                              (* 64-bit-aligned 64-bit float *)
-  | Double_u                            (* word-aligned 64-bit float *)
+  | Double                             (* 64-bit-aligned 64-bit float *)
+  | Double_u                           (* word-aligned 64-bit float *)
 
 type operation =
     Capply of machtype * Debuginfo.t
@@ -59,7 +88,8 @@ type operation =
   | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi of comparison
-  | Cadda | Csuba
+  | Caddv (* pointer addition that produces a [Val] (well-formed Caml value) *)
+  | Cadda (* pointer addition that produces a [Addr] (derived heap pointer) *)
   | Ccmpa of comparison
   | Cnegf | Cabsf
   | Caddf | Csubf | Cmulf | Cdivf
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 17dcb8220f..0d904491e8 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -472,14 +472,15 @@ let field_address ptr n =
   then ptr
   else Cop(Cadda, [ptr; Cconst_int(n * size_addr)])
 
+
 let get_field ptr n =
-  Cop(Cload Word, [field_address ptr n])
+  Cop(Cload Word_val, [field_address ptr n])
 
 let set_field ptr n newval =
-  Cop(Cstore Word, [field_address ptr n; newval])
+  Cop(Cstore Word_val, [field_address ptr n; newval])
 
 let header ptr =
-  Cop(Cload Word, [Cop(Cadda, [ptr; Cconst_int(-size_int)])])
+  Cop(Cload Word_int, [Cop(Cadda, [ptr; Cconst_int(-size_int)])])
 
 let tag_offset =
   if big_endian then -1 else -size_int
@@ -529,7 +530,9 @@ let array_indexing log2size ptr ofs =
                    Cconst_int((-1) lsl (log2size - 1))])
 
 let addr_array_ref arr ofs =
-  Cop(Cload Word, [array_indexing log2_size_addr arr ofs])
+  Cop(Cload Word_val, [array_indexing log2_size_addr arr ofs])
+let int_array_ref arr ofs =
+  Cop(Cload Word_int, [array_indexing log2_size_addr arr ofs])
 let unboxed_float_array_ref arr ofs =
   Cop(Cload Double_u, [array_indexing log2_size_float arr ofs])
 let float_array_ref arr ofs =
@@ -539,7 +542,7 @@ let addr_array_set arr ofs newval =
   Cop(Cextcall("caml_modify", typ_void, false, Debuginfo.none),
       [array_indexing log2_size_addr arr ofs; newval])
 let int_array_set arr ofs newval =
-  Cop(Cstore Word, [array_indexing log2_size_addr arr ofs; newval])
+  Cop(Cstore Word_int, [array_indexing log2_size_addr arr ofs; newval])
 let float_array_set arr ofs newval =
   Cop(Cstore Double_u, [array_indexing log2_size_float arr ofs; newval])
 
@@ -565,19 +568,19 @@ let string_length exp =
 
 let lookup_tag obj tag =
   bind "tag" tag (fun tag ->
-    Cop(Cextcall("caml_get_public_method", typ_addr, false, Debuginfo.none),
+    Cop(Cextcall("caml_get_public_method", typ_val, false, Debuginfo.none),
         [obj; tag]))
 
 let lookup_label obj lab =
   bind "lab" lab (fun lab ->
-    let table = Cop (Cload Word, [obj]) in
+    let table = Cop (Cload Word_val, [obj]) in
     addr_array_ref table lab)
 
 let call_cached_method obj tag cache pos args dbg =
   let arity = List.length args in
   let cache = array_indexing log2_size_addr cache pos in
   Compilenv.need_send_fun arity;
-  Cop(Capply (typ_addr, dbg),
+  Cop(Capply (typ_val, dbg),
       Cconst_symbol("caml_send" ^ string_of_int arity) ::
       obj :: tag :: cache :: args)
 
@@ -593,7 +596,7 @@ let make_alloc_generic set_fn tag wordsize args =
     | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int idx) e1,
                           fill_fields (idx + 2) el) in
     Clet(id,
-         Cop(Cextcall("caml_alloc", typ_addr, true, Debuginfo.none),
+         Cop(Cextcall("caml_alloc", typ_val, true, Debuginfo.none),
                  [Cconst_int wordsize; Cconst_int tag]),
          fill_fields 1 args)
   end
@@ -748,7 +751,7 @@ let rec unbox_int bi arg =
   | Ccatch(n, ids, e1, e2) -> Ccatch(n, ids, unbox_int bi e1, unbox_int bi e2)
   | Ctrywith(e1, id, e2) -> Ctrywith(unbox_int bi e1, id, unbox_int bi e2)
   | _ ->
-      Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word),
+      Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word_int),
           [Cop(Cadda, [arg; Cconst_int size_addr])])
 
 let make_unsigned_int bi arg =
@@ -781,12 +784,13 @@ let bigarray_indexing unsafe elt_kind layout b args dbg =
   | [arg] ->
       bind "idx" (untag_int arg)
         (fun idx ->
-           check_bound (Cop(Cload Word,[field_address b dim_ofs])) idx idx)
+           check_bound (Cop(Cload Word_int,[field_address b dim_ofs]))
+                       idx idx)
   | arg1 :: argl ->
       let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in
       bind "idx" (untag_int arg1)
         (fun idx ->
-          bind "bound" (Cop(Cload Word, [field_address b dim_ofs]))
+          bind "bound" (Cop(Cload Word_int, [field_address b dim_ofs]))
           (fun bound ->
             check_bound bound idx (add_int (mul_int rem bound) idx))) in
   let offset =
@@ -803,7 +807,8 @@ let bigarray_indexing unsafe elt_kind layout b args dbg =
     if elt_size = 1
     then offset
     else Cop(Clsl, [offset; Cconst_int(log2 elt_size)]) in
-  Cop(Cadda, [Cop(Cload Word, [field_address b 1]); byte_offset])
+  Cop(Caddi, [Cop(Cload Word_int, [field_address b 1]); byte_offset])
+  (* this produces a pointer outside the heap, hence Caddi instead of Cadda *)
 
 let bigarray_word_kind = function
     Pbigarray_unknown -> assert false
@@ -814,9 +819,9 @@ let bigarray_word_kind = function
   | Pbigarray_sint16 -> Sixteen_signed
   | Pbigarray_uint16 -> Sixteen_unsigned
   | Pbigarray_int32 -> Thirtytwo_signed
-  | Pbigarray_int64 -> Word
-  | Pbigarray_caml_int -> Word
-  | Pbigarray_native_int -> Word
+  | Pbigarray_int64 -> Word_int
+  | Pbigarray_caml_int -> Word_int
+  | Pbigarray_native_int -> Word_int
   | Pbigarray_complex32 -> Single
   | Pbigarray_complex64 -> Double
 
@@ -922,7 +927,7 @@ let unaligned_set_32 ptr idx newval =
 let unaligned_load_64 ptr idx =
   assert(size_int = 8);
   if Arch.allow_unaligned_access
-  then Cop(Cload Word, [add_int ptr idx])
+  then Cop(Cload Word_int, [add_int ptr idx])
   else
     let v1 = Cop(Cload Byte_unsigned, [add_int ptr idx]) in
     let v2 = Cop(Cload Byte_unsigned,
@@ -958,7 +963,7 @@ let unaligned_load_64 ptr idx =
 let unaligned_set_64 ptr idx newval =
   assert(size_int = 8);
   if Arch.allow_unaligned_access
-  then Cop(Cstore Word, [add_int ptr idx; newval])
+  then Cop(Cstore Word_int, [add_int ptr idx; newval])
   else
     let v1 =
       Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*7)]); Cconst_int 0xFF]) in
@@ -1324,26 +1329,30 @@ let rec transl = function
               transl_fundecls (pos + 4) rem in
       Cop(Calloc, transl_fundecls 0 fundecls)
   | Uoffset(arg, offset) ->
-      field_address (transl arg) offset
+      (* produces a valid Caml value, pointing just after an infix header *)
+      let ptr = transl arg in
+      if offset = 0
+      then ptr
+      else Cop(Caddv, [ptr; Cconst_int(offset * size_addr)])
   | Udirect_apply(lbl, args, dbg) ->
-      Cop(Capply(typ_addr, dbg), Cconst_symbol lbl :: List.map transl args)
+      Cop(Capply(typ_val, dbg), Cconst_symbol lbl :: List.map transl args)
   | Ugeneric_apply(clos, [arg], dbg) ->
       bind "fun" (transl clos) (fun clos ->
-        Cop(Capply(typ_addr, dbg), [get_field clos 0; transl arg; clos]))
+        Cop(Capply(typ_val, dbg), [get_field clos 0; transl arg; clos]))
   | Ugeneric_apply(clos, args, dbg) ->
       let arity = List.length args in
       let cargs = Cconst_symbol(apply_function arity) ::
         List.map transl (args @ [clos]) in
-      Cop(Capply(typ_addr, dbg), cargs)
+      Cop(Capply(typ_val, dbg), cargs)
   | Usend(kind, met, obj, args, dbg) ->
       let call_met obj args clos =
         if args = [] then
-          Cop(Capply(typ_addr, dbg), [get_field clos 0;obj;clos])
+          Cop(Capply(typ_val, dbg), [get_field clos 0;obj;clos])
         else
           let arity = List.length args + 1 in
           let cargs = Cconst_symbol(apply_function arity) :: obj ::
             (List.map transl args) @ [clos] in
-          Cop(Capply(typ_addr, dbg), cargs)
+          Cop(Capply(typ_val, dbg), cargs)
       in
       bind "obj" (transl obj) (fun obj ->
         match kind, args with
@@ -1364,7 +1373,8 @@ let rec transl = function
                            id exp body
       | Boxed_integer bi ->
           transl_unbox_let (box_int bi) (unbox_int bi) (transl_unbox_int bi)
-                           (if bi = Pint32 then Thirtytwo_signed else Word)
+                           (if bi = Pint32 then Thirtytwo_signed
+                                           else Word_int)
                            size_addr
                            id exp body
       end
@@ -1386,7 +1396,7 @@ let rec transl = function
               (Cop(Cextcall(prim.prim_native_name, typ_float, false, dbg),
                    List.map transl_unbox_float args))
           else
-            Cop(Cextcall(Primitive.native_name prim, typ_addr, prim.prim_alloc,
+            Cop(Cextcall(Primitive.native_name prim, typ_val, prim.prim_alloc,
                          dbg),
                 List.map transl args)
       | (Pmakearray kind, []) ->
@@ -1394,7 +1404,7 @@ let rec transl = function
       | (Pmakearray kind, args) ->
           begin match kind with
             Pgenarray ->
-              Cop(Cextcall("caml_make_array", typ_addr, true, Debuginfo.none),
+              Cop(Cextcall("caml_make_array", typ_val, true, Debuginfo.none),
                   [make_alloc 0 (List.map transl args)])
           | Paddrarray | Pintarray ->
               make_alloc 0 (List.map transl args)
@@ -1431,7 +1441,7 @@ let rec transl = function
             dbg)
       | (Pbigarraydim(n), [b]) ->
           let dim_ofs = 4 + n in
-          tag_int (Cop(Cload Word, [field_address (transl b) dim_ofs]))
+          tag_int (Cop(Cload Word_int, [field_address (transl b) dim_ofs]))
       | (p, [arg]) ->
           transl_prim_1 p arg dbg
       | (p, [arg1; arg2]) ->
@@ -1560,7 +1570,8 @@ and transl_prim_1 p arg dbg =
             [if n = 0 then ptr
                        else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
   | Pint_as_pointer ->
-     Cop(Cadda, [transl arg; Cconst_int (-1)])
+     Cop(Caddi, [transl arg; Cconst_int (-1)])
+     (* always a pointer outside the heap *)
   (* Exceptions *)
   | Praise k ->
       Cop(Craise (k, dbg), [transl arg])
@@ -1586,8 +1597,8 @@ and transl_prim_1 p arg dbg =
   | Poffsetref n ->
       return_unit
         (bind "ref" (transl arg) (fun arg ->
-          Cop(Cstore Word,
-              [arg; add_const (Cop(Cload Word, [arg])) (n lsl 1)])))
+          Cop(Cstore Word_int,
+              [arg; add_const (Cop(Cload Word_int, [arg])) (n lsl 1)])))
   (* Floating-point operations *)
   | Pfloatofint ->
       box_float(Cop(Cfloatofint, [untag_int(transl arg)]))
@@ -1745,8 +1756,8 @@ and transl_prim_2 p arg1 arg2 dbg =
      tag_int
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 1)) idx
                       (unaligned_load_16 ba_data idx)))))
 
@@ -1761,8 +1772,8 @@ and transl_prim_2 p arg1 arg2 dbg =
      box_int Pint32
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 3)) idx
                       (unaligned_load_32 ba_data idx)))))
 
@@ -1777,8 +1788,8 @@ and transl_prim_2 p arg1 arg2 dbg =
      box_int Pint64
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 7)) idx
                       (unaligned_load_64 ba_data idx)))))
 
@@ -1791,8 +1802,10 @@ and transl_prim_2 p arg1 arg2 dbg =
               Cifthenelse(is_addr_array_ptr arr,
                           addr_array_ref arr idx,
                           float_array_ref arr idx)))
-      | Paddrarray | Pintarray ->
+      | Paddrarray ->
           addr_array_ref (transl arg1) (transl arg2)
+      | Pintarray ->
+          int_array_ref (transl arg1) (transl arg2)
       | Pfloatarray ->
           float_array_ref (transl arg1) (transl arg2)
       end
@@ -1813,11 +1826,16 @@ and transl_prim_2 p arg1 arg2 dbg =
                           addr_array_ref arr idx),
                 Csequence(make_checkbound dbg [float_array_length hdr; idx],
                           float_array_ref arr idx)))))
-      | Paddrarray | Pintarray ->
+      | Paddrarray ->
           bind "index" (transl arg2) (fun idx ->
           bind "arr" (transl arg1) (fun arr ->
             Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                       addr_array_ref arr idx)))
+      | Pintarray ->
+          bind "index" (transl arg2) (fun idx ->
+          bind "arr" (transl arg1) (fun arr ->
+            Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
+                      int_array_ref arr idx)))
       | Pfloatarray ->
           box_float(
             bind "index" (transl arg2) (fun idx ->
@@ -1966,8 +1984,8 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
         bind "newval" (untag_int (transl arg3)) (fun newval ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 1))
                       idx (unaligned_set_16 ba_data idx newval))))))
 
@@ -1984,8 +2002,8 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
         bind "newval" (transl_unbox_int Pint32 arg3) (fun newval ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 3))
                       idx (unaligned_set_32 ba_data idx newval))))))
 
@@ -2002,8 +2020,8 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
        (bind "ba" (transl arg1) (fun ba ->
         bind "index" (untag_int (transl arg2)) (fun idx ->
         bind "newval" (transl_unbox_int Pint64 arg3) (fun newval ->
-        bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data ->
-          check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5]))
+        bind "ba_data" (Cop(Cload Word_int, [field_address ba 1])) (fun ba_data ->
+          check_bound unsafe dbg (sub_int (Cop(Cload Word_int,[field_address ba 5]))
                                           (Cconst_int 7)) idx
                       (unaligned_set_64 ba_data idx newval))))))
 
@@ -2154,7 +2172,7 @@ and transl_letrec bindings cont =
   let bsz =
     List.map (fun (id, exp) -> (id, exp, expr_size Ident.empty exp)) bindings in
   let op_alloc prim sz =
-    Cop(Cextcall(prim, typ_addr, true, Debuginfo.none), [int_const sz]) in
+    Cop(Cextcall(prim, typ_val, true, Debuginfo.none), [int_const sz]) in
   let rec init_blocks = function
     | [] -> fill_nonrec bsz
     | (id, exp, RHS_block sz) :: rem ->
@@ -2184,7 +2202,7 @@ and transl_letrec bindings cont =
 
 let transl_function f =
   Cfunction {fun_name = f.label;
-             fun_args = List.map (fun id -> (id, typ_addr)) f.params;
+             fun_args = List.map (fun id -> (id, typ_val)) f.params;
              fun_body = transl f.body;
              fun_fast = !Clflags.optimize_for_speed;
              fun_dbg  = f.dbg; }
@@ -2371,7 +2389,7 @@ let cache_public_method meths tag cache =
   Clet (
   li, Cconst_int 3,
   Clet (
-  hi, Cop(Cload Word, [meths]),
+  hi, Cop(Cload Word_int, [meths]),
   Csequence(
   Ccatch
     (raise_num, [],
@@ -2385,7 +2403,7 @@ let cache_public_method meths tag cache =
         Cifthenelse
           (Cop (Ccmpi Clt,
                 [tag;
-                 Cop(Cload Word,
+                 Cop(Cload Word_int,
                      [Cop(Cadda,
                           [meths; lsl_const (Cvar mi) log2_size_addr])])]),
            Cassign(hi, Cop(Csubi, [Cvar mi; Cconst_int 2])),
@@ -2397,7 +2415,7 @@ let cache_public_method meths tag cache =
   Clet (
   tagged, Cop(Cadda, [lsl_const (Cvar li) log2_size_addr;
                       Cconst_int(1 - 3 * size_addr)]),
-  Csequence(Cop (Cstore Word, [cache; Cvar tagged]),
+  Csequence(Cop (Cstore Word_int, [cache; Cvar tagged]),
             Cvar tagged)))))
 
 (* Generate an application function:
@@ -2417,12 +2435,12 @@ let apply_function_body arity =
   let clos = Ident.create "clos" in
   let rec app_fun clos n =
     if n = arity-1 then
-      Cop(Capply(typ_addr, Debuginfo.none),
+      Cop(Capply(typ_val, Debuginfo.none),
           [get_field (Cvar clos) 0; Cvar arg.(n); Cvar clos])
     else begin
       let newclos = Ident.create "clos" in
       Clet(newclos,
-           Cop(Capply(typ_addr, Debuginfo.none),
+           Cop(Capply(typ_val, Debuginfo.none),
                [get_field (Cvar clos) 0; Cvar arg.(n); Cvar clos]),
            app_fun newclos (n+1))
     end in
@@ -2432,7 +2450,7 @@ let apply_function_body arity =
    if arity = 1 then app_fun clos 0 else
    Cifthenelse(
    Cop(Ccmpi Ceq, [get_field (Cvar clos) 1; int_const arity]),
-   Cop(Capply(typ_addr, Debuginfo.none),
+   Cop(Capply(typ_val, Debuginfo.none),
        get_field (Cvar clos) 2 :: List.map (fun s -> Cvar s) all_args),
    app_fun clos 0))
 
@@ -2449,24 +2467,24 @@ let send_function arity =
     let cached_pos = Cvar cached in
     let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths]);
                               Cconst_int(3*size_addr-1)]) in
-    let tag' = Cop(Cload Word, [tag_pos]) in
+    let tag' = Cop(Cload Word_int, [tag_pos]) in
     Clet (
-    meths, Cop(Cload Word, [obj]),
+    meths, Cop(Cload Word_val, [obj]),
     Clet (
-    cached, Cop(Cand, [Cop(Cload Word, [cache]); mask]),
+    cached, Cop(Cand, [Cop(Cload Word_int, [cache]); mask]),
     Clet (
     real,
     Cifthenelse(Cop(Ccmpa Cne, [tag'; tag]),
                 cache_public_method (Cvar meths) tag cache,
                 cached_pos),
-    Cop(Cload Word, [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths]);
-                                 Cconst_int(2*size_addr-1)])]))))
+    Cop(Cload Word_val, [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths]);
+                                     Cconst_int(2*size_addr-1)])]))))
 
   in
   let body = Clet(clos', clos, body) in
   let fun_args =
-    [obj, typ_addr; tag, typ_int; cache, typ_addr]
-    @ List.map (fun id -> (id, typ_addr)) (List.tl args) in
+    [obj, typ_val; tag, typ_int; cache, typ_val]
+    @ List.map (fun id -> (id, typ_val)) (List.tl args) in
   Cfunction
    {fun_name = "caml_send" ^ string_of_int arity;
     fun_args = fun_args;
@@ -2479,7 +2497,7 @@ let apply_function arity =
   let all_args = args @ [clos] in
   Cfunction
    {fun_name = "caml_apply" ^ string_of_int arity;
-    fun_args = List.map (fun id -> (id, typ_addr)) all_args;
+    fun_args = List.map (fun id -> (id, typ_val)) all_args;
     fun_body = body;
     fun_fast = true;
     fun_dbg  = Debuginfo.none }
@@ -2497,9 +2515,9 @@ let tuplify_function arity =
     else get_field (Cvar arg) i :: access_components(i+1) in
   Cfunction
    {fun_name = "caml_tuplify" ^ string_of_int arity;
-    fun_args = [arg, typ_addr; clos, typ_addr];
+    fun_args = [arg, typ_val; clos, typ_val];
     fun_body =
-      Cop(Capply(typ_addr, Debuginfo.none),
+      Cop(Capply(typ_val, Debuginfo.none),
           get_field (Cvar clos) 2 :: access_components 0 @ [Cvar clos]);
     fun_fast = true;
     fun_dbg  = Debuginfo.none }
@@ -2538,7 +2556,7 @@ let final_curry_function arity =
   let last_clos = Ident.create "clos" in
   let rec curry_fun args clos n =
     if n = 0 then
-      Cop(Capply(typ_addr, Debuginfo.none),
+      Cop(Capply(typ_val, Debuginfo.none),
           get_field (Cvar clos) 2 ::
           args @ [Cvar last_arg; Cvar clos])
     else
@@ -2558,7 +2576,7 @@ let final_curry_function arity =
   Cfunction
    {fun_name = "caml_curry" ^ string_of_int arity ^
                "_" ^ string_of_int (arity-1);
-    fun_args = [last_arg, typ_addr; last_clos, typ_addr];
+    fun_args = [last_arg, typ_val; last_clos, typ_val];
     fun_body = curry_fun [] last_clos (arity-1);
     fun_fast = true;
     fun_dbg  = Debuginfo.none }
@@ -2572,7 +2590,7 @@ let rec intermediate_curry_functions arity num =
     let arg = Ident.create "arg" and clos = Ident.create "clos" in
     Cfunction
      {fun_name = name2;
-      fun_args = [arg, typ_addr; clos, typ_addr];
+      fun_args = [arg, typ_val; clos, typ_val];
       fun_body =
          if arity - num > 2 && arity <= max_arity_optimized then
            Cop(Calloc,
@@ -2593,13 +2611,13 @@ let rec intermediate_curry_functions arity num =
           let rec iter i =
             if i <= arity then
               let arg = Ident.create (Printf.sprintf "arg%d" i) in
-              (arg, typ_addr) :: iter (i+1)
+              (arg, typ_val) :: iter (i+1)
             else []
           in
           let direct_args = iter (num+2) in
           let rec iter i args clos =
             if i = 0 then
-              Cop(Capply(typ_addr, Debuginfo.none),
+              Cop(Capply(typ_val, Debuginfo.none),
                   (get_field (Cvar clos) 2) :: args @ [Cvar clos])
             else
               let newclos = Ident.create "clos" in
@@ -2610,7 +2628,7 @@ let rec intermediate_curry_functions arity num =
           let cf =
             Cfunction
               {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
-               fun_args = direct_args @ [clos, typ_addr];
+               fun_args = direct_args @ [clos, typ_val];
                fun_body = iter (num+1)
                   (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
                fun_fast = true;
@@ -2655,9 +2673,9 @@ let generic_functions shared units =
 
 let entry_point namelist =
   let incr_global_inited =
-    Cop(Cstore Word,
+    Cop(Cstore Word_int,
         [Cconst_symbol "caml_globals_inited";
-         Cop(Caddi, [Cop(Cload Word, [Cconst_symbol "caml_globals_inited"]);
+         Cop(Caddi, [Cop(Cload Word_int, [Cconst_symbol "caml_globals_inited"]);
                      Cconst_int 1])]) in
   let body =
     List.fold_right
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 98df5f958b..82608c2215 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -181,10 +181,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+        {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -529,7 +531,7 @@ let emit_instr fallthrough i =
     | Lop(Iload(chunk, addr)) ->
         let dest = i.res.(0) in
         begin match chunk with
-          | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
+          | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
               `	movl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
           | Byte_unsigned ->
               `	movzbl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
@@ -546,7 +548,7 @@ let emit_instr fallthrough i =
         end
     | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
-          | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
+          | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
             `	movl	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
           | Byte_unsigned | Byte_signed ->
             `	movb	{emit_reg8 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index ef5205ef8f..201a4730c7 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -151,10 +151,12 @@ let record_frame_label live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+        {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -465,7 +467,7 @@ let emit_instr i =
     | Lop(Iload(chunk, addr)) ->
         let dest = i.res.(0) in
         begin match chunk with
-          | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
+          | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
             `	mov	{emit_reg dest}, DWORD PTR {emit_addressing addr i.arg 0}\n`
           | Byte_unsigned ->
               `	movzx	{emit_reg dest}, BYTE PTR {emit_addressing addr i.arg 0}\n`
@@ -482,7 +484,7 @@ let emit_instr i =
         end
     | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
-          | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
+          | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
             `	mov	DWORD PTR {emit_addressing addr i.arg 1}, {emit_reg i.arg.(0)}\n`
           | Byte_unsigned | Byte_signed ->
             `	mov	BYTE PTR {emit_addressing addr i.arg 1}, {emit_reg8 i.arg.(0)}\n`
diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
index 10d2d40e37..f9ce4592ea 100644
--- a/asmcomp/i386/selection.ml
+++ b/asmcomp/i386/selection.ml
@@ -197,7 +197,7 @@ method! select_operation op args =
   match op with
   (* Recognize the LEA instruction *)
     Caddi | Cadda | Csubi | Csuba ->
-      begin match self#select_addressing Word (Cop(op, args)) with
+      begin match self#select_addressing Word_int (Cop(op, args)) with
         (Iindexed d, _) -> super#select_operation op args
       | (Iindexed2 0, _) -> super#select_operation op args
       | (addr, arg) -> (Ispecific(Ilea addr), [arg])
@@ -215,11 +215,11 @@ method! select_operation op args =
       self#select_floatarith Idivf (Ispecific Idivfrev) Ifloatdiv Ifloatdivrev
                              args
   (* Recognize store instructions *)
-  | Cstore Word ->
+  | Cstore (Word_int | Word_val as chunk) ->
       begin match args with
         [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])]
         when loc = loc' ->
-          let (addr, arg) = self#select_addressing Word loc in
+          let (addr, arg) = self#select_addressing chunk loc in
           (Ispecific(Ioffset_loc(n, addr)), [arg])
       | _ ->
           super#select_operation op args
@@ -280,8 +280,8 @@ method select_push exp =
   | Cconst_pointer n -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
   | Cconst_natpointer n -> (Ispecific(Ipush_int n), Ctuple [])
   | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple [])
-  | Cop(Cload Word, [loc]) ->
-      let (addr, arg) = self#select_addressing Word loc in
+  | Cop(Cload (Word_int | Word_val as chunk), [loc]) ->
+      let (addr, arg) = self#select_addressing chunk loc in
       (Ispecific(Ipush_load addr), arg)
   | Cop(Cload Double_u, [loc]) ->
       let (addr, arg) = self#select_addressing Double_u loc in
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index 0a26ed1479..24255fa834 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -214,10 +214,12 @@ let record_frame live dbg =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
-          live_offset := (r lsl 1) + 1 :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
@@ -542,7 +544,7 @@ let rec emit_instr i dslot =
           | Sixteen_signed -> "lha"
           | Thirtytwo_unsigned -> "lwz"
           | Thirtytwo_signed -> if ppc64 then "lwa" else "lwz"
-	  | Word -> lg
+	  | Word_int | Word_val -> lg
           | Single -> "lfs"
           | Double | Double_u -> "lfd" in
         emit_load_store loadinstr addr i.arg 0 i.res.(0);
@@ -554,7 +556,7 @@ let rec emit_instr i dslot =
             Byte_unsigned | Byte_signed -> "stb"
           | Sixteen_unsigned | Sixteen_signed -> "sth"
 	  | Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
-	  | Word -> stg
+	  | Word_int | Word_val -> stg
           | Single -> "stfs"
           | Double | Double_u -> "stfd" in
         emit_load_store storeinstr addr i.arg 1 i.arg.(0)
diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
index 89c8582aef..e13bff04bc 100644
--- a/asmcomp/printcmm.ml
+++ b/asmcomp/printcmm.ml
@@ -16,6 +16,7 @@ open Format
 open Cmm
 
 let machtype_component ppf = function
+  | Val -> fprintf ppf "val"
   | Addr -> fprintf ppf "addr"
   | Int -> fprintf ppf "int"
   | Float -> fprintf ppf "float"
@@ -43,7 +44,8 @@ let chunk = function
   | Sixteen_signed -> "signed int16"
   | Thirtytwo_unsigned -> "unsigned int32"
   | Thirtytwo_signed -> "signed int32"
-  | Word -> ""
+  | Word_int -> "int"
+  | Word_val -> "val"
   | Single -> "float32"
   | Double -> "float64"
   | Double_u -> "float64u"
@@ -52,10 +54,8 @@ let operation = function
   | Capply(ty, d) -> "app" ^ Debuginfo.to_string d
   | Cextcall(lbl, ty, alloc, d) ->
       Printf.sprintf "extcall \"%s\"%s" lbl (Debuginfo.to_string d)
-  | Cload Word -> "load"
   | Cload c -> Printf.sprintf "load %s" (chunk c)
   | Calloc -> "alloc"
-  | Cstore Word -> "store"
   | Cstore c -> Printf.sprintf "store %s" (chunk c)
   | Caddi -> "+"
   | Csubi -> "-"
@@ -70,8 +70,8 @@ let operation = function
   | Clsr -> ">>u"
   | Casr -> ">>s"
   | Ccmpi c -> comparison c
+  | Caddv -> "+v"
   | Cadda -> "+a"
-  | Csuba -> "-a"
   | Ccmpa c -> Printf.sprintf "%sa" (comparison c)
   | Cnegf -> "~f"
   | Cabsf -> "absf"
diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml
index a39160d28c..7c4679f8de 100644
--- a/asmcomp/printmach.ml
+++ b/asmcomp/printmach.ml
@@ -21,7 +21,8 @@ let reg ppf r =
   if not (Reg.anonymous r) then
     fprintf ppf "%s" (Reg.name r)
   else
-    fprintf ppf "%s" (match r.typ with Addr -> "A" | Int -> "I" | Float -> "F");
+    fprintf ppf "%s"
+      (match r.typ with Val -> "V" | Addr -> "A" | Int -> "I" | Float -> "F");
   fprintf ppf "/%i" r.stamp;
   begin match r.loc with
   | Unknown -> ()
@@ -56,7 +57,10 @@ let regsetaddr ppf s =
     (fun r ->
       if !first then begin first := false; fprintf ppf "%a" reg r end
       else fprintf ppf "@ %a" reg r;
-      match r.typ with Addr -> fprintf ppf "*" | _ -> ())
+      match r.typ with
+      | Val -> fprintf ppf "*"
+      | Addr -> fprintf ppf "!"
+      | _ -> ())
     s
 
 let intcomp = function
diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml
index f7af443675..c1ba222a8d 100644
--- a/asmcomp/schedgen.ml
+++ b/asmcomp/schedgen.ml
@@ -132,7 +132,7 @@ let rec remove_instr node = function
 
 (* We treat Lreloadretaddr as a word-sized load *)
 
-let some_load = (Iload(Cmm.Word, Arch.identity_addressing))
+let some_load = (Iload(Cmm.Word_int, Arch.identity_addressing))
 
 (* The generic scheduler *)
 
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 86e16d38f4..9afe2526cf 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -27,16 +27,17 @@ let oper_result_type = function
   | Cextcall(s, ty, alloc, _) -> ty
   | Cload c ->
       begin match c with
-        Word -> typ_addr
+      | Word_val -> typ_val
       | Single | Double | Double_u -> typ_float
       | _ -> typ_int
       end
-  | Calloc -> typ_addr
+  | Calloc -> typ_val
   | Cstore c -> typ_void
   | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi |
     Cand | Cor | Cxor | Clsl | Clsr | Casr |
     Ccmpi _ | Ccmpa _ | Ccmpf _ -> typ_int
-  | Cadda | Csuba -> typ_addr
+  | Caddv -> typ_val
+  | Cadda -> typ_addr
   | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf -> typ_float
   | Cfloatofint -> typ_float
   | Cintoffloat -> typ_int
@@ -210,7 +211,7 @@ method virtual select_addressing :
 (* Default instruction selection for stores (of words) *)
 
 method select_store is_assign addr arg =
-  (Istore(Word, addr, is_assign), arg)
+  (Istore(Word_val, addr, is_assign), arg)
 
 (* call marking methods, documented in selectgen.mli *)
 
@@ -255,7 +256,7 @@ method select_operation op args =
       (Iload(chunk, addr), [eloc])
   | (Cstore chunk, [arg1; arg2]) ->
       let (addr, eloc) = self#select_addressing chunk arg1 in
-      if chunk = Word then begin
+      if chunk = Word_int || chunk = Word_val then begin
         let (op, newarg2) = self#select_store true addr arg2 in
         (op, [newarg2; eloc])
       end else begin
@@ -276,8 +277,8 @@ method select_operation op args =
   | (Clsr, _) -> self#select_shift Ilsr args
   | (Casr, _) -> self#select_shift Iasr args
   | (Ccmpi comp, _) -> self#select_arith_comp (Isigned comp) args
+  | (Caddv, _) -> self#select_arith_comm Iadd args
   | (Cadda, _) -> self#select_arith_comm Iadd args
-  | (Csuba, _) -> self#select_arith Isub args
   | (Ccmpa comp, _) -> self#select_arith_comp (Iunsigned comp) args
   | (Cnegf, _) -> (Inegf, args)
   | (Cabsf, _) -> (Iabsf, args)
@@ -395,14 +396,14 @@ method insert_moves src dst =
 
 (* Adjust the types of destination pseudoregs for a [Cassign] assignment.
    The type inferred at [let] binding might be [Int] while we assign
-   something of type [Addr] (PR#6501). *)
+   something of type [Val] (PR#6501). *)
 
 method adjust_type src dst =
   let ts = src.typ and td = dst.typ in
   if ts <> td then
     match ts, td with
-    | Addr, Int -> dst.typ <- Addr
-    | Int, Addr -> ()
+    | Val, Int -> dst.typ <- Val
+    | Int, Val -> ()
     | _, _ -> fatal_error("Selection.adjust_type: bad assignment to "
                                                            ^ Reg.name dst)
 
@@ -450,13 +451,13 @@ method emit_expr env exp =
       let r = self#regs_for typ_float in
       Some(self#insert_op (Iconst_float n) [||] r)
   | Cconst_symbol n ->
-      let r = self#regs_for typ_addr in
+      let r = self#regs_for typ_int in  (* pointer outside heap *)
       Some(self#insert_op (Iconst_symbol n) [||] r)
   | Cconst_pointer n ->
-      let r = self#regs_for typ_addr in
+      let r = self#regs_for typ_val in  (* integer as Caml value *)
       Some(self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r)
   | Cconst_natpointer n ->
-      let r = self#regs_for typ_addr in
+      let r = self#regs_for typ_val in  (* integer as Caml value *)
       Some(self#insert_op (Iconst_int n) [||] r)
   | Cvar v ->
       begin try
@@ -535,7 +536,7 @@ method emit_expr env exp =
               self#insert_move_results loc_res rd stack_ofs;
               Some rd
           | Ialloc _ ->
-              let rd = self#regs_for typ_addr in
+              let rd = self#regs_for typ_val in
               let size = size_expr env (Ctuple new_args) in
               self#insert (Iop(Ialloc size)) [||] rd;
               self#emit_stores env new_args rd;
@@ -581,7 +582,7 @@ method emit_expr env exp =
       let rs =
         List.map
           (fun id ->
-            let r = self#regs_for typ_addr in name_regs id r; r)
+            let r = self#regs_for typ_val in name_regs id r; r)
           ids in
       catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
       let (r1, s1) = self#emit_sequence env e1 in
@@ -610,7 +611,7 @@ method emit_expr env exp =
       end
   | Ctrywith(e1, v, e2) ->
       let (r1, s1) = self#emit_sequence env e1 in
-      let rv = self#regs_for typ_addr in
+      let rv = self#regs_for typ_val in
       let (r2, s2) = self#emit_sequence (Tbl.add v rv env) e2 in
       let r = join r1 s1 r2 s2 in
       self#insert
@@ -703,7 +704,7 @@ method emit_stores env data regs_addr =
             Istore(_, _, _) ->
               for i = 0 to Array.length regs - 1 do
                 let r = regs.(i) in
-                let kind = if r.typ = Float then Double_u else Word in
+                let kind = if r.typ = Float then Double_u else Word_val in
                 self#insert (Iop(Istore(kind, !a, false)))
                             (Array.append [|r|] regs_addr) [||];
                 a := Arch.offset_addressing !a (size_component r.typ)
@@ -799,7 +800,7 @@ method emit_tail env exp =
        let rs =
         List.map
           (fun id ->
-            let r = self#regs_for typ_addr in
+            let r = self#regs_for typ_val in
             name_regs id r  ;
             r)
           ids in
@@ -814,7 +815,7 @@ method emit_tail env exp =
       self#insert (Icatch(nfail, s1, s2)) [||] [||]
   | Ctrywith(e1, v, e2) ->
       let (opt_r1, s1) = self#emit_sequence env e1 in
-      let rv = self#regs_for typ_addr in
+      let rv = self#regs_for typ_val in
       let s2 = self#emit_tail_sequence (Tbl.add v rv env) e2 in
       self#insert
         (Itrywith(s1#extract,
diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp
index 877a3d52a0..b849a12f2c 100644
--- a/asmcomp/sparc/emit.mlp
+++ b/asmcomp/sparc/emit.mlp
@@ -165,11 +165,12 @@ let record_frame live =
   let live_offset = ref [] in
   Reg.Set.iter
     (function
-        {typ = Addr; loc = Reg r} ->
+      | {typ = Val; loc = Reg r} ->
           live_offset := ((r lsl 1) + 1) :: !live_offset
-      | {typ = Addr; loc = Stack s} as reg ->
-          live_offset :=
-            slot_offset s (register_class reg) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
       | _ -> ())
     live;
   frame_descriptors :=
diff --git a/asmcomp/strmatch.ml b/asmcomp/strmatch.ml
index d63e92bf03..ad25ad8744 100644
--- a/asmcomp/strmatch.ml
+++ b/asmcomp/strmatch.ml
@@ -69,7 +69,7 @@ module Make(I:I) = struct
 
   let mk_let_cell id str ind body =
     let cell =
-      Cop(Cload Word,[Cop(Cadda,[str;Cconst_int(Arch.size_int*ind)])]) in
+      Cop(Cload Word_int,[Cop(Cadda,[str;Cconst_int(Arch.size_int*ind)])]) in
     Clet(id, cell, body)
 
   let mk_let_size id str body =