Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ 01d48bb0

History | View | Annotate | Download (11.6 KB)

1 b38ffff3 ploc
(********************************************************************)
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 307aba8d xthirioux
open Utils
13 3ab9437b ploc
open LustreSpec 
14
open Corelang
15 6aeb3388 xthirioux
open Causality
16 3ab9437b ploc
open Machine_code 
17 01d48bb0 xthirioux
open Dimension
18 3ab9437b ploc
19 307aba8d xthirioux
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 3ab9437b ploc
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 307aba8d xthirioux
  | LocalVar v -> (try IMap.find v.var_id elim with Not_found -> expr)
45 3ab9437b ploc
  | 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 307aba8d xthirioux
  | Power(v1, v2) -> Power(eliminate_expr elim v1, eliminate_expr elim v2)
49 3ab9437b ploc
  | Cst _ | StateVar _ -> expr
50
51 01d48bb0 xthirioux
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 307aba8d xthirioux
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 3ab9437b ploc
(* see if elim has to take in account the provided instr:
84 6a1a01d2 xthirioux
   if so, update elim and return the remove flag,
85 3ab9437b ploc
   otherwise, the expression should be kept and elim is left untouched *)
86 307aba8d xthirioux
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 7a6b5deb ploc
(*  Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*)
100 3ab9437b ploc
  match instr with
101
  (* Simple cases*)
102 307aba8d xthirioux
  | 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 3ab9437b ploc
    (* 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 01d48bb0 xthirioux
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 3ab9437b ploc
(** Perform optimization on machine code:
131
    - iterate through step instructions and remove simple local assigns
132
    
133
*)
134 307aba8d xthirioux
let machine_unfold fanin elim machine =
135
  (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)
136 01d48bb0 xthirioux
  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 3ab9437b ploc
  in
142
  {
143
    machine with
144
      mstep = { 
145
	machine.mstep with 
146 01d48bb0 xthirioux
	  step_locals = locals;
147
	  step_instrs = instrs
148
      };
149
      mconst = mconst;
150
      minstances = minstances;
151
      mcalls = mcalls;
152 3ab9437b ploc
  }
153
154 307aba8d xthirioux
let instr_of_const top_const =
155
  let const = const_of_top top_const in
156 01d48bb0 xthirioux
  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 307aba8d xthirioux
  let vdecl = { vdecl with var_type = const.const_type }
158
  in MLocalAssign (vdecl, Cst const.const_value)
159 3ab9437b ploc
160 307aba8d xthirioux
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 3ab9437b ploc
168 01f1a1f4 xthirioux
(* 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 6aeb3388 xthirioux
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 3ab9437b ploc
311
(* Local Variables: *)
312
(* compile-command:"make -C .." *)
313
(* End: *)