Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ e6b644f4

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