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

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

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

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

77  
78 
(** We iterate in the order, recording simple local assigns in an accumulator 
79 
1. each expression is rewritten according to the accumulator 
80 
2. local assigns then rewrite occurrences of the lhs in the computed accumulator 
81 
*) 
82 
let optimize_minstrs outputs instrs = 
83 
let rev_instrs, eliminate = 
84 
List.fold_left (fun (rinstrs, elim) 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 
let remove, elim = update_elim outputs elim instr in 
91 
(if remove then rinstrs else instr::rinstrs), elim 
92 
) ([],[]) instrs 
93 
in 
94 
let eliminated_vars = List.map fst eliminate in 
95 
eliminated_vars, List.rev rev_instrs 
96  
97 
(** Perform optimization on machine code: 
98 
 iterate through step instructions and remove simple local assigns 
99 

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

115  
116  
117 
let optimize_machines machines = 
118 
List.map optimize_machine machines 
119  
120 
(* variable substitution for optimizing purposes *) 
121  
122 
(* checks whether an [instr] is skip and can be removed from program *) 
123 
let rec instr_is_skip instr = 
124 
match instr with 
125 
 MLocalAssign (i, LocalVar v) when i = v > true 
126 
 MStateAssign (i, StateVar v) when i = v > true 
127 
 MBranch (g, hl) > List.for_all (fun (_, il) > instrs_are_skip il) hl 
128 
 _ > false 
129 
and instrs_are_skip instrs = 
130 
List.for_all instr_is_skip instrs 
131  
132 
let instr_cons instr cont = 
133 
if instr_is_skip instr then cont else instr::cont 
134  
135 
let rec instr_remove_skip instr cont = 
136 
match instr with 
137 
 MLocalAssign (i, LocalVar v) when i = v > cont 
138 
 MStateAssign (i, StateVar v) when i = v > cont 
139 
 MBranch (g, hl) > MBranch (g, List.map (fun (h, il) > (h, instrs_remove_skip il [])) hl) :: cont 
140 
 _ > instr::cont 
141  
142 
and instrs_remove_skip instrs cont = 
143 
List.fold_right instr_remove_skip instrs cont 
144  
145 
let rec value_replace_var fvar value = 
146 
match value with 
147 
 Cst c > value 
148 
 LocalVar v > LocalVar (fvar v) 
149 
 StateVar v > value 
150 
 Fun (id, args) > Fun (id, List.map (value_replace_var fvar) args) 
151 
 Array vl > Array (List.map (value_replace_var fvar) vl) 
152 
 Access (t, i) > Access(value_replace_var fvar t, i) 
153 
 Power (v, n) > Power(value_replace_var fvar v, n) 
154  
155 
let rec instr_replace_var fvar instr cont = 
156 
match instr with 
157 
 MLocalAssign (i, v) > instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont 
158 
 MStateAssign (i, v) > instr_cons (MStateAssign (i, value_replace_var fvar v)) cont 
159 
 MReset i > instr_cons instr cont 
160 
 MStep (il, i, vl) > instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont 
161 
 MBranch (g, hl) > instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) > (h, instrs_replace_var fvar il [])) hl)) cont 
162  
163 
and instrs_replace_var fvar instrs cont = 
164 
List.fold_right (instr_replace_var fvar) instrs cont 
165  
166 
let step_replace_var fvar step = 
167 
(* Some outputs may have been replaced by locals. 
168 
We then need to rename those outputs 
169 
without changing their clocks, etc *) 
170 
let outputs' = 
171 
List.map (fun o > { o with var_id = (fvar o).var_id }) step.step_outputs in 
172 
let locals' = 
173 
List.fold_left (fun res l > 
174 
let l' = fvar l in 
175 
if List.exists (fun o > o.var_id = l'.var_id) outputs' 
176 
then res 
177 
else Utils.add_cons l' res) 
178 
[] step.step_locals in 
179 
{ step with 
180 
step_checks = List.map (fun (l, v) > (l, value_replace_var fvar v)) step.step_checks; 
181 
step_outputs = outputs'; 
182 
step_locals = locals'; 
183 
step_instrs = instrs_replace_var fvar step.step_instrs []; 
184 
} 
185  
186 
let rec machine_replace_variables fvar m = 
187 
{ m with 
188 
mstep = step_replace_var fvar m.mstep 
189 
} 
190  
191 
let machine_reuse_variables m reuse = 
192 
let fvar v = 
193 
try 
194 
Hashtbl.find reuse v.var_id 
195 
with Not_found > v in 
196 
machine_replace_variables fvar m 
197  
198 
let machines_reuse_variables prog node_schs = 
199 
List.map 
200 
(fun m > 
201 
machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table 
202 
) prog 
203  
204  
205 
(* Local Variables: *) 
206 
(* compilecommand:"make C .." *) 
207 
(* End: *) 