Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 36454535

History | View | Annotate | Download (7.07 KB)

1 0cbf0839 ploc
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23
24
(* This module is used for the lustre to C compiler *)
25
26
open Utils
27 6cf31814 xthirioux
open LustreSpec
28 0cbf0839 ploc
open Corelang
29
open Graph
30
open Causality
31
32 9aaee7f9 xthirioux
type schedule_report =
33
{
34 d96d54ac xthirioux
  (* a schedule computed wrt the dependency graph *)
35 9aaee7f9 xthirioux
  schedule : ident list;
36 d96d54ac xthirioux
  (* the set of unused variables (no output or mem depends on them) *)
37 9aaee7f9 xthirioux
  unused_vars : ISet.t;
38 d96d54ac xthirioux
  (* the table mapping each local var to its in-degree *)
39
  fanin_table : (ident, int) Hashtbl.t;
40 1837ce98 xthirioux
  (* the table mapping each assignment to a reusable variable *)
41
  reuse_table : (ident, ident) Hashtbl.t
42 9aaee7f9 xthirioux
}
43 0cbf0839 ploc
44
(* Topological sort with a priority for variables belonging in the same equation lhs.
45
   For variables still unrelated, standard compare is used to choose the minimal element.
46
   This priority is used since it helps a lot in factorizing generated code.
47
   In the following functions:
48
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
49
   - [g] the (imperative) graph to be topologically sorted
50
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
51
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
52
   - [sort] is the resulting topological order
53
*)
54
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
55
   then removes [v] from [g] 
56
*)
57
let add_successors eq_equiv g v pending frontier =
58
  let succs_v = IdentDepGraph.succ g v in
59
  begin
60
    IdentDepGraph.remove_vertex g v;
61 49ddf66d ploc
    List.iter 
62
      (fun v' -> 
63
	if is_graph_root v' g then 
64
	  (if eq_equiv v v' then 
65
	      pending := ISet.add v' !pending 
66
	   else
67
	      frontier := ISet.add v' !frontier)
68
      ) succs_v;
69 0cbf0839 ploc
  end
70
71
(* Chooses the next var to be sorted, taking priority into account.
72
   Modifies [pending] and [frontier] accordingly.
73
*)
74
let next_element eq_equiv g sort pending frontier =
75 6cf31814 xthirioux
  begin
76
    if ISet.is_empty !pending
77
    then
78
      begin
79
	let choice = ISet.min_elt !frontier in
80 0cbf0839 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
81 6cf31814 xthirioux
	frontier := ISet.remove choice !frontier;
82
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
83
	pending := p;
84
	frontier := f;
85
	add_successors eq_equiv g choice pending frontier;
86 9aaee7f9 xthirioux
	if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort
87 6cf31814 xthirioux
      end
88
    else
89
      begin
90
	let choice = ISet.min_elt !pending in
91 0cbf0839 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
92 6cf31814 xthirioux
	pending := ISet.remove choice !pending;
93
	add_successors eq_equiv g choice pending frontier;
94 9aaee7f9 xthirioux
	if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort
95 6cf31814 xthirioux
      end
96
  end
97
98 0cbf0839 ploc
99
(* Topological sort of dependency graph [g], with priority.
100
 *)
101
let topological_sort eq_equiv g =
102
  let roots = graph_roots g in
103
  assert (roots <> []);
104
  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
      next_element eq_equiv g sorted pending frontier;
114
    done;
115 6cf31814 xthirioux
    IdentDepGraph.clear g;
116 0cbf0839 ploc
    !sorted
117
  end
118
119 e8c0f452 xthirioux
let schedule_node n =
120 0cbf0839 ploc
  try
121
    let eq_equiv = ExprDep.node_eq_equiv n in
122
    let eq_equiv v1 v2 =
123
      try
124
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
125
      with Not_found -> false in
126 522938b5 ploc
127 0cbf0839 ploc
    let n', g = global_dependency n in
128 49ddf66d ploc
    Log.report ~level:5 
129
      (fun fmt -> 
130
	Format.eprintf 
131
	  "dependency graph for node %s: %a" 
132
	  n'.node_id
133
	  pp_dep_graph g
134
      );
135 c1b14ce6 xthirioux
    
136
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
137
     compute: coi predecessors of outputs
138
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
139 d96d54ac xthirioux
       DONE !
140 c1b14ce6 xthirioux
     *)
141
142 3c48346d xthirioux
    let gg = IdentDepGraph.copy g in
143 84d9893e xthirioux
    let sort = topological_sort eq_equiv g in
144 9aaee7f9 xthirioux
    let unused = Liveness.compute_unused n gg in
145 d96d54ac xthirioux
    let fanin = Liveness.compute_fanin n gg in
146 d4101ea0 xthirioux
    let death = Liveness.death_table n gg sort in
147 49ddf66d ploc
    Log.report ~level:5 
148
      (fun fmt -> 
149
	Format.eprintf 
150
	  "death table for node %s: %a" 
151
	  n'.node_id
152
	  Liveness.pp_death_table death
153
      );
154 e8c0f452 xthirioux
155 0038002e ploc
    let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in
156 49ddf66d ploc
    
157
    Log.report ~level:5 
158
      (fun fmt -> 
159
	Format.eprintf 
160
	  "clock disjoint map for node %s: %a" 
161
	  n'.node_id
162
	  Disjunction.pp_disjoint_map disjoint
163
      );
164 97498b53 xthirioux
165 1837ce98 xthirioux
    let reuse = Liveness.reuse_policy n sort death disjoint in
166 49ddf66d ploc
    Log.report ~level:5 
167
      (fun fmt -> 
168
	Format.eprintf 
169
	  "reuse policy for node %s: %a" 
170
	  n'.node_id
171
	  Liveness.pp_reuse_policy reuse
172
      );
173 e8c0f452 xthirioux
 
174 1837ce98 xthirioux
    n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse }
175 0cbf0839 ploc
  with (Causality.Cycle v) as exc ->
176
    pp_error Format.err_formatter v;
177
    raise exc
178
179 db1c5c00 ploc
let schedule_prog prog =
180
  List.fold_right (
181 9aaee7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
182 db1c5c00 ploc
      match top_decl.top_decl_desc with
183
	| Node nd -> 
184 9aaee7f9 xthirioux
	  let nd', report = schedule_node nd in
185 c1b14ce6 xthirioux
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, 
186 9aaee7f9 xthirioux
	  IMap.add nd.node_id report sch_map
187
	| _ -> top_decl::accu_prog, sch_map
188 db1c5c00 ploc
    ) 
189
    prog
190 9aaee7f9 xthirioux
    ([],IMap.empty)
191
192 d96d54ac xthirioux
let pp_schedule fmt node_schs =
193
 IMap.iter
194
   (fun nd report ->
195
     Format.fprintf fmt "%s schedule: %a@."
196
       nd
197
       (fprintf_list ~sep:" ; " (fun fmt v -> Format.fprintf fmt "%s" v)) report.schedule)
198
   node_schs
199
200
let pp_fanin_table fmt node_schs =
201
  IMap.iter
202
    (fun nd report ->
203
      Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table)
204
    node_schs
205
206 9aaee7f9 xthirioux
let pp_warning_unused fmt node_schs =
207
 IMap.iter
208
   (fun nd report ->
209
     let unused = report.unused_vars in
210
     if not (ISet.is_empty unused)
211
     then
212
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
213
       ISet.iter
214
	 (fun u -> 
215
	   Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@."
216
	     u
217 0038002e ploc
	     Location.pp_loc (get_node_var u nd).var_loc)
218 9aaee7f9 xthirioux
	 unused
219
   )
220
   node_schs
221 0cbf0839 ploc
222
(* Local Variables: *)
223
(* compile-command:"make -C .." *)
224
(* End: *)