Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 4162f7a0

History | View | Annotate | Download (5.88 KB)

1 22fe1c93 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 8ea13d96 xthirioux
open LustreSpec
28 22fe1c93 ploc
open Corelang
29
open Graph
30
open Causality
31
32
33
(* Topological sort with a priority for variables belonging in the same equation lhs.
34
   For variables still unrelated, standard compare is used to choose the minimal element.
35
   This priority is used since it helps a lot in factorizing generated code.
36
   In the following functions:
37
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
38
   - [g] the (imperative) graph to be topologically sorted
39
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
40
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
41
   - [sort] is the resulting topological order
42
*)
43
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
44
   then removes [v] from [g] 
45
*)
46
let add_successors eq_equiv g v pending frontier =
47
  let succs_v = IdentDepGraph.succ g v in
48
  begin
49
    IdentDepGraph.remove_vertex g v;
50 b84a138e ploc
    List.iter 
51
      (fun v' -> 
52
	if is_graph_root v' g then 
53
	  (if eq_equiv v v' then 
54
	      pending := ISet.add v' !pending 
55
	   else
56
	      frontier := ISet.add v' !frontier)
57
      ) succs_v;
58 22fe1c93 ploc
  end
59
60
(* Chooses the next var to be sorted, taking priority into account.
61
   Modifies [pending] and [frontier] accordingly.
62
*)
63
let next_element eq_equiv g sort pending frontier =
64 8ea13d96 xthirioux
  begin
65
    if ISet.is_empty !pending
66
    then
67
      begin
68
	let choice = ISet.min_elt !frontier in
69 22fe1c93 ploc
      (*Format.eprintf "-1-> %s@." choice;*)
70 8ea13d96 xthirioux
	frontier := ISet.remove choice !frontier;
71
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
72
	pending := p;
73
	frontier := f;
74
	add_successors eq_equiv g choice pending frontier;
75
	if not (ExprDep.is_instance_var choice) then sort := choice :: !sort
76
      end
77
    else
78
      begin
79
	let choice = ISet.min_elt !pending in
80 22fe1c93 ploc
      (*Format.eprintf "-2-> %s@." choice;*)
81 8ea13d96 xthirioux
	pending := ISet.remove choice !pending;
82
	add_successors eq_equiv g choice pending frontier;
83
	if not (ExprDep.is_instance_var choice) then sort := choice :: !sort
84
      end
85
  end
86
87 22fe1c93 ploc
88
(* Topological sort of dependency graph [g], with priority.
89
 *)
90
let topological_sort eq_equiv g =
91
  let roots = graph_roots g in
92
  assert (roots <> []);
93
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
94
  let pending = ref ISet.empty in
95
  let sorted = ref [] in
96
  begin
97
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
98
    do
99
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
100
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
101
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
102
      next_element eq_equiv g sorted pending frontier;
103
    done;
104 8ea13d96 xthirioux
    IdentDepGraph.clear g;
105 22fe1c93 ploc
    !sorted
106
  end
107
108 7afcba5a xthirioux
let schedule_node n =
109 22fe1c93 ploc
  try
110
    let eq_equiv = ExprDep.node_eq_equiv n in
111
    let eq_equiv v1 v2 =
112
      try
113
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
114
      with Not_found -> false in
115 cd670fe1 ploc
116 22fe1c93 ploc
    let n', g = global_dependency n in
117 b84a138e ploc
    Log.report ~level:5 
118
      (fun fmt -> 
119
	Format.eprintf 
120
	  "dependency graph for node %s: %a" 
121
	  n'.node_id
122
	  pp_dep_graph g
123
      );
124 0e1049dc xthirioux
    
125
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
126
     compute: coi predecessors of outputs
127
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
128
     *)
129
130 a5784e75 xthirioux
    let gg = IdentDepGraph.copy g in
131 d4807c3d xthirioux
    let sort = topological_sort eq_equiv g in
132 a5784e75 xthirioux
133 695d6f2f xthirioux
    let death = Liveness.death_table n gg sort in
134 b84a138e ploc
    Log.report ~level:5 
135
      (fun fmt -> 
136
	Format.eprintf 
137
	  "death table for node %s: %a" 
138
	  n'.node_id
139
	  Liveness.pp_death_table death
140
      );
141 7afcba5a xthirioux
142 b1a97ade xthirioux
    let disjoint = Disjunction.clock_disjoint_map (node_vars n) in
143 b84a138e ploc
    
144
    Log.report ~level:5 
145
      (fun fmt -> 
146
	Format.eprintf 
147
	  "clock disjoint map for node %s: %a" 
148
	  n'.node_id
149
	  Disjunction.pp_disjoint_map disjoint
150
      );
151 b1a97ade xthirioux
152 695d6f2f xthirioux
    let reuse = Liveness.reuse_policy n sort death in
153 b84a138e ploc
    Log.report ~level:5 
154
      (fun fmt -> 
155
	Format.eprintf 
156
	  "reuse policy for node %s: %a" 
157
	  n'.node_id
158
	  Liveness.pp_reuse_policy reuse
159
      );
160 7afcba5a xthirioux
 
161 0e1049dc xthirioux
    n', sort, (death, disjoint, reuse (* ??? *) )
162 22fe1c93 ploc
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*)
163
  with (Causality.Cycle v) as exc ->
164
    pp_error Format.err_formatter v;
165
    raise exc
166
167 88486aaf ploc
let schedule_prog prog =
168
  List.fold_right (
169 0e1049dc xthirioux
    fun top_decl (accu_prog, sch_map, death_map)  ->
170 88486aaf ploc
      match top_decl.top_decl_desc with
171
	| Node nd -> 
172 0e1049dc xthirioux
	  let nd', sch, death_tbls = schedule_node nd in
173
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, 
174
	  (nd.node_id, sch)::sch_map, 
175
	  (nd.node_id, death_tbls)::death_map
176
	| _ -> top_decl::accu_prog, sch_map, death_map
177 88486aaf ploc
    ) 
178
    prog
179 0e1049dc xthirioux
    ([],[],[])
180 88486aaf ploc
181 22fe1c93 ploc
182
(* Local Variables: *)
183
(* compile-command:"make -C .." *)
184
(* End: *)