Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ df39e35a

History | View | Annotate | Download (7.51 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 b1655a21 xthirioux
   Moreover, the dependency graph is browsed in a depth-first manner whenever possible,
34
   to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
35 22fe1c93 ploc
   In the following functions:
36
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
37
   - [g] the (imperative) graph to be topologically sorted
38
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
39
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
40
   - [sort] is the resulting topological order
41
*)
42 a38c681e xthirioux
43
(* Checks whether the currently scheduled variable [choice]
44
   is an output of a call, possibly among others *)
45
let is_call_output choice g =
46 04d15b97 xthirioux
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
47 a38c681e xthirioux
48 22fe1c93 ploc
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
49
   then removes [v] from [g] 
50
*)
51
let add_successors eq_equiv g v pending frontier =
52
  let succs_v = IdentDepGraph.succ g v in
53
  begin
54
    IdentDepGraph.remove_vertex g v;
55 b84a138e ploc
    List.iter 
56
      (fun v' -> 
57
	if is_graph_root v' g then 
58
	  (if eq_equiv v v' then 
59
	      pending := ISet.add v' !pending 
60
	   else
61
	      frontier := ISet.add v' !frontier)
62
      ) succs_v;
63 22fe1c93 ploc
  end
64
65
(* Chooses the next var to be sorted, taking priority into account.
66
   Modifies [pending] and [frontier] accordingly.
67
*)
68 a38c681e xthirioux
let next_element eq_equiv g sort call pending frontier =
69 8ea13d96 xthirioux
  begin
70
    if ISet.is_empty !pending
71
    then
72
      begin
73
	let choice = ISet.min_elt !frontier in
74 22fe1c93 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
75 8ea13d96 xthirioux
	frontier := ISet.remove choice !frontier;
76
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
77
	pending := p;
78
	frontier := f;
79 a38c681e xthirioux
	call := is_call_output choice g;
80 8ea13d96 xthirioux
	add_successors eq_equiv g choice pending frontier;
81 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
82
	then sort := [choice] :: !sort
83 8ea13d96 xthirioux
      end
84
    else
85
      begin
86
	let choice = ISet.min_elt !pending in
87 22fe1c93 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
88 8ea13d96 xthirioux
	pending := ISet.remove choice !pending;
89
	add_successors eq_equiv g choice pending frontier;
90 a38c681e xthirioux
	if not (ExprDep.is_ghost_var choice)
91
	then sort := (if !call
92
		      then (choice :: List.hd !sort) :: List.tl !sort
93
		      else [choice] :: !sort)
94 8ea13d96 xthirioux
      end
95
  end
96
97 22fe1c93 ploc
98
(* Topological sort of dependency graph [g], with priority.
99
 *)
100
let topological_sort eq_equiv g =
101
  let roots = graph_roots g in
102
  assert (roots <> []);
103 a38c681e xthirioux
  let call = ref false in
104 22fe1c93 ploc
  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 a38c681e xthirioux
      next_element eq_equiv g sorted call pending frontier;
114 22fe1c93 ploc
    done;
115 8ea13d96 xthirioux
    IdentDepGraph.clear g;
116 22fe1c93 ploc
    !sorted
117
  end
118
119 54d032f5 xthirioux
(* Filters out normalization variables and renames instance variables to keep things readable,
120
   in a case of a dependency error *)
121
let filter_original n vl =
122
 List.fold_right (fun v res ->
123
   if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else
124
   let vdecl = get_node_var v n in
125
   if vdecl.var_orig then v :: res else res) vl []
126
127 7afcba5a xthirioux
let schedule_node n =
128 54d032f5 xthirioux
  let node_vars = get_node_vars n in
129 22fe1c93 ploc
  try
130
    let eq_equiv = ExprDep.node_eq_equiv n in
131
    let eq_equiv v1 v2 =
132
      try
133
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
134
      with Not_found -> false in
135 cd670fe1 ploc
136 22fe1c93 ploc
    let n', g = global_dependency n in
137 b84a138e ploc
    Log.report ~level:5 
138
      (fun fmt -> 
139 b6a94a4e xthirioux
	Format.fprintf fmt
140 b84a138e ploc
	  "dependency graph for node %s: %a" 
141
	  n'.node_id
142
	  pp_dep_graph g
143
      );
144 0e1049dc xthirioux
    
145
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
146
     compute: coi predecessors of outputs
147
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
148 8a183477 xthirioux
       DONE !
149 0e1049dc xthirioux
     *)
150
151 a5784e75 xthirioux
    let gg = IdentDepGraph.copy g in
152 d4807c3d xthirioux
    let sort = topological_sort eq_equiv g in
153 b6a94a4e xthirioux
    let unused = Liveness.compute_unused_variables n gg in
154 8a183477 xthirioux
    let fanin = Liveness.compute_fanin n gg in
155 54d032f5 xthirioux
 
156
    let disjoint = Disjunction.clock_disjoint_map node_vars in
157 b84a138e ploc
    
158 b4d9710b xthirioux
    Log.report ~level:3 
159 b84a138e ploc
      (fun fmt -> 
160 b6a94a4e xthirioux
	Format.fprintf fmt
161 b84a138e ploc
	  "clock disjoint map for node %s: %a" 
162
	  n'.node_id
163
	  Disjunction.pp_disjoint_map disjoint
164
      );
165 b1a97ade xthirioux
166 45c13277 xthirioux
    let reuse = Liveness.compute_reuse_policy n sort disjoint gg in
167 7afcba5a xthirioux
 
168 bb2ca5f4 xthirioux
    n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse }
169 54d032f5 xthirioux
  with (Causality.Cycle vl) as exc ->
170
    let vl = filter_original n vl in
171
    pp_error Format.err_formatter vl;
172 22fe1c93 ploc
    raise exc
173
174 88486aaf ploc
let schedule_prog prog =
175
  List.fold_right (
176 3bfed7f9 xthirioux
    fun top_decl (accu_prog, sch_map)  ->
177 88486aaf ploc
      match top_decl.top_decl_desc with
178
	| Node nd -> 
179 3bfed7f9 xthirioux
	  let nd', report = schedule_node nd in
180 0e1049dc xthirioux
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, 
181 3bfed7f9 xthirioux
	  IMap.add nd.node_id report sch_map
182
	| _ -> top_decl::accu_prog, sch_map
183 88486aaf ploc
    ) 
184
    prog
185 3bfed7f9 xthirioux
    ([],IMap.empty)
186
187 a38c681e xthirioux
let pp_eq_schedule fmt vl =
188
  match vl with
189
  | []  -> assert false
190
  | [v] -> Format.fprintf fmt "%s" v
191
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
192
 
193 8a183477 xthirioux
let pp_schedule fmt node_schs =
194
 IMap.iter
195
   (fun nd report ->
196
     Format.fprintf fmt "%s schedule: %a@."
197
       nd
198 a38c681e xthirioux
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
199 8a183477 xthirioux
   node_schs
200
201
let pp_fanin_table fmt node_schs =
202
  IMap.iter
203
    (fun nd report ->
204
      Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table)
205
    node_schs
206
207 3bfed7f9 xthirioux
let pp_warning_unused fmt node_schs =
208
 IMap.iter
209
   (fun nd report ->
210
     let unused = report.unused_vars in
211
     if not (ISet.is_empty unused)
212
     then
213
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
214
       ISet.iter
215 df39e35a xthirioux
	 (fun u ->
216
	   let vu = get_node_var u nd in
217
	   if vu.var_orig
218
	   then Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." u Location.pp_loc vu.var_loc)
219 3bfed7f9 xthirioux
	 unused
220
   )
221
   node_schs
222 22fe1c93 ploc
223
(* Local Variables: *)
224
(* compile-command:"make -C .." *)
225
(* End: *)