diff options
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | asmcomp/cmmgen.ml | 22 |
2 files changed, 17 insertions, 7 deletions
@@ -49,6 +49,8 @@ OCaml 4.01.1: Bug fixes: - PR#6173: Typing error message is worse that before - PR#6174: OCaml compiler loops on an example using GADTs (non -rectypes) +- PR#6216: inlining of GADT matches generates invalid assembly + OCaml 4.01.0: ------------- diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 2c62720e8..2ff8edb9a 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -990,7 +990,7 @@ let is_unboxed_number = function end | _ -> No_unboxing -let subst_boxed_number unbox_fn boxed_id unboxed_id exp = +let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp = let need_boxed = ref false in let assigned = ref false in let rec subst = function @@ -1004,10 +1004,14 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id exp = end else Cassign(id, subst arg) | Ctuple argv -> Ctuple(List.map subst argv) - | Cop(Cload _, [Cvar id]) as e -> - if Ident.same id boxed_id then Cvar unboxed_id else e - | Cop(Cload _, [Cop(Cadda, [Cvar id; _])]) as e -> - if Ident.same id boxed_id then Cvar unboxed_id else e + | Cop(Cload chunk, [Cvar id]) as e -> + if Ident.same id boxed_id && chunk = box_chunk && box_offset = 0 + then Cvar unboxed_id + else e + | Cop(Cload chunk, [Cop(Cadda, [Cvar id; Cconst_int ofs])]) as e -> + if Ident.same id boxed_id && chunk = box_chunk && ofs = box_offset + then Cvar unboxed_id + else e | Cop(op, argv) -> Cop(op, List.map subst argv) | Csequence(e1, e2) -> Csequence(subst e1, subst e2) | Cifthenelse(e1, e2, e3) -> Cifthenelse(subst e1, subst e2, subst e3) @@ -1098,9 +1102,12 @@ let rec transl = function Clet(id, transl exp, transl body) | Boxed_float -> transl_unbox_let box_float unbox_float transl_unbox_float + Double_u 0 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) + size_addr id exp body end | Uletrec(bindings, body) -> @@ -1755,11 +1762,12 @@ and transl_unbox_int bi = function Cconst_int i | exp -> unbox_int bi (transl exp) -and transl_unbox_let box_fn unbox_fn transl_unbox_fn id exp body = +and transl_unbox_let box_fn unbox_fn transl_unbox_fn box_chunk box_offset + id exp body = let unboxed_id = Ident.create (Ident.name id) in let trbody1 = transl body in let (trbody2, need_boxed, is_assigned) = - subst_boxed_number unbox_fn id unboxed_id trbody1 in + subst_boxed_number unbox_fn id unboxed_id box_chunk box_offset trbody1 in if need_boxed && is_assigned then Clet(id, transl exp, trbody1) else |