diff options
author | Xavier Leroy <xavier.leroy@inria.fr> | 1999-05-15 15:04:46 +0000 |
---|---|---|
committer | Xavier Leroy <xavier.leroy@inria.fr> | 1999-05-15 15:04:46 +0000 |
commit | 57d1b406ce84cf1e1071ccc4a9604ee013a6eea0 (patch) | |
tree | 6d92d26779fd46264224e628d006fe05f079a149 /asmcomp/comballoc.ml | |
parent | 94b8cdbb749016ee94e753088a30016f03e5cd2f (diff) | |
download | ocaml-57d1b406ce84cf1e1071ccc4a9604ee013a6eea0.tar.gz |
Ajout d'une passe supplementaire pour combiner les allocations qui apparaissent dans le meme bloc de base.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2361 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'asmcomp/comballoc.ml')
-rw-r--r-- | asmcomp/comballoc.ml | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml new file mode 100644 index 0000000000..1eb361df20 --- /dev/null +++ b/asmcomp/comballoc.ml @@ -0,0 +1,88 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Combine heap allocations occurring in the same basic block *) + +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 *) + +let allocated_size = function + No_alloc -> 0 + | Pending_alloc(reg, ofs) -> ofs + +let rec combine i allocstate = + match i.desc with + Iend | Ireturn | Iexit | Iraise -> + (i, allocated_size allocstate) + | Iop(Ialloc sz) -> + begin match allocstate with + No_alloc -> + let (newnext, newsz) = + combine i.next (Pending_alloc(i.res.(0), sz)) in + (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, 0) + | Pending_alloc(reg, ofs) -> + if ofs + sz < Config.max_young_wosize 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, + newsz) + end else begin + let (newnext, newsz) = + combine i.next (Pending_alloc(i.res.(0), sz)) in + (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, ofs) + end + end + | Iop(Icall_ind | Icall_imm _ | Iextcall(_, _) | + Itailcall_ind | Itailcall_imm _) -> + let newnext = combine_restart i.next in + (instr_cons i.desc i.arg i.res newnext, allocated_size allocstate) + | Iop op -> + let (newnext, sz) = combine i.next allocstate in + (instr_cons i.desc i.arg i.res newnext, sz) + | 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) + | 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) + | Iloop(body) -> + let newbody = combine_restart body in + (instr_cons (Iloop(newbody)) i.arg i.res i.next, + allocated_size allocstate) + | Icatch(body, handler) -> + let (newbody, sz) = combine body allocstate in + let newhandler = combine_restart handler in + let newnext = combine_restart i.next in + (instr_cons (Icatch(newbody, newhandler)) i.arg i.res newnext, sz) + | Itrywith(body, handler) -> + 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) + +and combine_restart i = + let (newi, _) = combine i No_alloc in newi + +let fundecl f = + {f with fun_body = combine_restart f.fun_body} |