[Hide Content]diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml
index 5a862b1..82c01f9 100644
--- a/asmcomp/comballoc.ml
+++ b/asmcomp/comballoc.ml
@@ -27,64 +27,78 @@ let allocated_size = function
No_alloc -> 0
| Pending_alloc(reg, ofs) -> ofs
+let instr_cons_alloc sz a r n =
+ if sz != 0
+ then instr_cons (Iop(Ialloc sz)) a r n
+ else n
+
let rec combine i allocstate =
match i.desc with
Iend | Ireturn | Iexit _ | Iraise ->
- (i, allocated_size allocstate)
+ (i, allocated_size allocstate, true)
| Iop(Ialloc sz) ->
begin match allocstate with
No_alloc ->
- let (newnext, newsz) =
+ let (newnext, newsz, _) =
combine i.next (Pending_alloc(i.res.(0), sz)) in
- (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, 0)
+ (instr_cons_alloc newsz i.arg i.res newnext, 0, false)
| Pending_alloc(reg, ofs) ->
if ofs + sz < Config.max_young_wosize then begin
- let (newnext, newsz) =
+ let (newnext, newsz, safe) =
combine i.next (Pending_alloc(reg, ofs + sz)) in
- (instr_cons (Iop(Iintop_imm(Iadd, ofs))) [| reg |] i.res newnext,
- newsz)
+ if sz != 0 && ofs != 0 then
+ (instr_cons (Iop(Iintop_imm(Iadd, ofs))) [|reg|] i.res newnext, newsz, safe)
+ else if sz != 0 then
+ (instr_cons (Iop Imove) [|reg|] i.res newnext, newsz, safe)
+ else
+ (newnext, newsz, safe)
end else begin
- let (newnext, newsz) =
+ let (newnext, newsz, _) =
combine i.next (Pending_alloc(i.res.(0), sz)) in
- (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, ofs)
+ (instr_cons_alloc newsz i.arg i.res newnext, ofs, false)
end
end
| Iop(Icall_ind | Icall_imm _ | Iextcall _ |
Itailcall_ind | Itailcall_imm _) ->
let newnext = combine_restart i.next in
- (instr_cons_debug i.desc i.arg i.res i.dbg newnext,
- allocated_size allocstate)
+ (instr_cons_debug i.desc i.arg i.res i.dbg newnext, allocated_size allocstate, false)
| Iop op ->
- let (newnext, sz) = combine i.next allocstate in
- (instr_cons_debug i.desc i.arg i.res i.dbg newnext, sz)
+ let (newnext, sz, safe) = combine i.next allocstate in
+ (instr_cons_debug i.desc i.arg i.res i.dbg newnext, sz, safe)
| Iifthenelse(test, ifso, ifnot) ->
- let newifso = combine_restart ifso in
- let newifnot = combine_restart ifnot in
- let newnext = combine_restart i.next in
- (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
- allocated_size allocstate)
+ begin match allocstate, combine ifso allocstate, combine ifnot allocstate with
+ Pending_alloc(reg, ofs), (newifso, szifso, true), (newifnot, szifnot, true) when szifso = szifnot ->
+ let (newnext, sznext, safe) = combine i.next (Pending_alloc(reg, ofs + szifso)) in
+ (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
+ sznext,
+ safe)
+ | _, _, _ ->
+ let newifso = combine_restart ifso in
+ let newifnot = combine_restart ifnot in
+ let newnext = combine_restart i.next in
+ (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
+ allocated_size allocstate, false)
+ end
| Iswitch(table, cases) ->
let newcases = Array.map combine_restart cases in
let newnext = combine_restart i.next in
- (instr_cons (Iswitch(table, newcases)) i.arg i.res newnext,
- allocated_size allocstate)
+ (instr_cons (Iswitch(table, newcases)) i.arg i.res newnext, allocated_size allocstate, false)
| Iloop(body) ->
let newbody = combine_restart body in
- (instr_cons (Iloop(newbody)) i.arg i.res i.next,
- allocated_size allocstate)
+ (instr_cons (Iloop(newbody)) i.arg i.res i.next, allocated_size allocstate, false)
| Icatch(io, body, handler) ->
- let (newbody, sz) = combine body allocstate in
+ let (newbody, sz, _) = combine body allocstate in
let newhandler = combine_restart handler in
let newnext = combine_restart i.next in
- (instr_cons (Icatch(io, newbody, newhandler)) i.arg i.res newnext, sz)
+ (instr_cons (Icatch(io, newbody, newhandler)) i.arg i.res newnext, sz, false)
| Itrywith(body, handler) ->
- let (newbody, sz) = combine body allocstate in
+ let (newbody, sz, _) = combine body allocstate in
let newhandler = combine_restart handler in
let newnext = combine_restart i.next in
- (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, sz)
+ (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, sz, false)
and combine_restart i =
- let (newi, _) = combine i No_alloc in newi
+ let (newi, _, _) = combine i No_alloc in newi
let fundecl f =
{f with fun_body = combine_restart f.fun_body}
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 7daa239..4221f95 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -562,6 +562,9 @@ method emit_expr env exp =
let (rif, sif) = self#emit_sequence env eif in
let (relse, selse) = self#emit_sequence env eelse in
let r = join rif sif relse selse in
+ (* Dummy Ialloc 0 for comballoc.ml *)
+ let ra = self#regs_for typ_addr in
+ self#insert (Iop(Ialloc 0)) [||] ra;
self#insert (Iifthenelse(cond, sif#extract, selse#extract))
rarg [||];
r
@@ -790,6 +793,9 @@ method emit_tail env exp =
begin match self#emit_expr env earg with
None -> ()
| Some rarg ->
+ (* Dummy Ialloc 0 for comballoc.ml *)
+ let ra = self#regs_for typ_addr in
+ self#insert (Iop(Ialloc 0)) [||] ra;
self#insert (Iifthenelse(cond, self#emit_tail_sequence env eif,
self#emit_tail_sequence env eelse))
rarg [||]