Project

General

Profile

Download (9.29 KB) Statistics
| Branch: | Tag: | Revision:
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 Graph
16
open Causality
17

    
18
type eq_schedule_t = ident list list
19
  
20
type schedule_report =
21
{
22
  (* the scheduled node *)
23
  node : node_desc;
24
  (* a schedule computed wrt the dependency graph *)
25
  schedule : eq_schedule_t;
26
  (* the set of unused variables (no output or mem depends on them) *)
27
  unused_vars : ISet.t;
28
  (* the table mapping each local var to its in-degree *)
29
  fanin_table : (ident, int) Hashtbl.t;
30
  (* the dependency graph *)
31
  dep_graph   : IdentDepGraph.t;
32
  (* the table mapping each assignment to a reusable variable *)
33
  (*reuse_table : (ident, var_decl) Hashtbl.t*)
34
}
35

    
36
type t = schedule_report IMap.t
37

    
38
let get_node_schedule node node_schs = Utils.IMap.find node.node_id node_schs
39

    
40
let fold_eq_schedule = List.fold_left
41
  
42
(* Topological sort with a priority for variables belonging in the same equation lhs.
43
   For variables still unrelated, standard compare is used to choose the minimal element.
44
   This priority is used since it helps a lot in factorizing generated code.
45
   Moreover, the dependency graph is browsed in a depth-first manner whenever possible,
46
   to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
47
   In the following functions:
48
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
49
   - [g] the (imperative) graph to be topologically sorted
50
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
51
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
52
   - [sort] is the resulting topological order
53
*)
54

    
55
(* Checks whether the currently scheduled variable [choice]
56
   is an output of a call, possibly among others *)
57
let is_call_output choice g =
58
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
59

    
60
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
61
   then removes [v] from [g] 
62
*)
63
let add_successors eq_equiv g v pending frontier =
64
  let succs_v = IdentDepGraph.succ g v in
65
  begin
66
    IdentDepGraph.remove_vertex g v;
67
    List.iter 
68
      (fun v' -> 
69
	if is_graph_root v' g then 
70
	  (if eq_equiv v v' then 
71
	      pending := ISet.add v' !pending 
72
	   else
73
	      frontier := ISet.add v' !frontier)
74
      ) succs_v;
75
  end
76

    
77
(* Chooses the next var to be sorted, taking priority into account.
78
   Modifies [pending] and [frontier] accordingly.
79
*)
80
let next_element eq_equiv g sort call pending frontier =
81
  begin
82
    if ISet.is_empty !pending
83
    then
84
      begin
85
	let choice = ISet.min_elt !frontier in
86
      (*Format.eprintf "-1-> %s@." choice;*)
87
	frontier := ISet.remove choice !frontier;
88
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
89
	pending := p;
90
	frontier := f;
91
	call := is_call_output choice g;
92
	add_successors eq_equiv g choice pending frontier;
93
	if not (ExprDep.is_ghost_var choice)
94
	then sort := [choice] :: !sort
95
      end
96
    else
97
      begin
98
	let choice = ISet.min_elt !pending in
99
      (*Format.eprintf "-2-> %s@." choice;*)
100
	pending := ISet.remove choice !pending;
101
	add_successors eq_equiv g choice pending frontier;
102
	if not (ExprDep.is_ghost_var choice)
103
	then sort := (if !call
104
		      then (choice :: List.hd !sort) :: List.tl !sort
105
		      else [choice] :: !sort)
106
      end
107
  end
108

    
109

    
110
(* Topological sort of dependency graph [g], with priority.
111
 *)
112
let topological_sort eq_equiv g =
113
  let roots = graph_roots g in
114
  assert (roots <> []);
115
  let call = ref false in
116
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
117
  let pending = ref ISet.empty in
118
  let sorted = ref [] in
119
  begin
120
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
121
    do
122
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
123
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
124
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
125
      next_element eq_equiv g sorted call pending frontier;
126
    done;
127
    IdentDepGraph.clear g;
128
    !sorted
129
  end
130

    
131
(* Filters out normalization variables and renames instance variables to keep things readable,
132
   in a case of a dependency error *)
133
let filter_original n vl =
134
 List.fold_right (fun v res ->
135
   if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else
136
   let vdecl = get_node_var v n in
137
   if vdecl.var_orig then v :: res else res) vl []
138

    
139
let schedule_node n =
140
  (* let node_vars = get_node_vars n in *)
141
  try
142
    let eq_equiv = ExprDep.node_eq_equiv n in
143
    let eq_equiv v1 v2 =
144
      try
145
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
146
      with Not_found -> false in
147

    
148
    let n', g = global_dependency n in
149
    
150
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
151
     compute: coi predecessors of outputs
152
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
153
       DONE !
154
     *)
155

    
156
    let gg = IdentDepGraph.copy g in
157
    let sort = topological_sort eq_equiv g in
158
    let unused = Liveness.compute_unused_variables n gg in
159
    let fanin = Liveness.compute_fanin n gg in
160
    { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
161

    
162
  with (Causality.Error err) as exc ->
163
    match err with
164
    | DataCycle vl ->
165
       let _ (*vl*) = filter_original n vl in
166
       Causality.pp_error Format.err_formatter err;
167
       raise exc
168
    | _ -> raise exc
169

    
170
let compute_node_reuse_table report =
171
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
172
  let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in
173
(*
174
    if !Options.print_reuse
175
    then
176
      begin
177
	Log.report ~level:0 
178
	  (fun fmt -> 
179
	    Format.fprintf fmt
180
	      "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true)
181
	  );
182
	Log.report ~level:0 
183
	  (fun fmt -> 
184
	    Format.fprintf fmt
185
	      "OPT:clock disjoint map for node %s: %a" 
186
	      n'.node_id
187
	      Disjunction.pp_disjoint_map disjoint
188
	  );
189
	Log.report ~level:0 
190
	  (fun fmt -> 
191
	    Format.fprintf fmt
192
	      "OPT:reuse policy for node %s: %a" 
193
	      n'.node_id
194
	      Liveness.pp_reuse_policy reuse
195
	  );
196
      end;
197
*)
198
    reuse
199

    
200

    
201
let schedule_prog prog =
202
  List.fold_right (
203
    fun top_decl (accu_prog, sch_map)  ->
204
      match top_decl.top_decl_desc with
205
	| Node nd -> 
206
	  let report = schedule_node nd in
207
	  {top_decl with top_decl_desc = Node report.node}::accu_prog, 
208
	  IMap.add nd.node_id report sch_map
209
	| _ -> top_decl::accu_prog, sch_map
210
    ) 
211
    prog
212
    ([],IMap.empty)
213
  
214

    
215
let compute_prog_reuse_table report =
216
  IMap.map compute_node_reuse_table report
217

    
218
(* removes inlined local variables from schedule report, 
219
   which are now useless *)
220
let remove_node_inlined_locals locals report =
221
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
222
  let schedule' =
223
    List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads
224
				    in if heads' = [] then q else heads'::q)
225
      report.schedule [] in
226
  begin
227
    IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
228
    IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v
229
			  in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;
230
    { report with schedule = schedule' }
231
  end
232

    
233
let remove_prog_inlined_locals removed reuse =
234
  IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
235

    
236
let pp_eq_schedule fmt vl =
237
  match vl with
238
  | []  -> assert false
239
  | [v] -> Format.fprintf fmt "%s" v
240
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
241
 
242
let pp_schedule fmt node_schs =
243
 IMap.iter
244
   (fun nd report ->
245
     Format.fprintf fmt "%s schedule: %a@."
246
       nd
247
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
248
   node_schs
249

    
250
let pp_fanin_table fmt node_schs =
251
  IMap.iter
252
    (fun nd report ->
253
      Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)
254
    node_schs
255

    
256
let pp_dep_graph fmt node_schs =
257
  IMap.iter
258
    (fun nd report ->
259
      Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)
260
    node_schs
261

    
262
let pp_warning_unused fmt node_schs =
263
 IMap.iter
264
   (fun nd report ->
265
     let unused = report.unused_vars in
266
     if not (ISet.is_empty unused)
267
     then
268
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
269
       ISet.iter
270
	 (fun u ->
271
	   let vu = get_node_var u nd in
272
	   if vu.var_orig
273
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
274
	 unused
275
   )
276
   node_schs
277

    
278

    
279
(* Local Variables: *)
280
(* compile-command:"make -C .." *)
281
(* End: *)
(53-53/62)