Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ 45c13277

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