Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ e7cc5186

History | View | Annotate | Download (8.86 KB)

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

    
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
   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
   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

    
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
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
51

    
52
(* 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
    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
  end
68

    
69
(* Chooses the next var to be sorted, taking priority into account.
70
   Modifies [pending] and [frontier] accordingly.
71
*)
72
let next_element eq_equiv g sort call pending frontier =
73
  begin
74
    if ISet.is_empty !pending
75
    then
76
      begin
77
	let choice = ISet.min_elt !frontier in
78
      (*Format.eprintf "-1-> %s@." choice;*)
79
	frontier := ISet.remove choice !frontier;
80
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
81
	pending := p;
82
	frontier := f;
83
	call := is_call_output choice g;
84
	add_successors eq_equiv g choice pending frontier;
85
	if not (ExprDep.is_ghost_var choice)
86
	then sort := [choice] :: !sort
87
      end
88
    else
89
      begin
90
	let choice = ISet.min_elt !pending in
91
      (*Format.eprintf "-2-> %s@." choice;*)
92
	pending := ISet.remove choice !pending;
93
	add_successors eq_equiv g choice pending frontier;
94
	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
      end
99
  end
100

    
101

    
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
  let call = ref false in
108
  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
      next_element eq_equiv g sorted call pending frontier;
118
    done;
119
    IdentDepGraph.clear g;
120
    !sorted
121
  end
122

    
123
(* 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
let schedule_node n =
132
  (* let node_vars = get_node_vars n in *)
133
  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

    
139
  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
     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
     DONE !
145
  *)
146

    
147
  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

    
153

    
154
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
    if !Options.print_reuse
159
    then
160
      begin
161
	Log.report ~level:0 
162
	  (fun fmt -> 
163
	    Format.fprintf fmt
164
	      "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
	      "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
*)
182
    reuse
183

    
184

    
185
let schedule_prog prog =
186
  List.fold_right (
187
    fun top_decl (accu_prog, sch_map)  ->
188
      match top_decl.top_decl_desc with
189
	| 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
	| _ -> top_decl::accu_prog, sch_map
194
    ) 
195
    prog
196
    ([],IMap.empty)
197
  
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

    
220
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
let pp_schedule fmt node_schs =
227
 IMap.iter
228
   (fun nd report ->
229
     Format.fprintf fmt "%s schedule: %a@."
230
       nd
231
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
232
   node_schs
233

    
234
let pp_fanin_table fmt node_schs =
235
  IMap.iter
236
    (fun nd report ->
237
      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
    node_schs
245

    
246
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
	 (fun u ->
255
	   let vu = get_node_var u nd in
256
	   if vu.var_orig
257
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
258
	 unused
259
   )
260
   node_schs
261

    
262

    
263
(* Local Variables: *)
264
(* compile-command:"make -C .." *)
265
(* End: *)