Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ 6aeb3388

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
(* compile-command:"make -C .." *)
266
(* End: *)