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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Marcell Fischbach, University of Siegen *)
(* Benedikt Meurer, University of Siegen *)
(* *)
(* Copyright 2011 Lehrstuhl für Compilerbau und Softwareanalyse, *)
(* Universität Siegen. *)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
(* Live intervals for the linear scan register allocator. *)
open Mach
open Reg
type range =
{
mutable rbegin: int;
mutable rend: int;
}
type t =
{
mutable reg: Reg.t;
mutable ibegin: int;
mutable iend: int;
mutable ranges: range list;
}
type kind =
Result
| Argument
| Live
type result =
{
intervals : t list;
fixed_intervals : t list;
}
(* Check if two intervals overlap *)
let overlap i0 i1 =
let rec overlap_ranges rl0 rl1 =
match rl0, rl1 with
r0 :: rl0', r1 :: rl1' ->
if r0.rend >= r1.rbegin && r1.rend >= r0.rbegin then true
else if r0.rend < r1.rend then overlap_ranges rl0' rl1
else if r0.rend > r1.rend then overlap_ranges rl0 rl1'
else overlap_ranges rl0' rl1'
| _ -> false in
overlap_ranges i0.ranges i1.ranges
let is_live i pos =
let rec is_live_in_ranges = function
[] -> false
| r :: rl -> if pos < r.rbegin then false
else if pos <= r.rend then true
else is_live_in_ranges rl in
is_live_in_ranges i.ranges
let remove_expired_ranges i pos =
let rec filter = function
[] -> []
| r :: rl' as rl -> if pos < r.rend then rl
else filter rl' in
i.ranges <- filter i.ranges
let update_interval_position intervals pos kind reg =
let i = intervals.(reg.stamp) in
let on = pos lsl 1 in
let off = on + 1 in
let rbegin = (match kind with Result -> off | _ -> on) in
let rend = (match kind with Argument -> on | _ -> off) in
if i.iend = 0 then begin
i.ibegin <- rbegin;
i.reg <- reg;
i.ranges <- [{rbegin = rbegin; rend = rend}]
end else begin
let r = List.hd i.ranges in
let ridx = r.rend asr 1 in
if pos - ridx <= 1 then
r.rend <- rend
else
i.ranges <- {rbegin = rbegin; rend = rend} :: i.ranges
end;
i.iend <- rend
let update_interval_position_by_array intervals regs pos kind =
Array.iter (update_interval_position intervals pos kind) regs
let update_interval_position_by_set intervals regs pos kind =
Set.iter (update_interval_position intervals pos kind) regs
let update_interval_position_by_instr intervals instr pos =
update_interval_position_by_array intervals instr.arg pos Argument;
update_interval_position_by_array intervals instr.res pos Result;
update_interval_position_by_set intervals instr.live pos Live
let insert_destroyed_at_oper intervals instr pos =
let destroyed = Proc.destroyed_at_oper instr.desc in
if Array.length destroyed > 0 then
update_interval_position_by_array intervals destroyed pos Result
let insert_destroyed_at_raise intervals pos =
let destroyed = Proc.destroyed_at_raise in
if Array.length destroyed > 0 then
update_interval_position_by_array intervals destroyed pos Result
(* Build all intervals.
The intervals will be expanded by one step at the start and end
of a basic block. *)
let build_intervals fd =
let intervals = Array.init
(Reg.num_registers())
(fun _ -> {
reg = Reg.dummy;
ibegin = 0;
iend = 0;
ranges = []; }) in
let pos = ref 0 in
let rec walk_instruction i =
incr pos;
update_interval_position_by_instr intervals i !pos;
begin match i.desc with
Iend -> ()
| Iop(Icall_ind | Icall_imm _ | Iextcall{alloc = true; _}
| Itailcall_ind | Itailcall_imm _) ->
walk_instruction i.next
| Iop _ ->
insert_destroyed_at_oper intervals i !pos;
walk_instruction i.next
| Ireturn ->
insert_destroyed_at_oper intervals i !pos;
walk_instruction i.next
| Iifthenelse(_, ifso, ifnot) ->
insert_destroyed_at_oper intervals i !pos;
walk_instruction ifso;
walk_instruction ifnot;
walk_instruction i.next
| Iswitch(_, cases) ->
insert_destroyed_at_oper intervals i !pos;
Array.iter walk_instruction cases;
walk_instruction i.next
| Icatch(_, handlers, body) ->
insert_destroyed_at_oper intervals i !pos;
List.iter (fun (_, i) -> walk_instruction i) handlers;
walk_instruction body;
walk_instruction i.next
| Iexit _ ->
insert_destroyed_at_oper intervals i !pos;
walk_instruction i.next
| Itrywith(body, handler) ->
insert_destroyed_at_oper intervals i !pos;
walk_instruction body;
insert_destroyed_at_raise intervals !pos;
walk_instruction handler;
walk_instruction i.next
| Iraise _ ->
walk_instruction i.next
end in
walk_instruction fd.fun_body;
(* Generate the interval and fixed interval lists *)
let interval_list = ref [] in
let fixed_intervals = ref [] in
Array.iter
(fun i ->
if i.iend != 0 then begin
i.ranges <- List.rev i.ranges;
begin match i.reg.loc with
Reg _ ->
fixed_intervals := i :: !fixed_intervals
| _ ->
interval_list := i :: !interval_list
end
end)
intervals;
{
fixed_intervals = !fixed_intervals;
intervals = List.sort (fun i0 i1 -> i0.ibegin - i1.ibegin) !interval_list;
(* Sort the intervals according to their start position *)
}
|
