Project

General

Profile

Revision 307aba8d

View differences:

src/causality.ml
191 191
      else
192 192
	let x = if ISet.mem x inputs then mk_read_var x else x in
193 193
	(add_edges lhs [x] g, g')
194
    else (g, g') in
194
    else (add_edges lhs [mk_read_var x] g, g') (* x is a global constant, treated as a read var *) in
195 195
(* Add dependencies from [lhs] to rhs clock [ck]. *)
196 196
  let rec add_clock lhs_is_mem lhs ck g =
197 197
    (*Format.eprintf "add_clock %a@." Clocks.print_ck ck;*)
src/liveness.ml
27 27
*)
28 28
let compute_fanin n g =
29 29
  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
30
  let inputs = ExprDep.node_input_variables n in
30 31
  let fanin = Hashtbl.create 23 in
31 32
  begin
32
    IdentDepGraph.iter_vertex (fun v -> if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g;
33
    IdentDepGraph.iter_vertex
34
      (fun v ->
35
	if ISet.mem v locals
36
	then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else
37
	if ExprDep.is_read_var v && not (ISet.mem v inputs)
38
	then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g;
33 39
    fanin
34 40
  end
35 41
 
src/main_lustre_compiler.ml
202 202
    - eliminate trivial expressions
203 203
 *)
204 204
  let prog = 
205
    if !Options.optimization >= 2 then 
205
    if !Options.optimization >= 4 then 
206 206
      Optimize_prog.prog_unfold_consts prog 
207 207
    else
208 208
      prog
......
214 214

  
215 215
  (* Optimize machine code *)
216 216
  let machine_code = 
217
    if !Options.optimization >= 3 && !Options.output <> "horn" then
217
    if !Options.optimization >= 2 && !Options.output <> "horn" then
218 218
      begin
219
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization@,");
220
	Optimize_machine.machines_reuse_variables machine_code node_schs
219
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization (phase 1)@,");
220
	Optimize_machine.machines_unfold (Corelang.get_consts prog) node_schs machine_code
221 221
      end
222 222
    else
223 223
      machine_code
224 224
 in  
225
  (* Optimize machine code *)
225 226
  let machine_code = 
226 227
    if !Options.optimization >= 3 && !Options.output <> "horn" then
227 228
      begin
228
	Optimize_machine.machines_fusion machine_code
229
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization (phase 2)@,");
230
	Optimize_machine.machines_fusion (Optimize_machine.machines_reuse_variables machine_code node_schs)
229 231
      end
230 232
    else
231 233
      machine_code
src/optimize_machine.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
open Utils
12 13
open LustreSpec 
13 14
open Corelang
14 15
open Causality
15 16
open Machine_code 
16 17

  
18
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

  
17 25
let rec eliminate elim instr =
18 26
  let e_expr = eliminate_expr elim in
19 27
  match instr with  
......
32 40
    
33 41
and eliminate_expr elim expr =
34 42
  match expr with
35
  | LocalVar v -> if List.mem_assoc v elim then List.assoc v elim else expr
43
  | LocalVar v -> (try IMap.find v.var_id elim with Not_found -> expr)
36 44
  | Fun (id, vl) -> Fun (id, List.map (eliminate_expr elim) vl)
37 45
  | Array(vl) -> Array(List.map (eliminate_expr elim) vl)
38 46
  | 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)
47
  | Power(v1, v2) -> Power(eliminate_expr elim v1, eliminate_expr elim v2)
40 48
  | Cst _ | StateVar _ -> expr
41 49

  
50
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

  
42 79
(* see if elim has to take in account the provided instr:
43 80
   if so, update elim and return the remove flag,
44 81
   otherwise, the expression should be kept and elim is left untouched *)
45
let update_elim outputs elim instr =
82
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 =
46 95
(*  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 96
  match instr with
52 97
  (* 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
  | _ -> 
98
  | 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)
75 111
    (* default case, we keep the instruction and do not modify elim *)
76
    false, elim
77 112
  
78 113

  
79 114
(** We iterate in the order, recording simple local assigns in an accumulator
80 115
    1. each expression is rewritten according to the accumulator
81 116
    2. local assigns then rewrite occurrences of the lhs in the computed accumulator
82 117
*)
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 118

  
98 119
(** Perform optimization on machine code:
99 120
    - iterate through step instructions and remove simple local assigns
100 121
    
101 122
*)
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 
123
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 
106 127
  in
107 128
  {
108 129
    machine with
......
112 133
	  step_instrs = new_instrs
113 134
      }
114 135
  }
115
    
116 136

  
137
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)
117 142

  
118
let optimize_machines machines =
119
  List.map optimize_machine machines
143
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
120 150

  
121 151
(* variable substitution for optimizing purposes *)
122 152

  
src/optimize_prog.ml
56 56
	| _       -> decl
57 57
    ) prog 
58 58

  
59
(* Distribution of when inside sub-expressions, i.e. (a+b) when c --> a when c + b when c 
60
   May increase clock disjointness of variables, which is useful for code optimization
61
*)
59 62
let apply_stack expr stack =
60 63
 List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack
61 64

  

Also available in: Unified diff