blob: 7e717fc7db35a4adbab7a327074ef2e8a0e49e96 (
plain) (
blame)
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
|
open Xi_lib
open Xi_lib.Measure
open Ir
let logf fmt = Logger.make_logf __MODULE__ fmt
module Make(Toolbox:Iface.COMPILER_TOOLBOX) = struct
module Implementation(M:sig
val cfg: ControlFlowGraph.t
val proc: procedure
end) = struct
open M
module Coalescencing = Toolbox.RegisterCoalescing
(* Dostępne rejestry *)
let available_registers = Toolbox.RegistersDescription.available_registers
(* Liczba dostępnych kolorów *)
let number_of_available_registers = List.length available_registers
(* ------------------------------------------------------------------------
* Hashtablice z kolorami
*)
(* wstępnie pokolorowane wierzchołki *)
let base_register2color_assignment : (reg, int) Hashtbl.t = Hashtbl.create 13
(* kolory wierzchołków *)
let register2color_assignment : (reg, int) Hashtbl.t = Hashtbl.create 13
(* pomocnicza tablica -- odwzorowuje kolor na rejestr sprzętowy *)
let color2register_assignment : (int, reg) Hashtbl.t = Hashtbl.create 13
(* ------------------------------------------------------------------------
* Wstępne kolorowanie
*)
let initialize_colors () =
let color i hard =
Hashtbl.replace color2register_assignment i hard;
Hashtbl.replace base_register2color_assignment hard i;
in
List.iteri color available_registers
(* ------------------------------------------------------------------------
* Budowanie grafu interferencji
*)
let build_infg () =
logf "building interference graph";
let lva = Toolbox.LiveVariablesAnalysis.analyse cfg in
Logger.extra_debug begin fun () ->
Logger.dump_live_variables "before-inf-build" cfg lva;
end;
let infg = Toolbox.InterferenceGraphAnalysis.analyse cfg lva in
Logger.extra_debug begin fun () ->
Logger.dump_interference_graph "before-simplify" infg
end;
infg
(* ------------------------------------------------------------------------
* Pomocnicze funkcje
*)
let loop name f =
let rec iter i =
logf "Starting iteration %s %u" name i;
let r, should_restart = measure "iteration" f in
if should_restart then
iter (succ i)
else
r
in
iter 0
(* ------------------------------------------------------------------------
* Spilling
*)
let compute_spill_costs infg =
Logger.extra_debug begin fun () ->
logf "Computing dominators"
end;
let dom = Toolbox.DominatorsAnalysis.analyse cfg in
Logger.extra_debug begin fun () ->
logf "Computing natural-loops"
end;
let nloops = Toolbox.NaturalLoopsAnalysis.analyse cfg dom in
Logger.extra_debug begin fun () ->
logf "Computing spill-costs"
end;
let spill_costs = Toolbox.SpillCostsAnalysis.analyse cfg nloops in
Logger.extra_debug begin fun () ->
Logger.dump_spill_costs spill_costs;
end;
spill_costs
let spill actual_spills =
measure "spill" (fun () -> Toolbox.Spilling.spill proc actual_spills);
actual_spills <> []
(* ------------------------------------------------------------------------
* Faza simplify
*)
let simplify =
failwith "not yet implemented"
(* ------------------------------------------------------------------------
* Faza Select
*)
let select =
failwith "not yet implemented"
(* ------------------------------------------------------------------------
* Pętla build-coalesce
*)
let build_coalescence () =
let infg = measure "build" (fun () -> build_infg ()) in
let changed = measure "coalescence" (fun () -> Coalescencing.coalesce proc infg available_registers) in
infg, changed
let build_coalescence_loop () =
loop "build-coalescence" build_coalescence
(* ------------------------------------------------------------------------
* Pętla build-coalesce
*)
let single_pass () =
let init () = begin
(* resetujemy robocze tablice *)
Hashtbl.reset register2color_assignment;
Hashtbl.replace_seq register2color_assignment @@ Hashtbl.to_seq base_register2color_assignment;
end in
Logger.extra_debug begin fun () ->
Logger.dump_ir_proc "begin-loop" proc
end;
let init = measure "init" init in
let infg = measure "build-coalescence " build_coalescence_loop in
let spill_costs = measure "spillcosts" (fun () -> compute_spill_costs infg) in
(* uruchom fazę simplify/select/spill *)
(* unit na potrzeby interfejsu pomocniczej funkcji loop *)
(), true
(* ------------------------------------------------------------------------
* Budowanie mapowania rejestrów
*)
let build_register_assignment () =
let register_assignment : (reg, reg) Hashtbl.t = Hashtbl.create 513 in
failwith "not yet implemented";
(* Przejdz tablice register2color_assignment i uzupełnij prawidłowo
* tablicę register_assignment *)
register_assignment
(* ------------------------------------------------------------------------
* Main
*)
let regalloc () =
logf "Starting register-allocation";
initialize_colors ();
loop "main-loop" single_pass;
build_register_assignment ()
end
let regalloc proc =
let module Instance = Implementation(struct
let cfg = cfg_of_procedure proc
let proc = proc
let available_registers = Toolbox.RegistersDescription.available_registers
end)
in
Instance.regalloc ()
end
|
