lustrec / src / optimize_machine.ml @ 307aba8d
History  View  Annotate  Download (10.9 KB)
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 
(* compilecommand:"make C .." *) 
296 
(* End: *) 