Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 01d48bb0

History | View | Annotate | Download (8.04 KB)

1 b38ffff3 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 0cbf0839 ploc
12
open Utils
13 6cf31814 xthirioux
open LustreSpec
14 0cbf0839 ploc
open Corelang
15
open Graph
16
open Causality
17
18 9aaee7f9 xthirioux
type schedule_report =
19
{
20 d96d54ac xthirioux
  (* a schedule computed wrt the dependency graph *)
21 2cf39a8e xthirioux
  schedule : ident list list;
22 d96d54ac xthirioux
  (* the set of unused variables (no output or mem depends on them) *)
23 9aaee7f9 xthirioux
  unused_vars : ISet.t;
24 d96d54ac xthirioux
  (* the table mapping each local var to its in-degree *)
25
  fanin_table : (ident, int) Hashtbl.t;
26 1837ce98 xthirioux
  (* the table mapping each assignment to a reusable variable *)
27 7cd31331 xthirioux
  reuse_table : (ident, var_decl) Hashtbl.t
28 9aaee7f9 xthirioux
}
29 0cbf0839 ploc
30
(* Topological sort with a priority for variables belonging in the same equation lhs.
31
   For variables still unrelated, standard compare is used to choose the minimal element.
32
   This priority is used since it helps a lot in factorizing generated code.
33 6aeb3388 xthirioux
   Moreover, the dependency graph is browsed in a depth-first manner whenever possible,
34
   to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
35 0cbf0839 ploc
   In the following functions:
36
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
37
   - [g] the (imperative) graph to be topologically sorted
38
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
39
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
40
   - [sort] is the resulting topological order
41
*)
42 2cf39a8e xthirioux
43
(* Checks whether the currently scheduled variable [choice]
44
   is an output of a call, possibly among others *)
45
let is_call_output choice g =
46 2ac56807 xthirioux
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
47 2cf39a8e xthirioux
48 0cbf0839 ploc
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
49
   then removes [v] from [g] 
50
*)
51
let add_successors eq_equiv g v pending frontier =
52
  let succs_v = IdentDepGraph.succ g v in
53
  begin
54
    IdentDepGraph.remove_vertex g v;
55 49ddf66d ploc
    List.iter 
56
      (fun v' -> 
57
	if is_graph_root v' g then 
58
	  (if eq_equiv v v' then 
59
	      pending := ISet.add v' !pending 
60
	   else
61
	      frontier := ISet.add v' !frontier)
62
      ) succs_v;
63 0cbf0839 ploc
  end
64
65
(* Chooses the next var to be sorted, taking priority into account.
66
   Modifies [pending] and [frontier] accordingly.
67
*)
68 2cf39a8e xthirioux
let next_element eq_equiv g sort call pending frontier =
69 6cf31814 xthirioux
  begin
70
    if ISet.is_empty !pending
71
    then
72
      begin
73
	let choice = ISet.min_elt !frontier in
74 0cbf0839 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
75 6cf31814 xthirioux
	frontier := ISet.remove choice !frontier;
76
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
77
	pending := p;
78
	frontier := f;
79 2cf39a8e xthirioux
	call := is_call_output choice g;
80 6cf31814 xthirioux
	add_successors eq_equiv g choice pending frontier;
81 2cf39a8e xthirioux
	if not (ExprDep.is_ghost_var choice)
82
	then sort := [choice] :: !sort
83 6cf31814 xthirioux
      end
84
    else
85
      begin
86
	let choice = ISet.min_elt !pending in
87 0cbf0839 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
88 6cf31814 xthirioux
	pending := ISet.remove choice !pending;
89
	add_successors eq_equiv g choice pending frontier;
90 2cf39a8e xthirioux
	if not (ExprDep.is_ghost_var choice)
91
	then sort := (if !call
92
		      then (choice :: List.hd !sort) :: List.tl !sort
93
		      else [choice] :: !sort)
94 6cf31814 xthirioux
      end
95
  end
96
97 0cbf0839 ploc
98
(* Topological sort of dependency graph [g], with priority.
99
 *)
100
let topological_sort eq_equiv g =
101
  let roots = graph_roots g in
102
  assert (roots <> []);
103 2cf39a8e xthirioux
  let call = ref false in
104 0cbf0839 ploc
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
105
  let pending = ref ISet.empty in
106
  let sorted = ref [] in
107
  begin
108
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
109
    do
110
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
111
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
112
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
113 2cf39a8e xthirioux
      next_element eq_equiv g sorted call pending frontier;
114 0cbf0839 ploc
    done;
115 6cf31814 xthirioux
    IdentDepGraph.clear g;
116 0cbf0839 ploc
    !sorted
117
  end
118
119 6a1a01d2 xthirioux
(* Filters out normalization variables and renames instance variables to keep things readable,
120
   in a case of a dependency error *)
121
let filter_original n vl =
122
 List.fold_right (fun v res ->
123
   if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else
124
   let vdecl = get_node_var v n in
125
   if vdecl.var_orig then v :: res else res) vl []
126
127 e8c0f452 xthirioux
let schedule_node n =
128 6a1a01d2 xthirioux
  let node_vars = get_node_vars n in
129 0cbf0839 ploc
  try
130
    let eq_equiv = ExprDep.node_eq_equiv n in
131
    let eq_equiv v1 v2 =
132
      try
133
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
134
      with Not_found -> false in
135 522938b5 ploc
136 0cbf0839 ploc
    let n', g = global_dependency n in
137 49ddf66d ploc
    Log.report ~level:5 
138
      (fun fmt -> 
139 34a5a072 xthirioux
	Format.fprintf fmt
140 49ddf66d ploc
	  "dependency graph for node %s: %a" 
141
	  n'.node_id
142
	  pp_dep_graph g
143
      );
144 c1b14ce6 xthirioux
    
145
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
146
     compute: coi predecessors of outputs
147
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
148 d96d54ac xthirioux
       DONE !
149 c1b14ce6 xthirioux
     *)
150
151 3c48346d xthirioux
    let gg = IdentDepGraph.copy g in
152 84d9893e xthirioux
    let sort = topological_sort eq_equiv g in
153 34a5a072 xthirioux
    let unused = Liveness.compute_unused_variables n gg in
154 d96d54ac xthirioux
    let fanin = Liveness.compute_fanin n gg in
155 01d48bb0 xthirioux
156 c825868a xthirioux
    let (disjoint, reuse) =
157
      if !Options.optimization >= 3
158
      then
159
	let disjoint = Disjunction.clock_disjoint_map node_vars in
160
	(disjoint,
161
	 Liveness.compute_reuse_policy n sort disjoint gg)
162
      else
163
	(Hashtbl.create 1,
164
	 Hashtbl.create 1) in
165 97498b53 xthirioux
166 c825868a xthirioux
    if !Options.print_reuse
167
    then
168
      begin
169
	Log.report ~level:0 
170
	  (fun fmt -> 
171
	    Format.fprintf fmt
172 86b99b69 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 c825868a 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 1837ce98 xthirioux
    n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse }
190 6a1a01d2 xthirioux
  with (Causality.Cycle vl) as exc ->
191
    let vl = filter_original n vl in
192
    pp_error Format.err_formatter vl;
193 0cbf0839 ploc
    raise exc
194
195 db1c5c00 ploc
let schedule_prog prog =
196
  List.fold_right (
197 9aaee7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
198 db1c5c00 ploc
      match top_decl.top_decl_desc with
199
	| Node nd -> 
200 9aaee7f9 xthirioux
	  let nd', report = schedule_node nd in
201 c1b14ce6 xthirioux
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, 
202 9aaee7f9 xthirioux
	  IMap.add nd.node_id report sch_map
203
	| _ -> top_decl::accu_prog, sch_map
204 db1c5c00 ploc
    ) 
205
    prog
206 9aaee7f9 xthirioux
    ([],IMap.empty)
207
208 2cf39a8e xthirioux
let pp_eq_schedule fmt vl =
209
  match vl with
210
  | []  -> assert false
211
  | [v] -> Format.fprintf fmt "%s" v
212
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
213
 
214 d96d54ac xthirioux
let pp_schedule fmt node_schs =
215
 IMap.iter
216
   (fun nd report ->
217
     Format.fprintf fmt "%s schedule: %a@."
218
       nd
219 2cf39a8e xthirioux
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
220 d96d54ac xthirioux
   node_schs
221
222
let pp_fanin_table fmt node_schs =
223
  IMap.iter
224
    (fun nd report ->
225
      Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table)
226
    node_schs
227
228 9aaee7f9 xthirioux
let pp_warning_unused fmt node_schs =
229
 IMap.iter
230
   (fun nd report ->
231
     let unused = report.unused_vars in
232
     if not (ISet.is_empty unused)
233
     then
234
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
235
       ISet.iter
236 67896f6d xthirioux
	 (fun u ->
237
	   let vu = get_node_var u nd in
238
	   if vu.var_orig
239
	   then Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." u Location.pp_loc vu.var_loc)
240 9aaee7f9 xthirioux
	 unused
241
   )
242
   node_schs
243 0cbf0839 ploc
244
(* Local Variables: *)
245
(* compile-command:"make -C .." *)
246
(* End: *)