Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ 01d48bb0

History | View | Annotate | Download (11.6 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
open Dimension
18

    
19
let pp_elim fmt elim =
20
  begin
21
    Format.fprintf fmt "{ /* elim table: */@.";
22
    IMap.iter (fun v expr -> Format.fprintf fmt "%s |-> %a@." v pp_val expr) elim;
23
    Format.fprintf fmt "}@.";
24
  end
25

    
26
let rec eliminate elim instr =
27
  let e_expr = eliminate_expr elim in
28
  match instr with  
29
  | MLocalAssign (i,v) -> MLocalAssign (i, e_expr v)
30
  | MStateAssign (i,v) -> MStateAssign (i, e_expr v)
31
  | MReset i           -> instr
32
  | MStep (il, i, vl)  -> MStep(il, i, List.map e_expr vl)
33
  | MBranch (g,hl)     -> 
34
    MBranch
35
      (e_expr g, 
36
       (List.map 
37
	  (fun (l, il) -> l, List.map (eliminate elim) il) 
38
	  hl
39
       )
40
      )
41
    
42
and eliminate_expr elim expr =
43
  match expr with
44
  | LocalVar v -> (try IMap.find v.var_id elim with Not_found -> expr)
45
  | Fun (id, vl) -> Fun (id, List.map (eliminate_expr elim) vl)
46
  | Array(vl) -> Array(List.map (eliminate_expr elim) vl)
47
  | Access(v1, v2) -> Access(eliminate_expr elim v1, eliminate_expr elim v2)
48
  | Power(v1, v2) -> Power(eliminate_expr elim v1, eliminate_expr elim v2)
49
  | Cst _ | StateVar _ -> expr
50

    
51
let eliminate_dim elim dim =
52
  Dimension.expr_replace_expr (fun v -> try dimension_of_value (IMap.find v elim) with Not_found -> mkdim_ident dim.dim_loc v) dim
53

    
54
let is_scalar_const c =
55
  match c with
56
  | Const_int _
57
  | Const_real _
58
  | Const_float _
59
  | Const_tag _   -> true
60
  | _             -> false
61

    
62
let unfoldable_assign fanin v expr =
63
  try
64
    let d = Hashtbl.find fanin v.var_id
65
    in match expr with
66
    | Cst c when is_scalar_const c -> true
67
    | Cst c when d < 2             -> true
68
    | LocalVar _
69
    | StateVar _                   -> true
70
    | Fun (id, _) when d < 2 && Basic_library.is_internal_fun id -> true
71
    | _                                                          -> false
72
  with Not_found -> false
73

    
74
let merge_elim elim1 elim2 =
75
  let merge k e1 e2 =
76
    match e1, e2 with
77
    | Some e1, Some e2 -> if e1 = e2 then Some e1 else None
78
    | _      , Some e2 -> Some e2
79
    | Some e1, _       -> Some e1
80
    | _                -> None
81
  in IMap.merge merge elim1 elim2
82

    
83
(* see if elim has to take in account the provided instr:
84
   if so, update elim and return the remove flag,
85
   otherwise, the expression should be kept and elim is left untouched *)
86
let rec instrs_unfold fanin elim instrs =
87
  let elim, rev_instrs = 
88
    List.fold_left (fun (elim, instrs) instr ->
89
      (* each subexpression in instr that could be rewritten by the elim set is
90
	 rewritten *)
91
      let instr = eliminate elim instr in
92
      (* if instr is a simple local assign, then (a) elim is simplified with it (b) it
93
	 is stored as the elim set *)
94
      instr_unfold fanin instrs elim instr
95
    ) (elim, []) instrs
96
  in elim, List.rev rev_instrs
97

    
98
and instr_unfold fanin instrs elim instr =
99
(*  Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*)
100
  match instr with
101
  (* Simple cases*)
102
  | MStep([v], id, vl) when Basic_library.is_internal_fun id
103
    -> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl)))
104
  | MLocalAssign(v, expr) when unfoldable_assign fanin v expr
105
    -> (IMap.add v.var_id expr elim, instrs)
106
  | MBranch(g, hl) when false
107
    -> let elim_branches = List.map (fun (h, l) -> (h, instrs_unfold fanin elim l)) hl in
108
       let (elim, branches) =
109
	 List.fold_right
110
	   (fun (h, (e, l)) (elim, branches) -> (merge_elim elim e, (h, l)::branches))
111
	   elim_branches (elim, [])
112
       in elim, (MBranch (g, branches) :: instrs)
113
  | _
114
    -> (elim, instr :: instrs)
115
    (* default case, we keep the instruction and do not modify elim *)
116
  
117

    
118
(** We iterate in the order, recording simple local assigns in an accumulator
119
    1. each expression is rewritten according to the accumulator
120
    2. local assigns then rewrite occurrences of the lhs in the computed accumulator
121
*)
122

    
123
let static_call_unfold elim (inst, (n, args)) =
124
  let replace v =
125
    try
126
      Machine_code.dimension_of_value (IMap.find v elim)
127
    with Not_found -> Dimension.mkdim_ident Location.dummy_loc v
128
  in (inst, (n, List.map (Dimension.expr_replace_expr replace) args))
129

    
130
(** Perform optimization on machine code:
131
    - iterate through step instructions and remove simple local assigns
132
    
133
*)
134
let machine_unfold fanin elim machine =
135
  (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)
136
  let elim_consts, mconst = instrs_unfold fanin elim machine.mconst in
137
  let elim_vars, instrs = instrs_unfold fanin elim_consts machine.mstep.step_instrs in
138
  let locals = List.filter (fun v -> not (IMap.mem v.var_id elim_vars)) machine.mstep.step_locals in
139
  let minstances = List.map (static_call_unfold elim_consts) machine.minstances in
140
  let mcalls = List.map (static_call_unfold elim_consts) machine.mcalls
141
  in
142
  {
143
    machine with
144
      mstep = { 
145
	machine.mstep with 
146
	  step_locals = locals;
147
	  step_instrs = instrs
148
      };
149
      mconst = mconst;
150
      minstances = minstances;
151
      mcalls = mcalls;
152
  }
153

    
154
let instr_of_const top_const =
155
  let const = const_of_top top_const in
156
  let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true, None) in
157
  let vdecl = { vdecl with var_type = const.const_type }
158
  in MLocalAssign (vdecl, Cst const.const_value)
159

    
160
let machines_unfold consts node_schs machines =
161
  List.map
162
    (fun m ->
163
      let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in
164
      let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts)
165
      in machine_unfold fanin elim_consts m)
166
    machines
167

    
168
(* variable substitution for optimizing purposes *)
169

    
170
(* checks whether an [instr] is skip and can be removed from program *)
171
let rec instr_is_skip instr =
172
  match instr with
173
  | MLocalAssign (i, LocalVar v) when i = v -> true
174
  | MStateAssign (i, StateVar v) when i = v -> true
175
  | MBranch (g, hl) -> List.for_all (fun (_, il) -> instrs_are_skip il) hl
176
  | _               -> false
177
and instrs_are_skip instrs =
178
  List.for_all instr_is_skip instrs
179

    
180
let instr_cons instr cont =
181
 if instr_is_skip instr then cont else instr::cont
182

    
183
let rec instr_remove_skip instr cont =
184
  match instr with
185
  | MLocalAssign (i, LocalVar v) when i = v -> cont
186
  | MStateAssign (i, StateVar v) when i = v -> cont
187
  | MBranch (g, hl) -> MBranch (g, List.map (fun (h, il) -> (h, instrs_remove_skip il [])) hl) :: cont
188
  | _               -> instr::cont
189

    
190
and instrs_remove_skip instrs cont =
191
  List.fold_right instr_remove_skip instrs cont
192

    
193
let rec value_replace_var fvar value =
194
  match value with
195
  | Cst c -> value
196
  | LocalVar v -> LocalVar (fvar v)
197
  | StateVar v -> value
198
  | Fun (id, args) -> Fun (id, List.map (value_replace_var fvar) args) 
199
  | Array vl -> Array (List.map (value_replace_var fvar) vl)
200
  | Access (t, i) -> Access(value_replace_var fvar t, i)
201
  | Power (v, n) -> Power(value_replace_var fvar v, n)
202

    
203
let rec instr_replace_var fvar instr cont =
204
  match instr with
205
  | MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont
206
  | MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont
207
  | MReset i            -> instr_cons instr cont
208
  | MStep (il, i, vl)   -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont
209
  | MBranch (g, hl)     -> instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il [])) hl)) cont
210

    
211
and instrs_replace_var fvar instrs cont =
212
  List.fold_right (instr_replace_var fvar) instrs cont
213

    
214
let step_replace_var fvar step =
215
  (* Some outputs may have been replaced by locals.
216
     We then need to rename those outputs
217
     without changing their clocks, etc *)
218
  let outputs' =
219
    List.map (fun o -> { o with var_id = (fvar o).var_id }) step.step_outputs in
220
  let locals'  =
221
    List.fold_left (fun res l ->
222
      let l' = fvar l in
223
      if List.exists (fun o -> o.var_id = l'.var_id) outputs'
224
      then res
225
      else Utils.add_cons l' res)
226
      [] step.step_locals in
227
  { step with
228
    step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks;
229
    step_outputs = outputs';
230
    step_locals = locals';
231
    step_instrs = instrs_replace_var fvar step.step_instrs [];
232
}
233

    
234
let rec machine_replace_variables fvar m =
235
  { m with
236
    mstep = step_replace_var fvar m.mstep
237
  }
238

    
239
let machine_reuse_variables m reuse =
240
  let fvar v =
241
    try
242
      Hashtbl.find reuse v.var_id
243
    with Not_found -> v in
244
  machine_replace_variables fvar m
245

    
246
let machines_reuse_variables prog node_schs =
247
  List.map 
248
    (fun m -> 
249
      machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table
250
    ) prog
251

    
252
let rec instr_assign res instr =
253
  match instr with
254
  | MLocalAssign (i, _) -> Disjunction.CISet.add i res
255
  | MStateAssign (i, _) -> Disjunction.CISet.add i res
256
  | MBranch (g, hl)     -> List.fold_left (fun res (h, b) -> instrs_assign res b) res hl
257
  | MStep (il, _, _)    -> List.fold_right Disjunction.CISet.add il res
258
  | _                   -> res
259

    
260
and instrs_assign res instrs =
261
  List.fold_left instr_assign res instrs
262

    
263
let rec instr_constant_assign var instr =
264
  match instr with
265
  | MLocalAssign (i, Cst (Const_tag _))
266
  | MStateAssign (i, Cst (Const_tag _)) -> i = var
267
  | MBranch (g, hl)                     -> List.for_all (fun (h, b) -> instrs_constant_assign var b) hl
268
  | _                                   -> false
269

    
270
and instrs_constant_assign var instrs =
271
  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
272

    
273
let rec instr_reduce branches instr1 cont =
274
  match instr1 with
275
  | MLocalAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
276
  | MStateAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
277
  | MBranch (g, hl)                     -> MBranch (g, List.map (fun (h, b) -> (h, instrs_reduce branches b [])) hl) :: cont
278
  | _                                   -> instr1 :: cont
279

    
280
and instrs_reduce branches instrs cont =
281
 match instrs with
282
 | []        -> cont
283
 | [i]       -> instr_reduce branches i cont
284
 | i1::i2::q -> i1 :: instrs_reduce branches (i2::q) cont
285

    
286
let rec instrs_fusion instrs =
287
  match instrs with
288
  | []
289
  | [_]                                                               ->
290
    instrs
291
  | i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 ->
292
    instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q)
293
  | i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 ->
294
    instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q) 
295
  | i1::i2::q                                                         ->
296
    i1 :: instrs_fusion (i2::q)
297

    
298
let step_fusion step =
299
  { step with
300
    step_instrs = instrs_fusion step.step_instrs;
301
  }
302

    
303
let rec machine_fusion m =
304
  { m with
305
    mstep = step_fusion m.mstep
306
  }
307

    
308
let machines_fusion prog =
309
  List.map machine_fusion prog
310

    
311
(* Local Variables: *)
312
(* compile-command:"make -C .." *)
313
(* End: *)