Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 45c13277

History | View | Annotate | Download (7.01 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 8ea13d96 xthirioux
open LustreSpec
14 22fe1c93 ploc
open Corelang
15
open Graph
16
open Causality
17
18 3bfed7f9 xthirioux
type schedule_report =
19
{
20 8a183477 xthirioux
  (* a schedule computed wrt the dependency graph *)
21 a38c681e xthirioux
  schedule : ident list list;
22 8a183477 xthirioux
  (* the set of unused variables (no output or mem depends on them) *)
23 3bfed7f9 xthirioux
  unused_vars : ISet.t;
24 8a183477 xthirioux
  (* the table mapping each local var to its in-degree *)
25
  fanin_table : (ident, int) Hashtbl.t;
26 bb2ca5f4 xthirioux
  (* the table mapping each assignment to a reusable variable *)
27 44bea83a xthirioux
  reuse_table : (ident, var_decl) Hashtbl.t
28 3bfed7f9 xthirioux
}
29 22fe1c93 ploc
30
(* Topological sort with a priority for variables belonging in the same equation lhs.
31
   For variables still unrelated, standard compare is used to choose the minimal element.
32
   This priority is used since it helps a lot in factorizing generated code.
33
   In the following functions:
34
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
35
   - [g] the (imperative) graph to be topologically sorted
36
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
37
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
38
   - [sort] is the resulting topological order
39
*)
40 a38c681e xthirioux
41
(* Checks whether the currently scheduled variable [choice]
42
   is an output of a call, possibly among others *)
43
let is_call_output choice g =
44
  List.for_all ExprDep.is_instance_var (IdentDepGraph.succ g choice)
45
46 22fe1c93 ploc
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
47
   then removes [v] from [g] 
48
*)
49
let add_successors eq_equiv g v pending frontier =
50
  let succs_v = IdentDepGraph.succ g v in
51
  begin
52
    IdentDepGraph.remove_vertex g v;
53 b84a138e ploc
    List.iter 
54
      (fun v' -> 
55
	if is_graph_root v' g then 
56
	  (if eq_equiv v v' then 
57
	      pending := ISet.add v' !pending 
58
	   else
59
	      frontier := ISet.add v' !frontier)
60
      ) succs_v;
61 22fe1c93 ploc
  end
62
63
(* Chooses the next var to be sorted, taking priority into account.
64
   Modifies [pending] and [frontier] accordingly.
65
*)
66 a38c681e xthirioux
let next_element eq_equiv g sort call pending frontier =
67 8ea13d96 xthirioux
  begin
68
    if ISet.is_empty !pending
69
    then
70
      begin
71
	let choice = ISet.min_elt !frontier in
72 22fe1c93 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
73 8ea13d96 xthirioux
	frontier := ISet.remove choice !frontier;
74
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
75
	pending := p;
76
	frontier := f;
77 a38c681e xthirioux
	call := is_call_output choice g;
78 8ea13d96 xthirioux
	add_successors eq_equiv g choice pending frontier;
79 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
80
	then sort := [choice] :: !sort
81 8ea13d96 xthirioux
      end
82
    else
83
      begin
84
	let choice = ISet.min_elt !pending in
85 22fe1c93 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
86 8ea13d96 xthirioux
	pending := ISet.remove choice !pending;
87
	add_successors eq_equiv g choice pending frontier;
88 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
89
	then sort := (if !call
90
		      then (choice :: List.hd !sort) :: List.tl !sort
91
		      else [choice] :: !sort)
92 8ea13d96 xthirioux
      end
93
  end
94
95 22fe1c93 ploc
96
(* Topological sort of dependency graph [g], with priority.
97
 *)
98
let topological_sort eq_equiv g =
99
  let roots = graph_roots g in
100
  assert (roots <> []);
101 a38c681e xthirioux
  let call = ref false in
102 22fe1c93 ploc
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
103
  let pending = ref ISet.empty in
104
  let sorted = ref [] in
105
  begin
106
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
107
    do
108
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
109
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
110
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
111 a38c681e xthirioux
      next_element eq_equiv g sorted call pending frontier;
112 22fe1c93 ploc
    done;
113 8ea13d96 xthirioux
    IdentDepGraph.clear g;
114 22fe1c93 ploc
    !sorted
115
  end
116
117 7afcba5a xthirioux
let schedule_node n =
118 22fe1c93 ploc
  try
119
    let eq_equiv = ExprDep.node_eq_equiv n in
120
    let eq_equiv v1 v2 =
121
      try
122
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
123
      with Not_found -> false in
124 cd670fe1 ploc
125 22fe1c93 ploc
    let n', g = global_dependency n in
126 b84a138e ploc
    Log.report ~level:5 
127
      (fun fmt -> 
128 b6a94a4e xthirioux
	Format.fprintf fmt
129 b84a138e ploc
	  "dependency graph for node %s: %a" 
130
	  n'.node_id
131
	  pp_dep_graph g
132
      );
133 0e1049dc xthirioux
    
134
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
135
     compute: coi predecessors of outputs
136
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
137 8a183477 xthirioux
       DONE !
138 0e1049dc xthirioux
     *)
139
140 a5784e75 xthirioux
    let gg = IdentDepGraph.copy g in
141 d4807c3d xthirioux
    let sort = topological_sort eq_equiv g in
142 b6a94a4e xthirioux
    let unused = Liveness.compute_unused_variables n gg in
143 8a183477 xthirioux
    let fanin = Liveness.compute_fanin n gg in
144 7afcba5a xthirioux
145 01c7d5e1 ploc
    let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in
146 b84a138e ploc
    
147 a38c681e xthirioux
    Log.report ~level:2 
148 b84a138e ploc
      (fun fmt -> 
149 b6a94a4e xthirioux
	Format.fprintf fmt
150 b84a138e ploc
	  "clock disjoint map for node %s: %a" 
151
	  n'.node_id
152
	  Disjunction.pp_disjoint_map disjoint
153
      );
154 b1a97ade xthirioux
155 45c13277 xthirioux
    let reuse = Liveness.compute_reuse_policy n sort disjoint gg in
156 a38c681e xthirioux
    Log.report ~level:2 
157 b84a138e ploc
      (fun fmt -> 
158 b6a94a4e xthirioux
	Format.fprintf fmt
159 b84a138e ploc
	  "reuse policy for node %s: %a" 
160
	  n'.node_id
161
	  Liveness.pp_reuse_policy reuse
162
      );
163 7afcba5a xthirioux
 
164 bb2ca5f4 xthirioux
    n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse }
165 22fe1c93 ploc
  with (Causality.Cycle v) as exc ->
166
    pp_error Format.err_formatter v;
167
    raise exc
168
169 88486aaf ploc
let schedule_prog prog =
170
  List.fold_right (
171 3bfed7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
172 88486aaf ploc
      match top_decl.top_decl_desc with
173
	| Node nd -> 
174 3bfed7f9 xthirioux
	  let nd', report = schedule_node nd in
175 0e1049dc xthirioux
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, 
176 3bfed7f9 xthirioux
	  IMap.add nd.node_id report sch_map
177
	| _ -> top_decl::accu_prog, sch_map
178 88486aaf ploc
    ) 
179
    prog
180 3bfed7f9 xthirioux
    ([],IMap.empty)
181
182 a38c681e xthirioux
let pp_eq_schedule fmt vl =
183
  match vl with
184
  | []  -> assert false
185
  | [v] -> Format.fprintf fmt "%s" v
186
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
187
 
188 8a183477 xthirioux
let pp_schedule fmt node_schs =
189
 IMap.iter
190
   (fun nd report ->
191
     Format.fprintf fmt "%s schedule: %a@."
192
       nd
193 a38c681e xthirioux
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
194 8a183477 xthirioux
   node_schs
195
196
let pp_fanin_table fmt node_schs =
197
  IMap.iter
198
    (fun nd report ->
199
      Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table)
200
    node_schs
201
202 3bfed7f9 xthirioux
let pp_warning_unused fmt node_schs =
203
 IMap.iter
204
   (fun nd report ->
205
     let unused = report.unused_vars in
206
     if not (ISet.is_empty unused)
207
     then
208
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
209
       ISet.iter
210
	 (fun u -> 
211
	   Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@."
212
	     u
213 01c7d5e1 ploc
	     Location.pp_loc (get_node_var u nd).var_loc)
214 3bfed7f9 xthirioux
	 unused
215
   )
216
   node_schs
217 22fe1c93 ploc
218
(* Local Variables: *)
219
(* compile-command:"make -C .." *)
220
(* End: *)