Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ cfe98135

History | View | Annotate | Download (8.86 KB)

1 a2d97a3e 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 22fe1c93 ploc
12
open Utils
13 8446bf03 ploc
open Lustre_types
14 22fe1c93 ploc
open Corelang
15
open Graph
16
open Causality
17
18 3bfed7f9 xthirioux
type schedule_report =
19
{
20 04a63d25 xthirioux
  (* the scheduled node *)
21
  node : node_desc;
22 8a183477 xthirioux
  (* a schedule computed wrt the dependency graph *)
23 a38c681e xthirioux
  schedule : ident list list;
24 8a183477 xthirioux
  (* the set of unused variables (no output or mem depends on them) *)
25 3bfed7f9 xthirioux
  unused_vars : ISet.t;
26 8a183477 xthirioux
  (* the table mapping each local var to its in-degree *)
27
  fanin_table : (ident, int) Hashtbl.t;
28 04a63d25 xthirioux
  (* the dependency graph *)
29
  dep_graph   : IdentDepGraph.t;
30 bb2ca5f4 xthirioux
  (* the table mapping each assignment to a reusable variable *)
31 04a63d25 xthirioux
  (*reuse_table : (ident, var_decl) Hashtbl.t*)
32 3bfed7f9 xthirioux
}
33 22fe1c93 ploc
34
(* Topological sort with a priority for variables belonging in the same equation lhs.
35
   For variables still unrelated, standard compare is used to choose the minimal element.
36
   This priority is used since it helps a lot in factorizing generated code.
37 b1655a21 xthirioux
   Moreover, the dependency graph is browsed in a depth-first manner whenever possible,
38
   to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
39 22fe1c93 ploc
   In the following functions:
40
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
41
   - [g] the (imperative) graph to be topologically sorted
42
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
43
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
44
   - [sort] is the resulting topological order
45
*)
46 a38c681e xthirioux
47
(* Checks whether the currently scheduled variable [choice]
48
   is an output of a call, possibly among others *)
49
let is_call_output choice g =
50 04d15b97 xthirioux
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
51 a38c681e xthirioux
52 22fe1c93 ploc
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
53
   then removes [v] from [g] 
54
*)
55
let add_successors eq_equiv g v pending frontier =
56
  let succs_v = IdentDepGraph.succ g v in
57
  begin
58
    IdentDepGraph.remove_vertex g v;
59 b84a138e ploc
    List.iter 
60
      (fun v' -> 
61
	if is_graph_root v' g then 
62
	  (if eq_equiv v v' then 
63
	      pending := ISet.add v' !pending 
64
	   else
65
	      frontier := ISet.add v' !frontier)
66
      ) succs_v;
67 22fe1c93 ploc
  end
68
69
(* Chooses the next var to be sorted, taking priority into account.
70
   Modifies [pending] and [frontier] accordingly.
71
*)
72 a38c681e xthirioux
let next_element eq_equiv g sort call pending frontier =
73 8ea13d96 xthirioux
  begin
74
    if ISet.is_empty !pending
75
    then
76
      begin
77
	let choice = ISet.min_elt !frontier in
78 22fe1c93 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
79 8ea13d96 xthirioux
	frontier := ISet.remove choice !frontier;
80
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
81
	pending := p;
82
	frontier := f;
83 a38c681e xthirioux
	call := is_call_output choice g;
84 8ea13d96 xthirioux
	add_successors eq_equiv g choice pending frontier;
85 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
86
	then sort := [choice] :: !sort
87 8ea13d96 xthirioux
      end
88
    else
89
      begin
90
	let choice = ISet.min_elt !pending in
91 22fe1c93 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
92 8ea13d96 xthirioux
	pending := ISet.remove choice !pending;
93
	add_successors eq_equiv g choice pending frontier;
94 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
95
	then sort := (if !call
96
		      then (choice :: List.hd !sort) :: List.tl !sort
97
		      else [choice] :: !sort)
98 8ea13d96 xthirioux
      end
99
  end
100
101 22fe1c93 ploc
102
(* Topological sort of dependency graph [g], with priority.
103
 *)
104
let topological_sort eq_equiv g =
105
  let roots = graph_roots g in
106
  assert (roots <> []);
107 a38c681e xthirioux
  let call = ref false in
108 22fe1c93 ploc
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
109
  let pending = ref ISet.empty in
110
  let sorted = ref [] in
111
  begin
112
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
113
    do
114
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
115
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
116
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
117 a38c681e xthirioux
      next_element eq_equiv g sorted call pending frontier;
118 22fe1c93 ploc
    done;
119 8ea13d96 xthirioux
    IdentDepGraph.clear g;
120 22fe1c93 ploc
    !sorted
121
  end
122
123 54d032f5 xthirioux
(* Filters out normalization variables and renames instance variables to keep things readable,
124
   in a case of a dependency error *)
125
let filter_original n vl =
126
 List.fold_right (fun v res ->
127
   if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else
128
   let vdecl = get_node_var v n in
129
   if vdecl.var_orig then v :: res else res) vl []
130
131 7afcba5a xthirioux
let schedule_node n =
132 04a63d25 xthirioux
  (* let node_vars = get_node_vars n in *)
133 e7cc5186 ploc
  let eq_equiv = ExprDep.node_eq_equiv n in
134
  let eq_equiv v1 v2 =
135
    try
136
      Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
137
    with Not_found -> false in
138 cd670fe1 ploc
139 e7cc5186 ploc
  let n', g = global_dependency n in
140
  
141
  (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
142 0e1049dc xthirioux
     compute: coi predecessors of outputs
143
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
144 e7cc5186 ploc
     DONE !
145
  *)
146 0e1049dc xthirioux
147 e7cc5186 ploc
  let gg = IdentDepGraph.copy g in
148
  let sort = topological_sort eq_equiv g in
149
  let unused = Liveness.compute_unused_variables n gg in
150
  let fanin = Liveness.compute_fanin n gg in
151
  { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
152 ec433d69 xthirioux
153 b1a97ade xthirioux
154 04a63d25 xthirioux
let compute_node_reuse_table report =
155
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
156
  let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in
157
(*
158 89a70069 xthirioux
    if !Options.print_reuse
159
    then
160
      begin
161
	Log.report ~level:0 
162
	  (fun fmt -> 
163
	    Format.fprintf fmt
164 790765c0 xthirioux
	      "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true)
165
	  );
166
	Log.report ~level:0 
167
	  (fun fmt -> 
168
	    Format.fprintf fmt
169 89a70069 xthirioux
	      "OPT:clock disjoint map for node %s: %a" 
170
	      n'.node_id
171
	      Disjunction.pp_disjoint_map disjoint
172
	  );
173
	Log.report ~level:0 
174
	  (fun fmt -> 
175
	    Format.fprintf fmt
176
	      "OPT:reuse policy for node %s: %a" 
177
	      n'.node_id
178
	      Liveness.pp_reuse_policy reuse
179
	  );
180
      end;
181 04a63d25 xthirioux
*)
182
    reuse
183
184 22fe1c93 ploc
185 88486aaf ploc
let schedule_prog prog =
186
  List.fold_right (
187 3bfed7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
188 88486aaf ploc
      match top_decl.top_decl_desc with
189 f4050bef ploc
      | Node nd ->
190
	let report = schedule_node nd in
191
	{top_decl with top_decl_desc = Node report.node}::accu_prog, 
192
	IMap.add nd.node_id report sch_map
193 3bfed7f9 xthirioux
	| _ -> top_decl::accu_prog, sch_map
194 88486aaf ploc
    ) 
195
    prog
196 3bfed7f9 xthirioux
    ([],IMap.empty)
197 04a63d25 xthirioux
  
198
199
let compute_prog_reuse_table report =
200
  IMap.map compute_node_reuse_table report
201
202
(* removes inlined local variables from schedule report, 
203
   which are now useless *)
204
let remove_node_inlined_locals locals report =
205
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
206
  let schedule' =
207
    List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads
208
				    in if heads' = [] then q else heads'::q)
209
      report.schedule [] in
210
  begin
211
    IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
212
    IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v
213
			  in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;
214
    { report with schedule = schedule' }
215
  end
216
217
let remove_prog_inlined_locals removed reuse =
218
  IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
219 3bfed7f9 xthirioux
220 a38c681e xthirioux
let pp_eq_schedule fmt vl =
221
  match vl with
222
  | []  -> assert false
223
  | [v] -> Format.fprintf fmt "%s" v
224
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
225
 
226 8a183477 xthirioux
let pp_schedule fmt node_schs =
227
 IMap.iter
228
   (fun nd report ->
229
     Format.fprintf fmt "%s schedule: %a@."
230
       nd
231 a38c681e xthirioux
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
232 8a183477 xthirioux
   node_schs
233
234
let pp_fanin_table fmt node_schs =
235
  IMap.iter
236
    (fun nd report ->
237 04a63d25 xthirioux
      Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)
238
    node_schs
239
240
let pp_dep_graph fmt node_schs =
241
  IMap.iter
242
    (fun nd report ->
243
      Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)
244 8a183477 xthirioux
    node_schs
245
246 3bfed7f9 xthirioux
let pp_warning_unused fmt node_schs =
247
 IMap.iter
248
   (fun nd report ->
249
     let unused = report.unused_vars in
250
     if not (ISet.is_empty unused)
251
     then
252
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
253
       ISet.iter
254 df39e35a xthirioux
	 (fun u ->
255
	   let vu = get_node_var u nd in
256
	   if vu.var_orig
257 04a63d25 xthirioux
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
258 3bfed7f9 xthirioux
	 unused
259
   )
260
   node_schs
261 22fe1c93 ploc
262 04a63d25 xthirioux
263 22fe1c93 ploc
(* Local Variables: *)
264
(* compile-command:"make -C .." *)
265
(* End: *)