lustrec / src / optimize_machine.ml @ b1655a21
History  View  Annotate  Download (9.72 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 LustreSpec 
13 
open Corelang 
14 
open Causality 
15 
open Machine_code 
16  
17 
let rec eliminate elim instr = 
18 
let e_expr = eliminate_expr elim in 
19 
match instr with 
20 
 MLocalAssign (i,v) > MLocalAssign (i, e_expr v) 
21 
 MStateAssign (i,v) > MStateAssign (i, e_expr v) 
22 
 MReset i > instr 
23 
 MStep (il, i, vl) > MStep(il, i, List.map e_expr vl) 
24 
 MBranch (g,hl) > 
25 
MBranch 
26 
(e_expr g, 
27 
(List.map 
28 
(fun (l, il) > l, List.map (eliminate elim) il) 
29 
hl 
30 
) 
31 
) 
32 

33 
and eliminate_expr elim expr = 
34 
match expr with 
35 
 LocalVar v > if List.mem_assoc v elim then List.assoc v elim else expr 
36 
 Fun (id, vl) > Fun (id, List.map (eliminate_expr elim) vl) 
37 
 Array(vl) > Array(List.map (eliminate_expr elim) vl) 
38 
 Access(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2) 
39 
 Power(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2) 
40 
 Cst _  StateVar _ > expr 
41  
42 
(* see if elim has to take in account the provided instr: 
43 
if so, upodate elim and return the remove flag, 
44 
otherwise, the expression should be kept and elim is left untouched *) 
45 
let update_elim outputs elim instr = 
46 
(* Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*) 
47 

48 
let apply elim v new_e = 
49 
(v, new_e)::List.map (fun (v, e) > v, eliminate_expr [v, new_e] e) elim 
50 
in 
51 
match instr with 
52 
(* Simple cases*) 
53 
 MLocalAssign (v, (Cst _ as e)) 
54 
 MLocalAssign (v, (LocalVar _ as e)) 
55 
 MLocalAssign (v, (StateVar _ as e)) > 
56 
if not (List.mem v outputs) then true, apply elim v e else false, elim 
57 
(* When optimization >= 3, we also inline any basic operator call. 
58 
All those are returning a single ouput *) 
59 
 MStep([v], id, vl) when 
60 
Basic_library.is_internal_fun id 
61 
&& !Options.optimization >= 3 
62 
> assert false 
63 
(* true, apply elim v (Fun(id, vl))*) 
64  
65 

66 
 MLocalAssign (v, ((Fun (id, il)) as e)) when 
67 
not (List.mem v outputs) 
68 
&& Basic_library.is_internal_fun id (* this will avoid inlining ite *) 
69 
&& !Options.optimization >= 3 
70 
> ( 
71 
(* Format.eprintf "WE STORE THE EXPRESSION DEFINING %s TO ELIMINATE IT@." v.var_id; *) 
72 
true, apply elim v e 
73 
) 
74 
 _ > 
75 
(* default case, we keep the instruction and do not modify elim *) 
76 
false, elim 
77 

78  
79 
(** We iterate in the order, recording simple local assigns in an accumulator 
80 
1. each expression is rewritten according to the accumulator 
81 
2. local assigns then rewrite occurrences of the lhs in the computed accumulator 
82 
*) 
83 
let optimize_minstrs outputs instrs = 
84 
let rev_instrs, eliminate = 
85 
List.fold_left (fun (rinstrs, elim) instr > 
86 
(* each subexpression in instr that could be rewritten by the elim set is 
87 
rewritten *) 
88 
let instr = eliminate elim instr in 
89 
(* if instr is a simple local assign, then (a) elim is simplified with it (b) it 
90 
is stored as the elim set *) 
91 
let remove, elim = update_elim outputs elim instr in 
92 
(if remove then rinstrs else instr::rinstrs), elim 
93 
) ([],[]) instrs 
94 
in 
95 
let eliminated_vars = List.map fst eliminate in 
96 
eliminated_vars, List.rev rev_instrs 
97  
98 
(** Perform optimization on machine code: 
99 
 iterate through step instructions and remove simple local assigns 
100 

101 
*) 
102 
let optimize_machine machine = 
103 
let eliminated_vars, new_instrs = optimize_minstrs machine.mstep.step_outputs machine.mstep.step_instrs in 
104 
let new_locals = 
105 
List.filter (fun v > not (List.mem v eliminated_vars)) machine.mstep.step_locals 
106 
in 
107 
{ 
108 
machine with 
109 
mstep = { 
110 
machine.mstep with 
111 
step_locals = new_locals; 
112 
step_instrs = new_instrs 
113 
} 
114 
} 
115 

116  
117  
118 
let optimize_machines machines = 
119 
List.map optimize_machine machines 
120  
121 
(* variable substitution for optimizing purposes *) 
122  
123 
(* checks whether an [instr] is skip and can be removed from program *) 
124 
let rec instr_is_skip instr = 
125 
match instr with 
126 
 MLocalAssign (i, LocalVar v) when i = v > true 
127 
 MStateAssign (i, StateVar v) when i = v > true 
128 
 MBranch (g, hl) > List.for_all (fun (_, il) > instrs_are_skip il) hl 
129 
 _ > false 
130 
and instrs_are_skip instrs = 
131 
List.for_all instr_is_skip instrs 
132  
133 
let instr_cons instr cont = 
134 
if instr_is_skip instr then cont else instr::cont 
135  
136 
let rec instr_remove_skip instr cont = 
137 
match instr with 
138 
 MLocalAssign (i, LocalVar v) when i = v > cont 
139 
 MStateAssign (i, StateVar v) when i = v > cont 
140 
 MBranch (g, hl) > MBranch (g, List.map (fun (h, il) > (h, instrs_remove_skip il [])) hl) :: cont 
141 
 _ > instr::cont 
142  
143 
and instrs_remove_skip instrs cont = 
144 
List.fold_right instr_remove_skip instrs cont 
145  
146 
let rec value_replace_var fvar value = 
147 
match value with 
148 
 Cst c > value 
149 
 LocalVar v > LocalVar (fvar v) 
150 
 StateVar v > value 
151 
 Fun (id, args) > Fun (id, List.map (value_replace_var fvar) args) 
152 
 Array vl > Array (List.map (value_replace_var fvar) vl) 
153 
 Access (t, i) > Access(value_replace_var fvar t, i) 
154 
 Power (v, n) > Power(value_replace_var fvar v, n) 
155  
156 
let rec instr_replace_var fvar instr cont = 
157 
match instr with 
158 
 MLocalAssign (i, v) > instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont 
159 
 MStateAssign (i, v) > instr_cons (MStateAssign (i, value_replace_var fvar v)) cont 
160 
 MReset i > instr_cons instr cont 
161 
 MStep (il, i, vl) > instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont 
162 
 MBranch (g, hl) > instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) > (h, instrs_replace_var fvar il [])) hl)) cont 
163  
164 
and instrs_replace_var fvar instrs cont = 
165 
List.fold_right (instr_replace_var fvar) instrs cont 
166  
167 
let step_replace_var fvar step = 
168 
(* Some outputs may have been replaced by locals. 
169 
We then need to rename those outputs 
170 
without changing their clocks, etc *) 
171 
let outputs' = 
172 
List.map (fun o > { o with var_id = (fvar o).var_id }) step.step_outputs in 
173 
let locals' = 
174 
List.fold_left (fun res l > 
175 
let l' = fvar l in 
176 
if List.exists (fun o > o.var_id = l'.var_id) outputs' 
177 
then res 
178 
else Utils.add_cons l' res) 
179 
[] step.step_locals in 
180 
{ step with 
181 
step_checks = List.map (fun (l, v) > (l, value_replace_var fvar v)) step.step_checks; 
182 
step_outputs = outputs'; 
183 
step_locals = locals'; 
184 
step_instrs = instrs_replace_var fvar step.step_instrs []; 
185 
} 
186  
187 
let rec machine_replace_variables fvar m = 
188 
{ m with 
189 
mstep = step_replace_var fvar m.mstep 
190 
} 
191  
192 
let machine_reuse_variables m reuse = 
193 
let fvar v = 
194 
try 
195 
Hashtbl.find reuse v.var_id 
196 
with Not_found > v in 
197 
machine_replace_variables fvar m 
198  
199 
let machines_reuse_variables prog node_schs = 
200 
List.map 
201 
(fun m > 
202 
machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table 
203 
) prog 
204  
205 
let rec instr_assign res instr = 
206 
match instr with 
207 
 MLocalAssign (i, _) > Disjunction.CISet.add i res 
208 
 MStateAssign (i, _) > Disjunction.CISet.add i res 
209 
 MBranch (g, hl) > List.fold_left (fun res (h, b) > instrs_assign res b) res hl 
210 
 MStep (il, _, _) > List.fold_right Disjunction.CISet.add il res 
211 
 _ > res 
212  
213 
and instrs_assign res instrs = 
214 
List.fold_left instr_assign res instrs 
215  
216 
let rec instr_constant_assign var instr = 
217 
match instr with 
218 
 MLocalAssign (i, Cst (Const_tag _)) 
219 
 MStateAssign (i, Cst (Const_tag _)) > i = var 
220 
 MBranch (g, hl) > List.for_all (fun (h, b) > instrs_constant_assign var b) hl 
221 
 _ > false 
222  
223 
and instrs_constant_assign var instrs = 
224 
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 
225  
226 
let rec instr_reduce branches instr1 cont = 
227 
match instr1 with 
228 
 MLocalAssign (_, Cst (Const_tag c)) > instr1 :: (List.assoc c branches @ cont) 
229 
 MStateAssign (_, Cst (Const_tag c)) > instr1 :: (List.assoc c branches @ cont) 
230 
 MBranch (g, hl) > MBranch (g, List.map (fun (h, b) > (h, instrs_reduce branches b [])) hl) :: cont 
231 
 _ > instr1 :: cont 
232  
233 
and instrs_reduce branches instrs cont = 
234 
match instrs with 
235 
 [] > cont 
236 
 [i] > instr_reduce branches i cont 
237 
 i1::i2::q > i1 :: instrs_reduce branches (i2::q) cont 
238  
239 
let rec instrs_fusion instrs = 
240 
match instrs with 
241 
 [] 
242 
 [_] > 
243 
instrs 
244 
 i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 > 
245 
instr_reduce (List.map (fun (h, b) > h, instrs_fusion b) hl) i1 (instrs_fusion q) 
246 
 i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 > 
247 
instr_reduce (List.map (fun (h, b) > h, instrs_fusion b) hl) i1 (instrs_fusion q) 
248 
 i1::i2::q > 
249 
i1 :: instrs_fusion (i2::q) 
250  
251 
let step_fusion step = 
252 
{ step with 
253 
step_instrs = instrs_fusion step.step_instrs; 
254 
} 
255  
256 
let rec machine_fusion m = 
257 
{ m with 
258 
mstep = step_fusion m.mstep 
259 
} 
260  
261 
let machines_fusion prog = 
262 
List.map machine_fusion prog 
263  
264 
(* Local Variables: *) 
265 
(* compilecommand:"make C .." *) 
266 
(* End: *) 