Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ ba2f9fa1

History | View | Annotate | Download (10.9 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
18 307aba8d xthirioux
let pp_elim fmt elim =
19
  begin
20
    Format.fprintf fmt "{ /* elim table: */@.";
21
    IMap.iter (fun v expr -> Format.fprintf fmt "%s |-> %a@." v pp_val expr) elim;
22
    Format.fprintf fmt "}@.";
23
  end
24
25 3ab9437b ploc
let rec eliminate elim instr =
26
  let e_expr = eliminate_expr elim in
27
  match instr with  
28
  | MLocalAssign (i,v) -> MLocalAssign (i, e_expr v)
29
  | MStateAssign (i,v) -> MStateAssign (i, e_expr v)
30
  | MReset i           -> instr
31
  | MStep (il, i, vl)  -> MStep(il, i, List.map e_expr vl)
32
  | MBranch (g,hl)     -> 
33
    MBranch
34
      (e_expr g, 
35
       (List.map 
36
	  (fun (l, il) -> l, List.map (eliminate elim) il) 
37
	  hl
38
       )
39
      )
40
    
41
and eliminate_expr elim expr =
42
  match expr with
43 307aba8d xthirioux
  | LocalVar v -> (try IMap.find v.var_id elim with Not_found -> expr)
44 3ab9437b ploc
  | Fun (id, vl) -> Fun (id, List.map (eliminate_expr elim) vl)
45
  | Array(vl) -> Array(List.map (eliminate_expr elim) vl)
46
  | Access(v1, v2) -> Access(eliminate_expr elim v1, eliminate_expr elim v2)
47 307aba8d xthirioux
  | Power(v1, v2) -> Power(eliminate_expr elim v1, eliminate_expr elim v2)
48 3ab9437b ploc
  | Cst _ | StateVar _ -> expr
49
50 307aba8d xthirioux
let is_scalar_const c =
51
  match c with
52
  | Const_int _
53
  | Const_real _
54
  | Const_float _
55
  | Const_tag _   -> true
56
  | _             -> false
57
58
let unfoldable_assign fanin v expr =
59
  try
60
    let d = Hashtbl.find fanin v.var_id
61
    in match expr with
62
    | Cst c when is_scalar_const c -> true
63
    | Cst c when d < 2             -> true
64
    | LocalVar _
65
    | StateVar _                   -> true
66
    | Fun (id, _) when d < 2 && Basic_library.is_internal_fun id -> true
67
    | _                                                          -> false
68
  with Not_found -> false
69
70
let merge_elim elim1 elim2 =
71
  let merge k e1 e2 =
72
    match e1, e2 with
73
    | Some e1, Some e2 -> if e1 = e2 then Some e1 else None
74
    | _      , Some e2 -> Some e2
75
    | Some e1, _       -> Some e1
76
    | _                -> None
77
  in IMap.merge merge elim1 elim2
78
79 3ab9437b ploc
(* see if elim has to take in account the provided instr:
80 6a1a01d2 xthirioux
   if so, update elim and return the remove flag,
81 3ab9437b ploc
   otherwise, the expression should be kept and elim is left untouched *)
82 307aba8d xthirioux
let rec instrs_unfold fanin elim instrs =
83
  let elim, rev_instrs = 
84
    List.fold_left (fun (elim, instrs) 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
      instr_unfold fanin instrs elim instr
91
    ) (elim, []) instrs
92
  in elim, List.rev rev_instrs
93
94
and instr_unfold fanin instrs elim instr =
95 7a6b5deb ploc
(*  Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*)
96 3ab9437b ploc
  match instr with
97
  (* Simple cases*)
98 307aba8d xthirioux
  | MStep([v], id, vl) when Basic_library.is_internal_fun id
99
    -> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl)))
100
  | MLocalAssign(v, expr) when unfoldable_assign fanin v expr
101
    -> (IMap.add v.var_id expr elim, instrs)
102
  | MBranch(g, hl) when false
103
    -> let elim_branches = List.map (fun (h, l) -> (h, instrs_unfold fanin elim l)) hl in
104
       let (elim, branches) =
105
	 List.fold_right
106
	   (fun (h, (e, l)) (elim, branches) -> (merge_elim elim e, (h, l)::branches))
107
	   elim_branches (elim, [])
108
       in elim, (MBranch (g, branches) :: instrs)
109
  | _
110
    -> (elim, instr :: instrs)
111 3ab9437b ploc
    (* default case, we keep the instruction and do not modify elim *)
112
  
113
114
(** We iterate in the order, recording simple local assigns in an accumulator
115
    1. each expression is rewritten according to the accumulator
116
    2. local assigns then rewrite occurrences of the lhs in the computed accumulator
117
*)
118
119
(** Perform optimization on machine code:
120
    - iterate through step instructions and remove simple local assigns
121
    
122
*)
123 307aba8d xthirioux
let machine_unfold fanin elim machine =
124
  (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)
125
  let eliminated_vars, new_instrs = instrs_unfold fanin elim machine.mstep.step_instrs in
126
  let new_locals = List.filter (fun v -> not (IMap.mem v.var_id eliminated_vars)) machine.mstep.step_locals 
127 3ab9437b ploc
  in
128
  {
129
    machine with
130
      mstep = { 
131
	machine.mstep with 
132
	  step_locals = new_locals;
133
	  step_instrs = new_instrs
134
      }
135
  }
136
137 307aba8d xthirioux
let instr_of_const top_const =
138
  let const = const_of_top top_const in
139
  let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true) in
140
  let vdecl = { vdecl with var_type = const.const_type }
141
  in MLocalAssign (vdecl, Cst const.const_value)
142 3ab9437b ploc
143 307aba8d xthirioux
let machines_unfold consts node_schs machines =
144
  List.map
145
    (fun m ->
146
      let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in
147
      let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts)
148
      in machine_unfold fanin elim_consts m)
149
    machines
150 3ab9437b ploc
151 01f1a1f4 xthirioux
(* variable substitution for optimizing purposes *)
152
153
(* checks whether an [instr] is skip and can be removed from program *)
154
let rec instr_is_skip instr =
155
  match instr with
156
  | MLocalAssign (i, LocalVar v) when i = v -> true
157
  | MStateAssign (i, StateVar v) when i = v -> true
158
  | MBranch (g, hl) -> List.for_all (fun (_, il) -> instrs_are_skip il) hl
159
  | _               -> false
160
and instrs_are_skip instrs =
161
  List.for_all instr_is_skip instrs
162
163
let instr_cons instr cont =
164
 if instr_is_skip instr then cont else instr::cont
165
166
let rec instr_remove_skip instr cont =
167
  match instr with
168
  | MLocalAssign (i, LocalVar v) when i = v -> cont
169
  | MStateAssign (i, StateVar v) when i = v -> cont
170
  | MBranch (g, hl) -> MBranch (g, List.map (fun (h, il) -> (h, instrs_remove_skip il [])) hl) :: cont
171
  | _               -> instr::cont
172
173
and instrs_remove_skip instrs cont =
174
  List.fold_right instr_remove_skip instrs cont
175
176
let rec value_replace_var fvar value =
177
  match value with
178
  | Cst c -> value
179
  | LocalVar v -> LocalVar (fvar v)
180
  | StateVar v -> value
181
  | Fun (id, args) -> Fun (id, List.map (value_replace_var fvar) args) 
182
  | Array vl -> Array (List.map (value_replace_var fvar) vl)
183
  | Access (t, i) -> Access(value_replace_var fvar t, i)
184
  | Power (v, n) -> Power(value_replace_var fvar v, n)
185
186
let rec instr_replace_var fvar instr cont =
187
  match instr with
188
  | MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont
189
  | MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont
190
  | MReset i            -> instr_cons instr cont
191
  | MStep (il, i, vl)   -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont
192
  | MBranch (g, hl)     -> instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il [])) hl)) cont
193
194
and instrs_replace_var fvar instrs cont =
195
  List.fold_right (instr_replace_var fvar) instrs cont
196
197
let step_replace_var fvar step =
198
  (* Some outputs may have been replaced by locals.
199
     We then need to rename those outputs
200
     without changing their clocks, etc *)
201
  let outputs' =
202
    List.map (fun o -> { o with var_id = (fvar o).var_id }) step.step_outputs in
203
  let locals'  =
204
    List.fold_left (fun res l ->
205
      let l' = fvar l in
206
      if List.exists (fun o -> o.var_id = l'.var_id) outputs'
207
      then res
208
      else Utils.add_cons l' res)
209
      [] step.step_locals in
210
  { step with
211
    step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks;
212
    step_outputs = outputs';
213
    step_locals = locals';
214
    step_instrs = instrs_replace_var fvar step.step_instrs [];
215
}
216
217
let rec machine_replace_variables fvar m =
218
  { m with
219
    mstep = step_replace_var fvar m.mstep
220
  }
221
222
let machine_reuse_variables m reuse =
223
  let fvar v =
224
    try
225
      Hashtbl.find reuse v.var_id
226
    with Not_found -> v in
227
  machine_replace_variables fvar m
228
229
let machines_reuse_variables prog node_schs =
230
  List.map 
231
    (fun m -> 
232
      machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table
233
    ) prog
234
235 6aeb3388 xthirioux
let rec instr_assign res instr =
236
  match instr with
237
  | MLocalAssign (i, _) -> Disjunction.CISet.add i res
238
  | MStateAssign (i, _) -> Disjunction.CISet.add i res
239
  | MBranch (g, hl)     -> List.fold_left (fun res (h, b) -> instrs_assign res b) res hl
240
  | MStep (il, _, _)    -> List.fold_right Disjunction.CISet.add il res
241
  | _                   -> res
242
243
and instrs_assign res instrs =
244
  List.fold_left instr_assign res instrs
245
246
let rec instr_constant_assign var instr =
247
  match instr with
248
  | MLocalAssign (i, Cst (Const_tag _))
249
  | MStateAssign (i, Cst (Const_tag _)) -> i = var
250
  | MBranch (g, hl)                     -> List.for_all (fun (h, b) -> instrs_constant_assign var b) hl
251
  | _                                   -> false
252
253
and instrs_constant_assign var instrs =
254
  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
255
256
let rec instr_reduce branches instr1 cont =
257
  match instr1 with
258
  | MLocalAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
259
  | MStateAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont)
260
  | MBranch (g, hl)                     -> MBranch (g, List.map (fun (h, b) -> (h, instrs_reduce branches b [])) hl) :: cont
261
  | _                                   -> instr1 :: cont
262
263
and instrs_reduce branches instrs cont =
264
 match instrs with
265
 | []        -> cont
266
 | [i]       -> instr_reduce branches i cont
267
 | i1::i2::q -> i1 :: instrs_reduce branches (i2::q) cont
268
269
let rec instrs_fusion instrs =
270
  match instrs with
271
  | []
272
  | [_]                                                               ->
273
    instrs
274
  | i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 ->
275
    instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q)
276
  | i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 ->
277
    instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q) 
278
  | i1::i2::q                                                         ->
279
    i1 :: instrs_fusion (i2::q)
280
281
let step_fusion step =
282
  { step with
283
    step_instrs = instrs_fusion step.step_instrs;
284
  }
285
286
let rec machine_fusion m =
287
  { m with
288
    mstep = step_fusion m.mstep
289
  }
290
291
let machines_fusion prog =
292
  List.map machine_fusion prog
293 3ab9437b ploc
294
(* Local Variables: *)
295
(* compile-command:"make -C .." *)
296
(* End: *)