1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Combine heap allocations occurring in the same basic block *)
open Mach
type pending_alloc =
{ reg: Reg.t; (* register holding the result of the last allocation *)
dbginfos: Debuginfo.alloc_dbginfo; (* debug info for each pending alloc *)
totalsz: int } (* amount to be allocated in this block *)
type allocation_state =
No_alloc
| Pending_alloc of pending_alloc
let rec combine i allocstate =
match i.desc with
Iend | Ireturn | Iexit _ | Iraise _ ->
(i, allocstate)
| Iop(Ialloc { bytes = sz; dbginfo; _ }) ->
assert (List.length dbginfo = 1);
begin match allocstate with
| Pending_alloc {reg; dbginfos; totalsz}
when totalsz + sz <= (Config.max_young_wosize + 1) * Arch.size_addr ->
let (next, state) =
combine i.next
(Pending_alloc { reg = i.res.(0);
dbginfos = dbginfo @ dbginfos;
totalsz = totalsz + sz }) in
(instr_cons_debug (Iop(Iintop_imm(Iadd, -sz)))
[| reg |] i.res i.dbg next,
state)
| No_alloc | Pending_alloc _ ->
let (next, state) =
combine i.next
(Pending_alloc { reg = i.res.(0);
dbginfos = dbginfo;
totalsz = sz }) in
let totalsz, dbginfo =
match state with
| No_alloc -> assert false
| Pending_alloc { totalsz; dbginfos; _ } -> totalsz, dbginfos 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 = totalsz; dbginfo; }))
i.arg i.res i.dbg next, allocstate)
end
| Iop(Icall_ind | Icall_imm _ | Iextcall _ |
Itailcall_ind | Itailcall_imm _ | Ipoll _) ->
let newnext = combine_restart i.next in
(instr_cons_debug i.desc i.arg i.res i.dbg newnext,
allocstate)
| Iop _ ->
let (newnext, s') = combine i.next allocstate in
(instr_cons_debug i.desc i.arg i.res i.dbg newnext, s')
| 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,
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,
allocstate)
| Icatch(rec_flag, handlers, body) ->
let (newbody, s') = combine body allocstate in
let newhandlers =
List.map (fun (io, handler) -> io, combine_restart handler) handlers in
let newnext = combine_restart i.next in
(instr_cons (Icatch(rec_flag, newhandlers, newbody))
i.arg i.res newnext, s')
| Itrywith(body, handler) ->
let (newbody, s') = 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, s')
and combine_restart i =
let (newi, _) = combine i No_alloc in newi
let fundecl f =
{f with fun_body = combine_restart f.fun_body}
|
