l4/pkg/ocaml/contrib/asmcomp/comballoc.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1999 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: comballoc.ml 7812 2007-01-29 12:11:18Z xleroy $ *)
  14
  15 (* Combine heap allocations occurring in the same basic block *)
  16
  17 open Mach
  18
  19 type allocation_state =
  20     No_alloc                            (* no allocation is pending *)
  21   | Pending_alloc of Reg.t * int        (* an allocation is pending *)
  22 (* The arguments of Pending_alloc(reg, ofs) are:
  23      reg  the register holding the result of the last allocation
  24      ofs  the alloc position in the allocated block *)
  25
  26 let allocated_size = function
  27     No_alloc -> 0
  28   | Pending_alloc(reg, ofs) -> ofs
  29
  30 let rec combine i allocstate =
  31   match i.desc with
  32     Iend | Ireturn | Iexit _ | Iraise ->
  33       (i, allocated_size allocstate)
  34   | Iop(Ialloc sz) ->
  35       begin match allocstate with
  36         No_alloc ->
  37           let (newnext, newsz) =
  38             combine i.next (Pending_alloc(i.res.(0), sz)) in
  39           (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, 0)
  40       | Pending_alloc(reg, ofs) ->
  41           if ofs + sz < Config.max_young_wosize then begin
  42             let (newnext, newsz) =
  43               combine i.next (Pending_alloc(reg, ofs + sz)) in
  44             (instr_cons (Iop(Iintop_imm(Iadd, ofs))) [| reg |] i.res newnext,
  45              newsz)
  46           end else begin
  47             let (newnext, newsz) =
  48               combine i.next (Pending_alloc(i.res.(0), sz)) in
  49             (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, ofs)
  50           end
  51       end
  52   | Iop(Icall_ind | Icall_imm _ | Iextcall _ |
  53         Itailcall_ind | Itailcall_imm _) ->
  54       let newnext = combine_restart i.next in
  55       (instr_cons_debug i.desc i.arg i.res i.dbg newnext,
  56        allocated_size allocstate)
  57   | Iop op ->
  58       let (newnext, sz) = combine i.next allocstate in
  59       (instr_cons_debug i.desc i.arg i.res i.dbg newnext, sz)
  60   | Iifthenelse(test, ifso, ifnot) ->
  61       let newifso = combine_restart ifso in
  62       let newifnot = combine_restart ifnot in
  63       let newnext = combine_restart i.next in
  64       (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
  65        allocated_size allocstate)
  66   | Iswitch(table, cases) ->
  67       let newcases = Array.map combine_restart cases in
  68       let newnext = combine_restart i.next in
  69       (instr_cons (Iswitch(table, newcases)) i.arg i.res newnext,
  70        allocated_size allocstate)
  71   | Iloop(body) ->
  72       let newbody = combine_restart body in
  73       (instr_cons (Iloop(newbody)) i.arg i.res i.next,
  74        allocated_size allocstate)
  75   | Icatch(io, body, handler) ->
  76       let (newbody, sz) = combine body allocstate in
  77       let newhandler = combine_restart handler in
  78       let newnext = combine_restart i.next in
  79       (instr_cons (Icatch(io, newbody, newhandler)) i.arg i.res newnext, sz)
  80   | Itrywith(body, handler) ->
  81       let (newbody, sz) = combine body allocstate in
  82       let newhandler = combine_restart handler in
  83       let newnext = combine_restart i.next in
  84       (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, sz)
  85
  86 and combine_restart i =
  87   let (newi, _) = combine i No_alloc in newi
  88
  89 let fundecl f =
  90   {f with fun_body = combine_restart f.fun_body}