From 07a27d2fac064364220ef1ba4242f7a1b1d61806 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Thu, 19 Jul 2018 11:41:47 +0100 Subject: [PATCH 1/2] Ensure that comballoc.ml does not reverse the order of allocations. --- Changes | 3 +++ asmcomp/comballoc.ml | 40 +++++++++++++++++++--------------------- 2 files changed, 22 insertions(+), 21 deletions(-) diff --git a/Changes b/Changes index 4618a78cff00..96e7a8f749dc 100644 --- a/Changes +++ b/Changes @@ -299,6 +299,9 @@ Working version stubs on 32bits (Jérémie Dimino) +- GPR#1917: comballoc: ensure object allocation order is preserved + (Stephen Dolan) + ### Runtime system: - MPR#7198, MPR#7750, GPR#1738: add a function (caml_custom_alloc_mem) diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml index ff8db1a30516..20bd57aea3d2 100644 --- a/asmcomp/comballoc.ml +++ b/asmcomp/comballoc.ml @@ -20,9 +20,9 @@ open Mach type allocation_state = No_alloc (* no allocation is pending *) | Pending_alloc of Reg.t * int (* an allocation is pending *) -(* The arguments of Pending_alloc(reg, ofs) are: - reg the register holding the result of the last allocation - ofs the alloc position in the allocated block *) +(* The arguments of Pending_alloc(reg, totalsz) are: + reg the register holding the result of the last allocation + totalsz the amount to be allocated in this block *) let allocated_size = function No_alloc -> 0 @@ -34,25 +34,23 @@ let rec combine i allocstate = (i, allocated_size allocstate) | Iop(Ialloc { bytes = sz; _ }) -> begin match allocstate with - No_alloc -> - let (newnext, newsz) = - combine i.next (Pending_alloc(i.res.(0), sz)) in - (instr_cons_debug (Iop(Ialloc {bytes = newsz; spacetime_index = 0; - label_after_call_gc = None; })) - i.arg i.res i.dbg newnext, 0) - | Pending_alloc(reg, ofs) -> - if ofs + sz < Config.max_young_wosize * Arch.size_addr then begin - let (newnext, newsz) = - combine i.next (Pending_alloc(reg, ofs + sz)) in - (instr_cons (Iop(Iintop_imm(Iadd, ofs))) [| reg |] i.res newnext, + | Pending_alloc(reg, totalsz) + when totalsz + sz < Config.max_young_wosize * Arch.size_addr -> + let (newnext, newsz) = + combine i.next (Pending_alloc(i.res.(0), totalsz + sz)) in + (instr_cons_debug (Iop(Iintop_imm(Iadd, -sz))) + [| reg |] i.res i.dbg newnext, newsz) - end else begin - let (newnext, newsz) = - combine i.next (Pending_alloc(i.res.(0), sz)) in - (instr_cons_debug (Iop(Ialloc { bytes = newsz; spacetime_index = 0; - label_after_call_gc = None; })) - i.arg i.res i.dbg newnext, ofs) - end + | _ -> + let (newnext, newsz) = combine i.next (Pending_alloc(i.res.(0), sz)) in + let newnext = + if newsz = sz then newnext + else instr_cons_debug (Iop(Iintop_imm(Iadd, newsz - sz))) i.res + i.res i.dbg newnext + in + (instr_cons_debug (Iop(Ialloc {bytes = newsz; spacetime_index = 0; + label_after_call_gc = None; })) + i.arg i.res i.dbg newnext, allocated_size allocstate) end | Iop(Icall_ind _ | Icall_imm _ | Iextcall _ | Itailcall_ind _ | Itailcall_imm _) -> From 6b2a8e15b5787cf9a861b033479fef7eea366a10 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Wed, 14 Nov 2018 10:59:57 +0000 Subject: [PATCH 2/2] Coding style changes to comballoc.ml. --- asmcomp/comballoc.ml | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml index 20bd57aea3d2..b10edd2af9d1 100644 --- a/asmcomp/comballoc.ml +++ b/asmcomp/comballoc.ml @@ -18,15 +18,14 @@ open Mach type allocation_state = - No_alloc (* no allocation is pending *) - | Pending_alloc of Reg.t * int (* an allocation is pending *) -(* The arguments of Pending_alloc(reg, totalsz) are: - reg the register holding the result of the last allocation - totalsz the amount to be allocated in this block *) + No_alloc + | Pending_alloc of + { reg: Reg.t; (* register holding the result of the last allocation *) + totalsz: int } (* amount to be allocated in this block *) let allocated_size = function No_alloc -> 0 - | Pending_alloc(_, ofs) -> ofs + | Pending_alloc {totalsz; _} -> totalsz let rec combine i allocstate = match i.desc with @@ -34,23 +33,27 @@ let rec combine i allocstate = (i, allocated_size allocstate) | Iop(Ialloc { bytes = sz; _ }) -> begin match allocstate with - | Pending_alloc(reg, totalsz) + | Pending_alloc {reg; totalsz} when totalsz + sz < Config.max_young_wosize * Arch.size_addr -> - let (newnext, newsz) = - combine i.next (Pending_alloc(i.res.(0), totalsz + sz)) in - (instr_cons_debug (Iop(Iintop_imm(Iadd, -sz))) - [| reg |] i.res i.dbg newnext, - newsz) - | _ -> - let (newnext, newsz) = combine i.next (Pending_alloc(i.res.(0), sz)) in - let newnext = - if newsz = sz then newnext - else instr_cons_debug (Iop(Iintop_imm(Iadd, newsz - sz))) i.res - i.res i.dbg newnext + let (next, totalsz) = + combine i.next + (Pending_alloc { reg = i.res.(0); totalsz = totalsz + sz }) in + (instr_cons_debug (Iop(Iintop_imm(Iadd, -sz))) + [| reg |] i.res i.dbg next, + totalsz) + | No_alloc | Pending_alloc _ -> + let (next, totalsz) = + combine i.next + (Pending_alloc { reg = i.res.(0); totalsz = sz }) in + let next = + let offset = totalsz - sz in + if offset = 0 then next + else instr_cons_debug (Iop(Iintop_imm(Iadd, offset))) i.res + i.res i.dbg next in - (instr_cons_debug (Iop(Ialloc {bytes = newsz; spacetime_index = 0; + (instr_cons_debug (Iop(Ialloc {bytes = totalsz; spacetime_index = 0; label_after_call_gc = None; })) - i.arg i.res i.dbg newnext, allocated_size allocstate) + i.arg i.res i.dbg next, allocated_size allocstate) end | Iop(Icall_ind _ | Icall_imm _ | Iextcall _ | Itailcall_ind _ | Itailcall_imm _) ->