1
|
(********************************************************************)
|
2
|
(* *)
|
3
|
(* The LustreC compiler toolset / The LustreC Development Team *)
|
4
|
(* Copyright 2012 - -- ONERA - CNRS - INPT *)
|
5
|
(* *)
|
6
|
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)
|
7
|
(* under the terms of the GNU Lesser General Public License *)
|
8
|
(* version 2.1. *)
|
9
|
(* *)
|
10
|
(********************************************************************)
|
11
|
|
12
|
open Utils
|
13
|
open LustreSpec
|
14
|
open Corelang
|
15
|
open Causality
|
16
|
open Machine_code
|
17
|
|
18
|
let pp_elim fmt elim =
|
19
|
begin
|
20
|
Format.fprintf fmt "{ /* elim table: */@.";
|
21
|
IMap.iter (fun v expr -> Format.fprintf fmt "%s |-> %a@." v pp_val expr) elim;
|
22
|
Format.fprintf fmt "}@.";
|
23
|
end
|
24
|
|
25
|
let rec eliminate elim instr =
|
26
|
let e_expr = eliminate_expr elim in
|
27
|
match instr with
|
28
|
| MLocalAssign (i,v) -> MLocalAssign (i, e_expr v)
|
29
|
| MStateAssign (i,v) -> MStateAssign (i, e_expr v)
|
30
|
| MReset i -> instr
|
31
|
| MStep (il, i, vl) -> MStep(il, i, List.map e_expr vl)
|
32
|
| MBranch (g,hl) ->
|
33
|
MBranch
|
34
|
(e_expr g,
|
35
|
(List.map
|
36
|
(fun (l, il) -> l, List.map (eliminate elim) il)
|
37
|
hl
|
38
|
)
|
39
|
)
|
40
|
|
41
|
and eliminate_expr elim expr =
|
42
|
match expr with
|
43
|
| LocalVar v -> (try IMap.find v.var_id elim with Not_found -> expr)
|
44
|
| Fun (id, vl) -> Fun (id, List.map (eliminate_expr elim) vl)
|
45
|
| Array(vl) -> Array(List.map (eliminate_expr elim) vl)
|
46
|
| Access(v1, v2) -> Access(eliminate_expr elim v1, eliminate_expr elim v2)
|
47
|
| Power(v1, v2) -> Power(eliminate_expr elim v1, eliminate_expr elim v2)
|
48
|
| Cst _ | StateVar _ -> expr
|
49
|
|
50
|
let is_scalar_const c =
|
51
|
match c with
|
52
|
| Const_int _
|
53
|
| Const_real _
|
54
|
| Const_float _
|
55
|
| Const_tag _ -> true
|
56
|
| _ -> false
|
57
|
|
58
|
let unfoldable_assign fanin v expr =
|
59
|
try
|
60
|
let d = Hashtbl.find fanin v.var_id
|
61
|
in match expr with
|
62
|
| Cst c when is_scalar_const c -> true
|
63
|
| Cst c when d < 2 -> true
|
64
|
| LocalVar _
|
65
|
| StateVar _ -> true
|
66
|
| Fun (id, _) when d < 2 && Basic_library.is_internal_fun id -> true
|
67
|
| _ -> false
|
68
|
with Not_found -> false
|
69
|
|
70
|
let merge_elim elim1 elim2 =
|
71
|
let merge k e1 e2 =
|
72
|
match e1, e2 with
|
73
|
| Some e1, Some e2 -> if e1 = e2 then Some e1 else None
|
74
|
| _ , Some e2 -> Some e2
|
75
|
| Some e1, _ -> Some e1
|
76
|
| _ -> None
|
77
|
in IMap.merge merge elim1 elim2
|
78
|
|
79
|
(* see if elim has to take in account the provided instr:
|
80
|
if so, update elim and return the remove flag,
|
81
|
otherwise, the expression should be kept and elim is left untouched *)
|
82
|
let rec instrs_unfold fanin elim instrs =
|
83
|
let elim, rev_instrs =
|
84
|
List.fold_left (fun (elim, instrs) instr ->
|
85
|
(* each subexpression in instr that could be rewritten by the elim set is
|
86
|
rewritten *)
|
87
|
let instr = eliminate elim instr in
|
88
|
(* if instr is a simple local assign, then (a) elim is simplified with it (b) it
|
89
|
is stored as the elim set *)
|
90
|
instr_unfold fanin instrs elim instr
|
91
|
) (elim, []) instrs
|
92
|
in elim, List.rev rev_instrs
|
93
|
|
94
|
and instr_unfold fanin instrs elim instr =
|
95
|
(* Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*)
|
96
|
match instr with
|
97
|
(* Simple cases*)
|
98
|
| MStep([v], id, vl) when Basic_library.is_internal_fun id
|
99
|
-> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl)))
|
100
|
| MLocalAssign(v, expr) when unfoldable_assign fanin v expr
|
101
|
-> (IMap.add v.var_id expr elim, instrs)
|
102
|
| MBranch(g, hl) when false
|
103
|
-> let elim_branches = List.map (fun (h, l) -> (h, instrs_unfold fanin elim l)) hl in
|
104
|
let (elim, branches) =
|
105
|
List.fold_right
|
106
|
(fun (h, (e, l)) (elim, branches) -> (merge_elim elim e, (h, l)::branches))
|
107
|
elim_branches (elim, [])
|
108
|
in elim, (MBranch (g, branches) :: instrs)
|
109
|
| _
|
110
|
-> (elim, instr :: instrs)
|
111
|
(* default case, we keep the instruction and do not modify elim *)
|
112
|
|
113
|
|
114
|
(** We iterate in the order, recording simple local assigns in an accumulator
|
115
|
1. each expression is rewritten according to the accumulator
|
116
|
2. local assigns then rewrite occurrences of the lhs in the computed accumulator
|
117
|
*)
|
118
|
|
119
|
(** Perform optimization on machine code:
|
120
|
- iterate through step instructions and remove simple local assigns
|
121
|
|
122
|
*)
|
123
|
let machine_unfold fanin elim machine =
|
124
|
(*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)
|
125
|
let eliminated_vars, new_instrs = instrs_unfold fanin elim machine.mstep.step_instrs in
|
126
|
let new_locals = List.filter (fun v -> not (IMap.mem v.var_id eliminated_vars)) machine.mstep.step_locals
|
127
|
in
|
128
|
{
|
129
|
machine with
|
130
|
mstep = {
|
131
|
machine.mstep with
|
132
|
step_locals = new_locals;
|
133
|
step_instrs = new_instrs
|
134
|
}
|
135
|
}
|
136
|
|
137
|
let instr_of_const top_const =
|
138
|
let const = const_of_top top_const in
|
139
|
let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true) in
|
140
|
let vdecl = { vdecl with var_type = const.const_type }
|
141
|
in MLocalAssign (vdecl, Cst const.const_value)
|
142
|
|
143
|
let machines_unfold consts node_schs machines =
|
144
|
List.map
|
145
|
(fun m ->
|
146
|
let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in
|
147
|
let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts)
|
148
|
in machine_unfold fanin elim_consts m)
|
149
|
machines
|
150
|
|
151
|
(* variable substitution for optimizing purposes *)
|
152
|
|
153
|
(* checks whether an [instr] is skip and can be removed from program *)
|
154
|
let rec instr_is_skip instr =
|
155
|
match instr with
|
156
|
| MLocalAssign (i, LocalVar v) when i = v -> true
|
157
|
| MStateAssign (i, StateVar v) when i = v -> true
|
158
|
| MBranch (g, hl) -> List.for_all (fun (_, il) -> instrs_are_skip il) hl
|
159
|
| _ -> false
|
160
|
and instrs_are_skip instrs =
|
161
|
List.for_all instr_is_skip instrs
|
162
|
|
163
|
let instr_cons instr cont =
|
164
|
if instr_is_skip instr then cont else instr::cont
|
165
|
|
166
|
let rec instr_remove_skip instr cont =
|
167
|
match instr with
|
168
|
| MLocalAssign (i, LocalVar v) when i = v -> cont
|
169
|
| MStateAssign (i, StateVar v) when i = v -> cont
|
170
|
| MBranch (g, hl) -> MBranch (g, List.map (fun (h, il) -> (h, instrs_remove_skip il [])) hl) :: cont
|
171
|
| _ -> instr::cont
|
172
|
|
173
|
and instrs_remove_skip instrs cont =
|
174
|
List.fold_right instr_remove_skip instrs cont
|
175
|
|
176
|
let rec value_replace_var fvar value =
|
177
|
match value with
|
178
|
| Cst c -> value
|
179
|
| LocalVar v -> LocalVar (fvar v)
|
180
|
| StateVar v -> value
|
181
|
| Fun (id, args) -> Fun (id, List.map (value_replace_var fvar) args)
|
182
|
| Array vl -> Array (List.map (value_replace_var fvar) vl)
|
183
|
| Access (t, i) -> Access(value_replace_var fvar t, i)
|
184
|
| Power (v, n) -> Power(value_replace_var fvar v, n)
|
185
|
|
186
|
let rec instr_replace_var fvar instr cont =
|
187
|
match instr with
|
188
|
| MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont
|
189
|
| MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont
|
190
|
| MReset i -> instr_cons instr cont
|
191
|
| MStep (il, i, vl) -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont
|
192
|
| MBranch (g, hl) -> instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il [])) hl)) cont
|
193
|
|
194
|
and instrs_replace_var fvar instrs cont =
|
195
|
List.fold_right (instr_replace_var fvar) instrs cont
|
196
|
|
197
|
let step_replace_var fvar step =
|
198
|
(* Some outputs may have been replaced by locals.
|
199
|
We then need to rename those outputs
|
200
|
without changing their clocks, etc *)
|
201
|
let outputs' =
|
202
|
List.map (fun o -> { o with var_id = (fvar o).var_id }) step.step_outputs in
|
203
|
let locals' =
|
204
|
List.fold_left (fun res l ->
|
205
|
let l' = fvar l in
|
206
|
if List.exists (fun o -> o.var_id = l'.var_id) outputs'
|
207
|
then res
|
208
|
else Utils.add_cons l' res)
|
209
|
[] step.step_locals in
|
210
|
{ step with
|
211
|
step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks;
|
212
|
step_outputs = outputs';
|
213
|
step_locals = locals';
|
214
|
step_instrs = instrs_replace_var fvar step.step_instrs [];
|
215
|
}
|
216
|
|
217
|
let rec machine_replace_variables fvar m =
|
218
|
{ m with
|
219
|
mstep = step_replace_var fvar m.mstep
|
220
|
}
|
221
|
|
222
|
let machine_reuse_variables m reuse =
|
223
|
let fvar v =
|
224
|
try
|
225
|
Hashtbl.find reuse v.var_id
|
226
|
with Not_found -> v in
|
227
|
machine_replace_variables fvar m
|
228
|
|
229
|
let machines_reuse_variables prog node_schs =
|
230
|
List.map
|
231
|
(fun m ->
|
232
|
machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table
|
233
|
) prog
|
234
|
|
235
|
let rec instr_assign res instr =
|
236
|
match instr with
|
237
|
| MLocalAssign (i, _) -> Disjunction.CISet.add i res
|
238
|
| MStateAssign (i, _) -> Disjunction.CISet.add i res
|
239
|
| MBranch (g, hl) -> List.fold_left (fun res (h, b) -> instrs_assign res b) res hl
|
240
|
| MStep (il, _, _) -> List.fold_right Disjunction.CISet.add il res
|
241
|
| _ -> res
|
242
|
|
243
|
and instrs_assign res instrs =
|
244
|
List.fold_left instr_assign res instrs
|
245
|
|
246
|
let rec instr_constant_assign var instr =
|
247
|
match instr with
|
248
|
| MLocalAssign (i, Cst (Const_tag _))
|
249
|
| MStateAssign (i, Cst (Const_tag _)) -> i = var
|
250
|
| MBranch (g, hl) -> List.for_all (fun (h, b) -> instrs_constant_assign var b) hl
|
251
|
| _ -> false
|
252
|
|
253
|
and instrs_constant_assign var instrs =
|
254
|
List.fold_left (fun res i -> if Disjunction.CISet.mem var (instr_assign Disjunction.CISet.empty i) then instr_constant_assign var i else res) false instrs
|
255
|
|
256
|
let rec instr_reduce branches instr1 cont =
|
257
|
match instr1 with
|
258
|
| MLocalAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
|
259
|
| MStateAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
|
260
|
| MBranch (g, hl) -> MBranch (g, List.map (fun (h, b) -> (h, instrs_reduce branches b [])) hl) :: cont
|
261
|
| _ -> instr1 :: cont
|
262
|
|
263
|
and instrs_reduce branches instrs cont =
|
264
|
match instrs with
|
265
|
| [] -> cont
|
266
|
| [i] -> instr_reduce branches i cont
|
267
|
| i1::i2::q -> i1 :: instrs_reduce branches (i2::q) cont
|
268
|
|
269
|
let rec instrs_fusion instrs =
|
270
|
match instrs with
|
271
|
| []
|
272
|
| [_] ->
|
273
|
instrs
|
274
|
| i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 ->
|
275
|
instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q)
|
276
|
| i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 ->
|
277
|
instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q)
|
278
|
| i1::i2::q ->
|
279
|
i1 :: instrs_fusion (i2::q)
|
280
|
|
281
|
let step_fusion step =
|
282
|
{ step with
|
283
|
step_instrs = instrs_fusion step.step_instrs;
|
284
|
}
|
285
|
|
286
|
let rec machine_fusion m =
|
287
|
{ m with
|
288
|
mstep = step_fusion m.mstep
|
289
|
}
|
290
|
|
291
|
let machines_fusion prog =
|
292
|
List.map machine_fusion prog
|
293
|
|
294
|
(* Local Variables: *)
|
295
|
(* compile-command:"make -C .." *)
|
296
|
(* End: *)
|