Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 3b2bd83d

History | View | Annotate | Download (9.09 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.Error err) as exc ->
155
    match err with
156
    | DataCycle vl ->
157
       let vl = filter_original n vl in
158
       Causality.pp_error Format.err_formatter err;
159
       raise exc
160
    | _ -> raise exc
161

    
162
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
    if !Options.print_reuse
167
    then
168
      begin
169
	Log.report ~level:0 
170
	  (fun fmt -> 
171
	    Format.fprintf fmt
172
	      "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
	      "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
*)
190
    reuse
191

    
192

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

    
228
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
let pp_schedule fmt node_schs =
235
 IMap.iter
236
   (fun nd report ->
237
     Format.fprintf fmt "%s schedule: %a@."
238
       nd
239
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
240
   node_schs
241

    
242
let pp_fanin_table fmt node_schs =
243
  IMap.iter
244
    (fun nd report ->
245
      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
    node_schs
253

    
254
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
	 (fun u ->
263
	   let vu = get_node_var u nd in
264
	   if vu.var_orig
265
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
266
	 unused
267
   )
268
   node_schs
269

    
270

    
271
(* Local Variables: *)
272
(* compile-command:"make -C .." *)
273
(* End: *)