Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 53206908

History | View | Annotate | Download (9.01 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
  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

    
140
    let n', g = global_dependency n in
141
    
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
       DONE !
146
     *)
147

    
148
    let gg = IdentDepGraph.copy g in
149
    let sort = topological_sort eq_equiv g in
150
    let unused = Liveness.compute_unused_variables n gg in
151
    let fanin = Liveness.compute_fanin n gg in
152
    { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
153

    
154
  with (Causality.Cycle vl) as exc ->
155
    let vl = filter_original n vl in
156
    pp_error Format.err_formatter vl;
157
    raise exc
158

    
159
let compute_node_reuse_table report =
160
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
161
  let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in
162
(*
163
    if !Options.print_reuse
164
    then
165
      begin
166
	Log.report ~level:0 
167
	  (fun fmt -> 
168
	    Format.fprintf fmt
169
	      "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true)
170
	  );
171
	Log.report ~level:0 
172
	  (fun fmt -> 
173
	    Format.fprintf fmt
174
	      "OPT:clock disjoint map for node %s: %a" 
175
	      n'.node_id
176
	      Disjunction.pp_disjoint_map disjoint
177
	  );
178
	Log.report ~level:0 
179
	  (fun fmt -> 
180
	    Format.fprintf fmt
181
	      "OPT:reuse policy for node %s: %a" 
182
	      n'.node_id
183
	      Liveness.pp_reuse_policy reuse
184
	  );
185
      end;
186
*)
187
    reuse
188

    
189

    
190
let schedule_prog prog =
191
  List.fold_right (
192
    fun top_decl (accu_prog, sch_map)  ->
193
      match top_decl.top_decl_desc with
194
	| Node nd -> 
195
	  let report = schedule_node nd in
196
	  {top_decl with top_decl_desc = Node report.node}::accu_prog, 
197
	  IMap.add nd.node_id report sch_map
198
	| _ -> top_decl::accu_prog, sch_map
199
    ) 
200
    prog
201
    ([],IMap.empty)
202
  
203

    
204
let compute_prog_reuse_table report =
205
  IMap.map compute_node_reuse_table report
206

    
207
(* removes inlined local variables from schedule report, 
208
   which are now useless *)
209
let remove_node_inlined_locals locals report =
210
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
211
  let schedule' =
212
    List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads
213
				    in if heads' = [] then q else heads'::q)
214
      report.schedule [] in
215
  begin
216
    IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
217
    IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v
218
			  in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;
219
    { report with schedule = schedule' }
220
  end
221

    
222
let remove_prog_inlined_locals removed reuse =
223
  IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
224

    
225
let pp_eq_schedule fmt vl =
226
  match vl with
227
  | []  -> assert false
228
  | [v] -> Format.fprintf fmt "%s" v
229
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
230
 
231
let pp_schedule fmt node_schs =
232
 IMap.iter
233
   (fun nd report ->
234
     Format.fprintf fmt "%s schedule: %a@."
235
       nd
236
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
237
   node_schs
238

    
239
let pp_fanin_table fmt node_schs =
240
  IMap.iter
241
    (fun nd report ->
242
      Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)
243
    node_schs
244

    
245
let pp_dep_graph fmt node_schs =
246
  IMap.iter
247
    (fun nd report ->
248
      Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)
249
    node_schs
250

    
251
let pp_warning_unused fmt node_schs =
252
 IMap.iter
253
   (fun nd report ->
254
     let unused = report.unused_vars in
255
     if not (ISet.is_empty unused)
256
     then
257
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
258
       ISet.iter
259
	 (fun u ->
260
	   let vu = get_node_var u nd in
261
	   if vu.var_orig
262
	   then Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." u Location.pp_loc vu.var_loc)
263
	 unused
264
   )
265
   node_schs
266

    
267

    
268
(* Local Variables: *)
269
(* compile-command:"make -C .." *)
270
(* End: *)