Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ ef8a361a

History | View | Annotate | Download (9.1 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 8ea13d96 xthirioux
open LustreSpec
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 22fe1c93 ploc
  try
134
    let eq_equiv = ExprDep.node_eq_equiv n in
135
    let eq_equiv v1 v2 =
136
      try
137
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
138
      with Not_found -> false in
139 cd670fe1 ploc
140 22fe1c93 ploc
    let n', g = global_dependency n in
141 0e1049dc xthirioux
    
142
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
143
     compute: coi predecessors of outputs
144
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
145 8a183477 xthirioux
       DONE !
146 0e1049dc xthirioux
     *)
147
148 a5784e75 xthirioux
    let gg = IdentDepGraph.copy g in
149 d4807c3d xthirioux
    let sort = topological_sort eq_equiv g in
150 b6a94a4e xthirioux
    let unused = Liveness.compute_unused_variables n gg in
151 8a183477 xthirioux
    let fanin = Liveness.compute_fanin n gg in
152 04a63d25 xthirioux
    { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
153 ec433d69 xthirioux
154 eb837d74 xthirioux
  with (Causality.Error err) as exc ->
155
    match err with
156
    | DataCycle vl ->
157 dcafc99b Ploc
       let _ (*vl*) = filter_original n vl in
158 eb837d74 xthirioux
       Causality.pp_error Format.err_formatter err;
159
       raise exc
160
    | _ -> raise exc
161 b1a97ade xthirioux
162 04a63d25 xthirioux
let compute_node_reuse_table report =
163
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
164
  let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in
165
(*
166 89a70069 xthirioux
    if !Options.print_reuse
167
    then
168
      begin
169
	Log.report ~level:0 
170
	  (fun fmt -> 
171
	    Format.fprintf fmt
172 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)
173
	  );
174
	Log.report ~level:0 
175
	  (fun fmt -> 
176
	    Format.fprintf fmt
177 89a70069 xthirioux
	      "OPT:clock disjoint map for node %s: %a" 
178
	      n'.node_id
179
	      Disjunction.pp_disjoint_map disjoint
180
	  );
181
	Log.report ~level:0 
182
	  (fun fmt -> 
183
	    Format.fprintf fmt
184
	      "OPT:reuse policy for node %s: %a" 
185
	      n'.node_id
186
	      Liveness.pp_reuse_policy reuse
187
	  );
188
      end;
189 04a63d25 xthirioux
*)
190
    reuse
191
192 22fe1c93 ploc
193 88486aaf ploc
let schedule_prog prog =
194
  List.fold_right (
195 3bfed7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
196 88486aaf ploc
      match top_decl.top_decl_desc with
197
	| Node nd -> 
198 04a63d25 xthirioux
	  let report = schedule_node nd in
199
	  {top_decl with top_decl_desc = Node report.node}::accu_prog, 
200 3bfed7f9 xthirioux
	  IMap.add nd.node_id report sch_map
201
	| _ -> top_decl::accu_prog, sch_map
202 88486aaf ploc
    ) 
203
    prog
204 3bfed7f9 xthirioux
    ([],IMap.empty)
205 04a63d25 xthirioux
  
206
207
let compute_prog_reuse_table report =
208
  IMap.map compute_node_reuse_table report
209
210
(* removes inlined local variables from schedule report, 
211
   which are now useless *)
212
let remove_node_inlined_locals locals report =
213
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
214
  let schedule' =
215
    List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads
216
				    in if heads' = [] then q else heads'::q)
217
      report.schedule [] in
218
  begin
219
    IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
220
    IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v
221
			  in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;
222
    { report with schedule = schedule' }
223
  end
224
225
let remove_prog_inlined_locals removed reuse =
226
  IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
227 3bfed7f9 xthirioux
228 a38c681e xthirioux
let pp_eq_schedule fmt vl =
229
  match vl with
230
  | []  -> assert false
231
  | [v] -> Format.fprintf fmt "%s" v
232
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
233
 
234 8a183477 xthirioux
let pp_schedule fmt node_schs =
235
 IMap.iter
236
   (fun nd report ->
237
     Format.fprintf fmt "%s schedule: %a@."
238
       nd
239 a38c681e xthirioux
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
240 8a183477 xthirioux
   node_schs
241
242
let pp_fanin_table fmt node_schs =
243
  IMap.iter
244
    (fun nd report ->
245 04a63d25 xthirioux
      Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)
246
    node_schs
247
248
let pp_dep_graph fmt node_schs =
249
  IMap.iter
250
    (fun nd report ->
251
      Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)
252 8a183477 xthirioux
    node_schs
253
254 3bfed7f9 xthirioux
let pp_warning_unused fmt node_schs =
255
 IMap.iter
256
   (fun nd report ->
257
     let unused = report.unused_vars in
258
     if not (ISet.is_empty unused)
259
     then
260
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
261
       ISet.iter
262 df39e35a xthirioux
	 (fun u ->
263
	   let vu = get_node_var u nd in
264
	   if vu.var_orig
265 04a63d25 xthirioux
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
266 3bfed7f9 xthirioux
	 unused
267
   )
268
   node_schs
269 22fe1c93 ploc
270 04a63d25 xthirioux
271 22fe1c93 ploc
(* Local Variables: *)
272
(* compile-command:"make -C .." *)
273
(* End: *)